06-02-2023, 03:50 AM (This post was last modified: 06-02-2023, 03:52 AM by NasaCow.
Edit Reason: Grammar be important
)
I am trying to control exiting to prevent work from getting loss and adding some basic code related to EXIT is having my program crash out with Error 10 - Duplicate definition (The error points to the label ShutDown). I tried to step through it to see how the program flows exactly but with no success. Is running the timer all the time to check a bad idea for complex programs? Getting it to work with a simple loop seems to be no problem, inserting into Grade Keeper seems to be breaking something...
Quote:'Disabling the default exit routinue
ExitFlag = EXIT
ON TIMER(1) GOSUB ShutDown
TIMER ON
...
ShutDown:
ExitFlag = EXIT
IF ExitFlag THEN SYSTEM
RETURN
WHILE NOT EndOfLife(1)
HappyLife = HappyWife - (Money * Time * Travel * Gifts)
Kids = (NoTime * LackOfLove) MOD NumOfKids
IF Retirement <> Rich THEN YearsOnJob = YearsOnJob + 1 ELSE SeeTheWorld
WEND
Checking _EXIT status every second like that is overkill. Just check the function result at the end of the main loop of the main program. Check _EXIT function result as one of the executable statements.
Also please provide a way for the user to exit the program! Usually I program [ESC] to leave the application at any time as soon as possible.
Because you're not showing the whole code example, it's not certain to others including me, why you're getting a "Duplicate definition" error.
(06-02-2023, 05:29 AM)mnrvovrfc Wrote: Checking _EXIT status every second like that is overkill. Just check the function result at the end of the main loop of the main program. Check _EXIT function result as one of the executable statements.
Also please provide a way for the user to exit the program! Usually I program [ESC] to leave the application at any time as soon as possible.
Because you're not showing the whole code example, it's not certain to others including me, why you're getting a "Duplicate definition" error.
The reason why I didn't post the code here is cause I don't know where the error is occuring. I don't know where in 1000s of lines of code to point to and say ah-ha this is the area. I know it isn't optimized or user friendly at the moment, but there is no point worrying about it unless I can get it to work in the simplest of cases to start.
I will post the code here, but as I said, I don't know what is causing the crash and I am sorry I can't be more self-helpful in this case. The first mini code block I posted is after all the DIM SHARED statements and the ShutDown label is located after the main program loop and the general error code place holder I have for now:
OPTION EXPLICIT
OPTION BASE 1
ON ERROR GOTO errorhandle
'Standard file # list (Same # throughout for one file type)
'#1 is Students.gkn for student name list
'#2 is teacher.gkt for teacher and school info
'#3 for *.gka/gradebook master files
'#4 for *.gkb/gradebook slave files
'Global loop speed limit to control CPU usage, delay timer with keyboard flush
CONST LIMITRATE = 60, TIME = .15
'Used for the student name database
TYPE StudentsType
NickName AS STRING * 20
FirstName AS STRING * 20
MiddleName AS STRING * 20
LastName AS STRING * 20
Year AS INTEGER
Month AS INTEGER
Day AS INTEGER
MomName AS STRING * 30
MomPhone AS STRING * 20
MomEmail AS STRING * 38
DadName AS STRING * 30
DadPhone AS STRING * 20
DadEmail AS STRING * 38
AddInfo AS STRING * 88
UID AS INTEGER64
END TYPE
'User info (Teacher)
TYPE TeacherType
TeacherName AS STRING * 50
School AS STRING * 100
Grade AS STRING * 20
Class AS STRING * 20
Classroom AS STRING * 20
LastFile AS STRING * 20
LastUsedUID AS INTEGER64
LastUsedAID AS INTEGER64
Custom1 AS STRING * 20
Custom2 AS STRING * 20
Custom3 AS STRING * 20
Custom4 AS STRING * 20
Custom5 AS STRING * 20
END TYPE
'Global mouse status
TYPE MouseType
X AS INTEGER 'Current X position
Y AS INTEGER 'Current Y position
OldX AS INTEGER 'Prior X position
OldY AS INTEGER 'Prior Y position
LBut AS INTEGER 'Left button current state
RBut AS INTEGER 'Right button current state
Pointer AS INTEGER 'Mouse "pointing at what" when clicked - Not while held
GBX AS INTEGER 'Gradebook "pointing at what X" when clicked - Not while held
GBY AS INTEGER 'Gradebook "pointing at what Y" when clicked - Not while held
END TYPE
'Used to help establish boxes for the mouse
TYPE MenuPosType
X1 AS INTEGER
Y1 AS INTEGER
X2 AS INTEGER
Y2 AS INTEGER
END TYPE
'Info on the cells in the gradebook
TYPE GBCellsType
X1 AS INTEGER 'For mouse - top left corner detection box
Y1 AS INTEGER 'For mouse - bottom left corner detection box
X2 AS INTEGER 'For mouse - top right corner detection box
Y2 AS INTEGER 'For mouse - bottom right corner detection box
Entry AS FLOAT 'Data entered for the cell on screen, to be saved.
Flags AS BYTE 'Slave file flags
Flags2 AS BYTE 'Slave file flags
Notes AS STRING * 512 'Comments for a student's work
AID AS INTEGER64 'Align the current grid and the files on disk (Master-Slave)
UID AS INTEGER64 'Align the current grid and the files on disk (Namelist-Slave)
END TYPE
'Assignments for all students, populates the top of the gradebook
TYPE MasterAssignmentType
ARName AS STRING * 30 'Assignment report name
ADName AS STRING * 15 'Assignment display name (short name)
AType AS INTEGER 'Assignment Type (points, percentage, letter, etc.)
ACat AS STRING * 20 'Assignment Category (homework, test, etc)
ACatID AS INTEGER 'Used for sorting the MA in the gradebook
AColor AS UNSIGNED LONG 'Color coding assignment headers and for grouping for reports
ACode AS UNSIGNED BYTE 'See table below for codes
APts AS UNSIGNED INTEGER 'Total points allowed
AWght AS UNSIGNED INTEGER 'For weighted assignments/100 = 100%
Month AS UNSIGNED INTEGER
Day AS UNSIGNED INTEGER
Year AS UNSIGNED INTEGER
AMonth AS UNSIGNED INTEGER
ADay AS UNSIGNED INTEGER
AYear AS UNSIGNED INTEGER
AID AS INTEGER64 'Unique assignment ID
ADetails AS STRING * 4096 'Space to write instructions for an assignment sheet to print or notes for user.
END TYPE
'====================Flag codes====================
'1 - Extra credit allowed/Ignore pts allowed |
'2 - Include in final grade |
'4 - Excuse All/Ignore/Shown on reports flagged |
'8 - Hidden/Future dated/Exclude from reports |
'16 - Weighted |
'32 - Reserved |
'64 - Reserved |
'128 - Reserved |
'==================================================
'Assignment for one student with their individual details.
TYPE SlaveAssignmentType
UID AS INTEGER64 'UID matches StudentsType, negative UID means deleted student, records will be preserved
AID AS INTEGER64 'AID matches MasterAssignmentType
MPts AS FLOAT 'Points earned for each particular students
Flags AS UNSIGNED BYTE 'See below for codes
Flags2 AS UNSIGNED BYTE 'Reserved for future developments
Notes AS STRING * 512 'Comments for a student's work
END TYPE
'====================Flag codes====================
'1 - Late (Turned in late) |
'2 - Absent on due date (ignore due date) |
'4 - Incomplete (turned in but not done) |
'8 - Missing (Not turned in) |
'16 - Excused/Exempt |
'32 - Ignore score internally for avg, etc. |
'64 - Remove from external reports |
'128 - Reserved |
'==================================================
'Used to keep track of the current location on the gradebook and entries being accessed.
TYPE SelType
X AS INTEGER
Y AS INTEGER
AID AS INTEGER64
UID AS INTEGER64
END TYPE
'Used to track the various assignment categories and colors
TYPE ACatType
AName AS STRING
Color32 AS UNSIGNED LONG
Custom AS BYTE
END TYPE
'UDTs as explainded above
DIM SHARED AS StudentsType Students(50)
DIM SHARED AS TeacherType Teacher
DIM SHARED AS MouseType M
DIM SHARED AS MasterAssignmentType MA(400)
DIM SHARED AS SlaveAssignmentType SA(500)
DIM SHARED AS MenuPosType MenuPos(2 TO 10)
DIM SHARED AS GBCellsType GBCells(1 TO 25, 1 TO 20) 'Assignments, Students
DIM SHARED AS LONG MainScreen 'Screen handle
DIM SHARED AS LONG FontHandle(1 TO 17), ReportFont, ReportScriptFont 'Font handles
DIM SHARED AS INTEGER NumberOfStudents, SlaveCounter 'Gradebook use across GB subs
DIM SHARED AS INTEGER Pointer 'Used for menu selections
DIM SHARED AS INTEGER PageS, FSize, FHeight 'Used for fonts in the report printer
DIM SHARED AS BIT SelectFlag 'Used in menus
DIM SHARED AS BIT MLButAct, MRButAct 'Used to execute choices based on a click or released mouse button
DIM SHARED AS BIT MFlag 'Used to escape loops with the mouse
DIM SHARED AS BIT GBRestart 'Used by GBRemA to reinitalize the GB to properly display GBCells()
DIM SHARED AS BYTE ExitFlag
DIM SHARED AS INTEGER BGImage, CheckSelect 'Embedded pictures (data located in ./include/Data.bas)
DIM SHARED AS STRING Menu(1 TO 10) 'Used by the SUB MENUMAKER to quick create menus - "*" means stop building
DIM SHARED AS STRING * 50 NullStr 'Check the teacher's file is registered properly (data has been entered)
'Disabling the default exit routinue
ExitFlag = EXIT
ON TIMER(1) GOSUB ShutDown
TIMER ON
'Initalizing program
TITLE "Grade Keeper Alpha Version 4.1.2"
PageS = 11: FSize = 14
FHeight = INT(FSize * 0.3527 * PageS) 'Formula for font size on reports
'Loading screen for the fonts
CLS
SCREENMOVE MIDDLE
LOCATE 12, 25
COLOR 15
PRINT "Loading resources. Please wait...";
'Restoring pictures from embedded data
DIM AS STRING Buffer
RESTORE Blank
Buffer = LoadResource
BGImage = LOADIMAGE(Buffer, 32, "memory")
RESTORE CheckMark
Buffer = LoadResource
CheckSelect = LOADIMAGE(Buffer, 32, "memory")
'Setting up the main screen
MainScreen = NEWIMAGE(1280, 720, 32)
SCREEN MainScreen
SCREENMOVE 0, 0
PRINTMODE KEEPBACKGROUND
'Asking for info for reports if not on file
IF NOT FILEEXISTS("teacher.gkt") THEN
TEACHERWRITER
ELSE
OPEN "teacher.gkt" FOR INPUT AS #2
INPUT #2, Teacher.TeacherName
INPUT #2, Teacher.School
INPUT #2, Teacher.Grade
INPUT #2, Teacher.Class
INPUT #2, Teacher.Classroom
INPUT #2, Teacher.LastFile
INPUT #2, Teacher.LastUsedUID
INPUT #2, Teacher.LastUsedAID
INPUT #2, Teacher.Custom1
INPUT #2, Teacher.Custom2
INPUT #2, Teacher.Custom3
INPUT #2, Teacher.Custom4
INPUT #2, Teacher.Custom5
CLOSE #2
END IF
IF Teacher.TeacherName = NullStr THEN
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!"
END IF
GBRestart = FALSE
'Main program loop
DO: LIMIT LIMITRATE: A_MAINMENU: LOOP: SYSTEM
'Error handling
errorhandle:
DIM AS STRING ErrorCode
ErrorCode = "Error" + STR$(ERR) + " on program file line" + STR$(ERRORLINE) + ". Program will end."
QUICKMESSAGE ErrorCode
SYSTEM
ShutDown:
ExitFlag = EXIT
IF ExitFlag THEN SYSTEM
RETURN
'File holding all DATA lines used in the program.
'$include:'./include/Data.bas'
'*****************Menus**********************
'-----------------Level 1 Menu----------------------
SUB A_MAINMENU
DO
LIMIT LIMITRATE
CLS
PUTIMAGE (0, 0), BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE TIME 'Avoid double press delay
SelectFlag = FALSE 'reset input
'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
'Checking for mouse input
MOUSE "Poll"
MOUSE "Release"
MOUSE "Action"
MOUSE "Loop"
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) OR MFlag 'Return/space bar/mouse click to select
SELECT CASE Pointer
CASE 0: B_CSHOME
CASE 1: B_OPTIONS
CASE 2: ABOUT
CASE 3: SYSTEM
END SELECT
END SUB
'-------------------Level 2 Menus---------------------------
SUB B_CSHOME
DIM AS STRING * 20 Blank20 'Null string to check aganist a null teacher file result
DIM AS STRING NewFile 'To check we are changing file names
DIM AS BIT NoFile
DO
NoFile = FALSE
PAUSE TIME
LIMIT LIMITRATE
MOUSE "Inital"
Menu(1) = "Class Set"
IF Teacher.LastFile = Blank20 OR Teacher.LastFile = "" THEN Menu(2) = "No Recent Class Set": NoFile = TRUE ELSE Menu(2) = "Current Set: " + TRIM$(Teacher.LastFile)
Menu(3) = "Open Another Class Set"
Menu(4) = "Setup a New Class Set"
Menu(5) = "Back"
Menu(6) = "*"
IF NoFile THEN Pointer = 2 ELSE Pointer = 0
DO
LIMIT LIMITRATE
'Prepare and draw the menu
CLS
PUTIMAGE (0, 0), BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: IF NOT NoFile THEN PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), 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 = 3 ELSE Pointer = Pointer - 1
IF Pointer = 0 AND NoFile THEN Pointer = 3
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 3 THEN Pointer = 0 ELSE Pointer = Pointer + 1
IF Pointer = 0 AND NoFile THEN Pointer = 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) OR MFlag 'Return, space bar, or mouse to select
'Execute choice
SELECT CASE Pointer
CASE 0: IF NOT NoFile THEN CSSelect
CASE 1: NewFile = CSFile$(""): IF NewFile <> "*" THEN Teacher.LastFile = NewFile: TEACHERWRITER: CSSelect ELSE Pointer = 0
CASE 2: CSNew
Menu(1) = "Class Set"
IF Teacher.LastFile = Blank20 THEN Menu(2) = "No Recent Class Set": NoFile = TRUE ELSE Menu(2) = "Current Set: " + TRIM$(Teacher.LastFile)
END SELECT
PAUSE TIME
LOOP UNTIL Pointer = 3
END SUB
'For configuration & backing up
SUB B_OPTIONS
DO
Pointer = 0
Menu(1) = "Options"
Menu(2) = "Teacher/School Information"
Menu(3) = "Erase a Class set"
Menu(4) = "Erase all files"
Menu(5) = "Back"
Menu(6) = "*"
LIMIT LIMITRATE
MOUSE "Inital"
PAUSE TIME 'Clear the keyboard buffer
DO
'Prepare and draw the menu
LIMIT LIMITRATE
CLS
PUTIMAGE , BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), 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 = 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
LIMIT LIMITRATE
MOUSE "Inital"
PAUSE TIME 'Clear the keyboard buffer
IF NOT GBRestart THEN
DO
'Prepare and draw the menu
LIMIT LIMITRATE
CLS
PUTIMAGE , BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), CheckSelect
CASE 4: PUTIMAGE (MenuPos(6).X1 - 50, MenuPos(6).Y1 + 10), 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) OR MFlag 'Return or Space bar or mouse to select
END IF
'Execute choice
SELECT CASE Pointer
CASE 0: GBRestart = FALSE: GB
CASE 1: D_CSGREPORTS
CASE 2: D_CSSREPORTS
CASE 3: CSRoster: IF NumberOfStudents = 0 THEN QUICKMESSAGE "All students deleted, exiting to main menu.": EXIT SUB
END SELECT
LOOP UNTIL Pointer = 4
END SUB
DO
'Prepare and draw the menu
LIMIT LIMITRATE
CLS
PUTIMAGE , BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), 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 = 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) OR MFlag 'Return or Space bar or mouse to select
'Execute choice
SELECT CASE Pointer
CASE 0: REPORTWRITER "Name List"
CASE 1: REPORTWRITER "Birthday Report"
CASE 2: REPORTWRITER "Parent Contact Info"
END SELECT
LOOP UNTIL Pointer = 3
END SUB
'Gradebook Reports
SUB D_CSGREPORTS
QUICKMESSAGE "Gradebook Reports"
END SUB
'**********Start Subs and functions**********
'-----------Subs----------
'Writes reports with PRINTIMAGE (one page limit currently)
SUB REPORTWRITER (ReportName AS STRING)
DIM AS INTEGER PageH, PageW 'Height, Width, Scale (higher is clearer)
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 'Paper size
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.
CLS
FONT FontHandle(4)
'Collect info for the "Name List" report before the please wait screen is displayed...
IF ReportName = "Name List" THEN
CLS: PUTIMAGE , BGImage
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 "Parent Contact List" report before the please wait screen is displayed...
IF ReportName = "Parent Contact Info" THEN
CLS: PUTIMAGE , BGImage
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 , BGImage
X = 1280 / 2 - UPRINTWIDTH("Report is being generated,") / 2
Y = (HEIGHT / 2) - 2 * UFONTHEIGHT
UPRINTSTRING (X, Y), "Report is being generated."
X = 1280 / 2 - UPRINTWIDTH("Standby for printer selection...") / 2
UPRINTSTRING (X, Y + UFONTHEIGHT), "Standby for printer selection..."
X = 1280 / 2 - UPRINTWIDTH("Press or click nothing while waiting") / 2
UPRINTSTRING (X, Y + 3 * UFONTHEIGHT), "Press or click nothing while waiting"
DISPLAY
'Building the page and fonts needed
FHeight = INT(FSize * 0.3527 * PageS) 'Formula for a font 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 ReportFont '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 - UPRINTWIDTH(ReportName) / 2: Y = FHeight * 3
UPRINTSTRING (X, Y), ReportName
X = PageW / 2 - UPRINTWIDTH(Teach) / 2: Y = Y + FHeight * 2
UPRINTSTRING (X, Y), Teach
X = PageW / 2 - UPRINTWIDTH(School) / 2: Y = Y + FHeight
UPRINTSTRING (X, Y), School
X = PageW / 2 - UPRINTWIDTH(Location) / 2: Y = Y + FHeight
UPRINTSTRING (X, Y), Location
X = PageW / 2 - UPRINTWIDTH(DateAndTime) / 2: Y = Y + FHeight
UPRINTSTRING (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 Students(), 3 '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 = Students(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$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)
X = 70 * PageS
PRINTSTRING (X, Y), BIRTHDAY$(Students(PrintCounter).Month, Students(PrintCounter).Day, CurrentYear)
X = 180 * PageS
PRINTSTRING (X, Y), STR$(CurrentYear - Students(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$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)
X = 70 * PageS
PRINTSTRING (X, Y), BIRTHDAY$(Students(PrintCounter).Month, Students(PrintCounter).Day, CurrentYear)
X = 180 * PageS
PRINTSTRING (X, Y), STR$(CurrentYear - Students(PrintCounter).Year)
X = 20 * PageS: Y = Y + FHeight * 1.15
NEXT PrintCounter
END IF
SORT Students(), 1 'Restore display sort
CASE "Name List":
SORT Students(), 1
'Print the names to the sheet
X = 20 * PageS: Y = Y + FHeight * 2: LongName = 0
FOR PrintCounter = 1 TO NumberOfStudents
PRINTSTRING (X, Y), TRIM$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)
Y = Y + FHeight * 1.5
IF LongName < PRINTWIDTH(TRIM$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)) THEN 'Finds the longest name
LongName = PRINTWIDTH(TRIM$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName))
END IF
NEXT PrintCounter
'Prints a grid if desired
IF WantGrid THEN
X = LongName + 10 * 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$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)
Y = Y + FHeight * 1.15
IF LongName < PRINTWIDTH(TRIM$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName)) THEN 'Finds the longest name
LongName = PRINTWIDTH(TRIM$(Students(PrintCounter).FirstName) + " " + TRIM$(Students(PrintCounter).LastName))
END IF
IF MotherFather = "Mother's " THEN
IF MomDadLongName < PRINTWIDTH(TRIM$(Students(PrintCounter).MomName)) THEN MomDadLongName = PRINTWIDTH(TRIM$(Students(PrintCounter).MomName))
IF MomDadLongEmail < PRINTWIDTH(TRIM$(Students(PrintCounter).MomEmail)) THEN MomDadLongEmail = PRINTWIDTH(TRIM$(Students(PrintCounter).MomEmail))
IF MomDadLongPhone < PRINTWIDTH(TRIM$(Students(PrintCounter).MomPhone)) THEN MomDadLongPhone = PRINTWIDTH(TRIM$(Students(PrintCounter).MomPhone))
ELSE
IF MomDadLongName < PRINTWIDTH(TRIM$(Students(PrintCounter).DadName)) THEN MomDadLongName = PRINTWIDTH(TRIM$(Students(PrintCounter).DadName))
IF MomDadLongEmail < PRINTWIDTH(TRIM$(Students(PrintCounter).DadEmail)) THEN MomDadLongEmail = PRINTWIDTH(TRIM$(Students(PrintCounter).DadEmail))
IF MomDadLongPhone < PRINTWIDTH(TRIM$(Students(PrintCounter).DadPhone)) THEN MomDadLongPhone = PRINTWIDTH(TRIM$(Students(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), Students(PrintCounter).MomName
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing, Y), Students(PrintCounter).MomPhone
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing + MomDadLongPhone + XSpacing, Y), Students(PrintCounter).MomEmail
ELSE
PRINTSTRING (X + LongName + XSpacing, Y), Students(PrintCounter).DadName
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing, Y), Students(PrintCounter).DadPhone
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing + MomDadLongPhone + XSpacing, Y), Students(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
UPRINTSTRING (20 * PageS, Y), "Prepared with "
UPRINTSTRING (190 * PageS - UPRINTWIDTH("Page 1 of 1"), Y), "Page 1 of 1"
X = (20 * PageS) + UPRINTWIDTH("Prepared with ")
FONT ReportScriptFont
UPRINTSTRING (X, Y), "Grade Keeper"
'Send the report to the printer, cleans up fonts, and inform the user of success.
PRINTIMAGE Page
FONT FontHandle(3)
QUICKMESSAGE "Report generated!"
END SUB
'**************************************************All Gradebook Subs*************************************
'The Gradebook
SUB GB
'Used to track location on the grid and which entries are being accessed.
DIM AS StudentsType PrintOrder(1 TO 100)
DIM AS SelType Sel
DIM AS INTEGER CurrentStudents, X, Y, LongName, CurrentPageCount, EndPoint, GridCount
DIM AS INTEGER StartY, LoopX, LoopY, TextInput, GBBGImage, AssignCount, NoAssignLen
DIM AS INTEGER Counter, Counter1, CounterX, CounterY, HL(500000), FCommand
DIM AS BIT EnterText, ExitFlag, FFlag, WriteFlag, ReadFlag
DIM AS LONG PrintName
DIM AS STRING Texty
'---------Start Inital settings-----------
FONT FontHandle(2)
AssignCount = 0 'Total assignment on screen, used to restrict movement.
'Load the master from file
GBReader "Master", AssignCount, CurrentStudents
'Display order of names for the gradebook
FOR Counter = 1 TO NumberOfStudents
IF Students(Counter).UID > 0 THEN CurrentStudents = CurrentStudents + 1: PrintOrder(Counter) = Students(Counter)
NEXT Counter
SORT PrintOrder(), 1
'Places AID and UID into the GB grid for loading of SA()
FOR Counter = 1 TO CurrentStudents
FOR Counter1 = 1 TO 25
GBCells(Counter1, Counter).UID = PrintOrder(Counter).UID
GBCells(Counter1, Counter).AID = MA(Counter1).AID
NEXT Counter1
NEXT Counter
'Load the slave from file and restore the info to cells
GBReader "Slave", AssignCount, CurrentStudents
FOR Counter = 1 TO UBOUND(SA)
FOR CounterY = 1 TO CurrentStudents
FOR CounterX = 1 TO AssignCount
IF GBCells(CounterX, CounterY).UID = SA(Counter).UID AND GBCells(CounterX, CounterY).AID = SA(Counter).AID THEN
GBCells(CounterX, CounterY).Entry = SA(Counter).MPts
GBCells(CounterX, CounterY).Flags = SA(Counter).Flags
GBCells(CounterX, CounterY).Flags2 = SA(Counter).Flags2
GBCells(CounterX, CounterY).Notes = SA(Counter).Notes
END IF
NEXT CounterX
NEXT CounterY
NEXT Counter
'Finds the length of the longest name
FOR Counter = 1 TO CurrentStudents
IF LongName < PRINTWIDTH(TRIM$(PrintOrder(Counter).FirstName) + " " + TRIM$(PrintOrder(Counter).LastName)) THEN 'Finds the longest name
LongName = PRINTWIDTH(TRIM$(PrintOrder(Counter).FirstName) + " " + TRIM$(PrintOrder(Counter).LastName))
END IF
NEXT Counter
'Find the last point we can draw the grid and how many columns we will have
EndPoint = LongName + 11: GridCount = 0
WHILE EndPoint < 1230
EndPoint = EndPoint + 50
GridCount = GridCount + 1
WEND
EndPoint = EndPoint
'Inital grid state for mouse box detection
StartY = 144
X = LongName + 11: Y = StartY - 4
IF CurrentStudents >= 20 THEN CurrentPageCount = 20 ELSE CurrentPageCount = CurrentStudents
'Mouse boxes for detection - grade boxes
FOR CounterY = 1 TO CurrentPageCount
FOR CounterX = 1 TO GridCount
GBCells(CounterX, CounterY).X1 = X
GBCells(CounterX, CounterY).Y1 = Y
GBCells(CounterX, CounterY).X2 = X + 48
GBCells(CounterX, CounterY).Y2 = Y + FONTHEIGHT + 7
X = X + 50
NEXT CounterX
X = LongName + 11
Y = Y + FONTHEIGHT + 8
NEXT CounterY
'Prepare to draw the grid and print names
X = 1: Y = StartY
GBBGImage = NEWIMAGE(1280, 720, 32)
DEST GBBGImage
FONT FontHandle(2)
'Top panel (BG color)
CLS , RGB32(168, 168, 168)
'Printing the names
FOR Counter = 1 TO CurrentPageCount
IF Counter MOD 2 THEN
LINE (0, Y + FONTHEIGHT + 4)-(EndPoint, Y - 4), RGB32(241, 245, 250), BF
ELSE
LINE (0, Y + FONTHEIGHT + 4)-(EndPoint, Y - 4), White, BF
END IF
PrintName = TEXTTOIMAGE(TRIM$(PrintOrder(Counter).FirstName) + " " + TRIM$(PrintOrder(Counter).LastName), FontHandle(12), Black, 0, 1)
DISPLAYIMAGE PrintName, X, Y, 1, 1, 0, 1
FREEIMAGE PrintName
Y = Y + FONTHEIGHT + 4
LINE (0, Y)-(EndPoint, Y), RGB32(141, 142, 143)
Y = Y + 4
NEXT Counter
'Outer grid lines
X = LongName + 11: Y = StartY - 5
LINE (0, Y)-(EndPoint, Y), RGB32(141, 142, 143)
LINE (X, Y + 1)-(X, Y + (FONTHEIGHT + 8) * CurrentPageCount), RGB32(141, 142, 143)
'Assignment grid lines
LINE (X, 0)-(X, Y), RGB32(141, 142, 143)
FOR Counter = 1 TO INT((1280 - LongName) / 50)
X = X + 50
LINE (X, 0)-(X, Y), RGB32(141, 142, 143)
NEXT Counter
'More grid lines
X = LongName + 61
FOR Counter = 1 TO INT((1280 - LongName) / 50)
LINE (X, Y)-(X, Y + (FONTHEIGHT + 8) * CurrentPageCount), RGB32(141, 142, 143)
X = X + 50
NEXT Counter
LINE (X, Y)-(X, Y + (FONTHEIGHT + 8) * CurrentPageCount), RGB32(141, 142, 143)
SELECT CASE MA(Counter).AType
CASE 1: Texty = "PTS: " + STR$(MA(Counter).APts)
CASE 2: Texty = "%"
CASE 3: Texty = "COMP"
CASE 4: Texty = "LTR"
CASE 5: Texty = "F-E"
END SELECT
PrintName = TEXTTOIMAGE(Texty, FontHandle(1), Black, 0, 1)
DISPLAYIMAGE PrintName, X + 34, Y - 5, 1, 1, 90, 1
FREEIMAGE PrintName
X = X + 50
NEXT Counter
'Restore the contents of the cells and updating SA().
COLOR Black
ERASE SA
REDIM SA(AssignCount * CurrentStudents) AS SlaveAssignmentType
SlaveCounter = 0
FOR CounterY = 1 TO CurrentPageCount
FOR CounterX = 1 TO GridCount
IF GBCells(CounterX, CounterY).Entry <> 0 THEN
SlaveCounter = SlaveCounter + 1
IF GBCells(CounterX, CounterY).Entry > 0 THEN
PRINTSTRING (GBCells(CounterX, CounterY).X1 + 2, GBCells(CounterX, CounterY).Y1 + 6), STR$(GBCells(CounterX, CounterY).Entry)
SA(SlaveCounter).MPts = GBCells(CounterX, CounterY).Entry
ELSE
PRINTSTRING (GBCells(CounterX, CounterY).X1 + 2, GBCells(CounterX, CounterY).Y1 + 6), ""
SA(SlaveCounter).MPts = 0
GBCells(CounterX, CounterY).Entry = 0
END IF
SA(SlaveCounter).AID = MA(CounterX).AID
SA(SlaveCounter).UID = PrintOrder(CounterY).UID
SA(SlaveCounter).Flags = GBCells(CounterX, CounterY).Flags
SA(SlaveCounter).Flags2 = GBCells(CounterX, CounterY).Flags2
END IF
NEXT CounterX
NEXT CounterY
COLOR White
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
'New gradebook case - Overlay an F2 prompt
IF AssignCount = 0 THEN
FONT FontHandle(17)
NoAssignLen = UPRINTWIDTH("Please press F2 to create your first assignment or press F12 to exit...") / 2
LINE (640 - NoAssignLen - 17, 360 - UFONTHEIGHT / 2 - 17)-(640 + NoAssignLen + 17, 360 + UFONTHEIGHT / 2 + 17), Black, BF
LINE (640 - NoAssignLen - 15, 360 - UFONTHEIGHT / 2 - 15)-(640 + NoAssignLen + 15, 360 + UFONTHEIGHT / 2 + 15), DarkGray, BF
LINE (640 - NoAssignLen - 10, 360 - UFONTHEIGHT / 2 - 10)-(640 + NoAssignLen + 10, 360 + UFONTHEIGHT / 2 + 10), Black, BF
COLOR RGB32(212, 212, 0)
UPRINTSTRING (640 - NoAssignLen, 360 - UFONTHEIGHT / 2), "Please press F2 to create your first assignment or press F12 to exit..."
COLOR White
FONT FontHandle(2)
END IF
'Selection loop - All movement is disabled with no assignments
DO
'Reset the entering of text flag
LIMIT LIMITRATE
'Down case
IF KEYDOWN(20480) OR KEYDOWN(13) THEN
IF AssignCount <> 0 THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y < CurrentPageCount THEN LoopY = LoopY + FONTHEIGHT + 8: Sel.Y = Sel.Y + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PAUSE TIME
END IF
END IF
'Up case
IF KEYDOWN(18432) AND AssignCount <> 0 THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y > 1 THEN LoopY = LoopY - FONTHEIGHT - 8: Sel.Y = Sel.Y - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PAUSE TIME
END IF
'Right case
IF KEYDOWN(19712) AND AssignCount > Sel.X THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X < GridCount THEN LoopX = LoopX + 50: Sel.X = Sel.X + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PAUSE TIME
END IF
'Left case
IF KEYDOWN(19200) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X > 1 THEN LoopX = LoopX - 50: Sel.X = Sel.X - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PAUSE TIME
END IF
'Checking for mouse input
MOUSE "Poll"
MOUSE "Release"
'Mouse is over the boundray box pre-click
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct AND AssignCount <> 0 THEN 'Check if our mouse is moving or a button is being held
FOR CounterX = 1 TO AssignCount
FOR CounterY = 1 TO CurrentPageCount
IF M.X > GBCells(CounterX, CounterY).X1 AND M.X < GBCells(CounterX, CounterY).X2 AND_
M.Y > GBCells(CounterX, CounterY).Y1 AND M.Y < GBCells(CounterX, CounterY).Y2 THEN
M.GBX = CounterX
M.GBY = CounterY
END IF
NEXT CounterY
NEXT CounterX
'Move the highlight box only on a click and release is over the same box
IF MLButAct THEN
FOR CounterX = 1 TO AssignCount
FOR CounterY = 1 TO CurrentPageCount
IF M.X > GBCells(CounterX, CounterY).X1 AND M.X < GBCells(CounterX, CounterY).X2 AND M.Y > GBCells(CounterX, CounterY).Y1 AND M.Y < GBCells(CounterX, CounterY).Y2 AND M.GBX = CounterX AND M.GBY = CounterY THEN
MFlag = TRUE
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
Sel.X = CounterX
Sel.Y = CounterY
LoopX = GBCells(CounterX, CounterY).X1
LoopY = GBCells(CounterX, CounterY).Y1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PAUSE TIME
END IF
NEXT CounterY
NEXT CounterX
END IF
END IF
'Reload the GB to re-establish GBCells correctly
IF GBRestart THEN GBWriter "Both", AssignCount: EXIT SUB
DISPLAY
'Reset the mouse before looping
MOUSE "Loop"
'Checking for command hits
FCommand = 0
FOR Counter = 15104 TO 17152 STEP 256
FCommand = FCommand + 1
IF KEYDOWN(Counter) THEN FFlag = TRUE: EXIT FOR
NEXT Counter
'More command hits
IF NOT FFlag THEN
IF KEYDOWN(34304) THEN FCommand = 12: FFlag = TRUE
IF KEYDOWN(18688) THEN FCommand = 20: FFlag = TRUE 'Page Up - Student scroll up (page)
IF KEYDOWN(20736) THEN FCommand = 21: FFlag = TRUE 'Page Down - Student scroll down (page)
IF KEYDOWN(43) THEN FCommand = 43: FFlag = TRUE '+: Grade page scroll (right)
IF KEYDOWN(45) THEN FCommand = 45: FFlag = TRUE '-: Grade page scroll (left)
END IF
'Checking for any input into the current cell - Numbers 0-9
FOR Counter = 48 TO 57
IF KEYDOWN(Counter) THEN EnterText = TRUE: EXIT FOR
NEXT Counter
LOOP UNTIL ExitFlag OR MFlag OR EnterText OR FFlag
'Modifying a cell's contents and displaying it to the user
IF EnterText THEN
LINE (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), Black, BF
TextInput = GLIINPUT(LoopX + 2, LoopY + 6, GLINUMERIC, "", TRUE)
PRINTMODE KEEPBACKGROUND
DO
GLICLEAR
GLIUPDATE
DISPLAY
LOOP UNTIL GLIENTERED(TextInput)
GBCells(Sel.X, Sel.Y).Entry = VAL(GLIOUTPUT$(TextInput))
IF GBCells(Sel.X, Sel.Y).Entry > MA(Sel.X).APts AND MA(Sel.X).AType = 1 THEN GBCells(Sel.X, Sel.Y).Entry = 0
GLICLOSE TextInput, TRUE
WriteFlag = TRUE
END IF
'FCommand cases matches F1 - F12 as used plus a few others (pgup/pgdn/+/-).
IF FFlag THEN
PAUSE TIME
SELECT CASE FCommand
' F1 - Help
CASE 1: GBHelp
'F5 - Copy grades
CASE 5: GBCopyG Sel.X, CurrentStudents
'F6 - Clear grades
CASE 6: GBClearG Sel.X, CurrentPageCount, TRUE
'F7 - Add/Modify Comments
CASE 7: GBCommentsA
'F8 - Remove assignment
CASE 8: GBRemA Sel.X, AssignCount, CurrentPageCount
PAUSE TIME
'F9 - Add/Remove flags
CASE 9: GBFlags
'F12 - Exit and save
CASE 12: ExitFlag = TRUE
'Page Up - Student scroll up (page)
CASE 20: GBScrollS
'Page Down - Student scroll down (page)
CASE 21: GBScrollS
'+: Grade page scroll (right)
CASE 43: GBScrollA
'-: Grade page scroll (left)
CASE 45: GBScrollA
END SELECT
PAUSE TIME
END IF
'Changes made? Write/Read both files and reload GBCells
IF WriteFlag THEN GBWriter "Both", AssignCount
IF ReadFlag THEN
GBReader "Both", AssignCount, CurrentStudents
FOR Counter = 1 TO UBOUND(SA)
FOR CounterY = 1 TO CurrentStudents
FOR CounterX = 1 TO AssignCount
IF GBCells(CounterX, CounterY).UID = SA(Counter).UID AND GBCells(CounterX, CounterY).AID = SA(Counter).AID THEN
GBCells(CounterX, CounterY).Entry = SA(Counter).MPts
GBCells(CounterX, CounterY).Flags = SA(Counter).Flags
GBCells(CounterX, CounterY).Flags2 = SA(Counter).Flags2
GBCells(CounterX, CounterY).Notes = SA(Counter).Notes
END IF
NEXT CounterX
NEXT CounterY
NEXT Counter
END IF
LOOP UNTIL ExitFlag 'F12 closes gradebook
GBWriter "Both", AssignCount
END SUB
'Gradebook - Help - F1
SUB GBHelp
QUICKMESSAGE "Help"
END SUB
'Gradebook - Add assignment - F2
SUB GBAddA (Count AS INTEGER)
TYPE InputInfoType
Response AS STRING 'Refered to as Qu
Allowed AS INTEGER 'Refered to as Al
Required AS INTEGER 'Refered to as Re
END TYPE
REDIM AS InputInfoType InputInfo(0)
DIM AS MenuPosType MBox(1 TO 23)
DIM AS ACatType ACat(1 TO 10)
DIM AS STRING Qu
DIM AS INTEGER X, Y, Counter, Al, Re, CanidateHL, HLCount
DIM AS INTEGER Radio1, Radio2, Radio3, Month, Day, Year, ACatSelected, ACatSelectedCanidate
DIM AS LONG GLInput(1 TO 14), AddImage, PrintCommand
DIM AS LONG RadioButton, GrayRadio, AddScreen
DIM AS BIT Save, Verify, Cancel, MaxDisabled, WeightDisabled, Redo
'Make a space for the screen
AddScreen = NEWIMAGE(1280, 720, 32)
'Read Category info
RESTORE ACat
FOR Counter = 1 TO 10
READ ACat(Counter).AName, ACat(Counter).Color32, ACat(Counter).Custom
NEXT Counter
'Creating a radio button
RadioButton = NEWIMAGE(21, 21, 32)
DEST RadioButton
CIRCLES 10, 10, 6, White, 0, 2 * PI, 1
PAINT (10, 10), White, White
'Disabled radio button
GrayRadio = NEWIMAGE(176, 35, 32)
DEST GrayRadio
FONT FontHandle(14)
COLOR DarkGray, Black
UPRINTSTRING (30, 1), "Yes"
UPRINTSTRING (130, 1), "No"
CIRCLES 15, 17, 10, DarkGray, 0, 2 * PI, 1
CIRCLES 15, 17, 9, DarkGray, 0, 2 * PI, 1
CIRCLES 115, 17, 10, DarkGray, 0, 2 * PI, 1
CIRCLES 115, 17, 9, DarkGray, 0, 2 * PI, 1
LINE (0, 0)-(175, 34), DarkGray, B
'Background image of the add screen; used with GLI
AddImage = NEWIMAGE(1280, 720, 32)
DEST AddImage
MENUFRAME "Add Assignment"
FONT FontHandle(14)
'Building the text on screen
X = 45: Y = 65
'Set the flags for the data field
RESTORE AAss
FOR Counter = 1 TO 5
READ Qu, Al, Re
GLInput(Counter) = GLIINPUT(X, Y + FONTHEIGHT * 1.2 * Counter, Al, Qu, TRUE)
IF GLInput(Counter) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(Counter)) AS InputInfoType
InputInfo(Counter).Required = Re
InputInfo(Counter).Allowed = Al
InputInfo(Counter).Response = ""
NEXT Counter
'Mouse boxes for the top three input fields
MBox(10).X1 = X: MBox(10).Y1 = Y + FONTHEIGHT * 1.2 - 1
MBox(10).X2 = 800: MBox(10).Y2 = Y + FONTHEIGHT * 1.2 * 2 - 5
'Inital values for looping and default enteries for quicker entry
Save = FALSE
Verify = FALSE
MaxDisabled = FALSE
Radio1 = 1
Radio2 = 1
Radio3 = 2
'------------GLI Fields----------
'1 - Assignment name
'2 - Short assignmnet
'3 - Max points allowed
'7 - Weight
'8 - Due month
'9 - Due day
'10 - Due year
'11 - Assigned month
'12 - Assigned day
'13 - Assigned year
'14 - Comments
'Tomorrow's date for due
Day = VAL(MID$(DATE$, 4, 2))
Month = VAL(MID$(DATE$, 1, 2))
Year = VAL(MID$(DATE$, 9))
'Add a day to today and accordingly fall months or years forward,
SELECT CASE Day
CASE 28:
IF Year MOD 4 = 0 THEN Day = Day + 1 ELSE Day = 1: Month = Month + 1
CASE 29:
Day = 1: Month = 3
CASE 30:
Day = 1: Month = Month + 1
CASE 31:
Day = 1: IF Month = 12 THEN Month = 1: Year = Year + 1 ELSE Month = Month + 1
CASE ELSE
Day = Day + 1
END SELECT
'Verify enteries are correct loop
DO
LIMIT LIMITRATE
MOUSE "Inital"
PAUSE TIME
Redo = FALSE
'Collect enteries loop
DO
'Setting up the screen
LIMIT LIMITRATE
GLICLEAR
PUTIMAGE , AddImage
'Paint the box and print the category, if selected.
SELECT CASE ACatSelected
CASE 1: PAINT (620, 150), ACat(1).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(1).AName
CASE 2: PAINT (620, 150), ACat(2).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(2).AName
CASE 3: PAINT (620, 150), ACat(3).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(3).AName
CASE 4: PAINT (620, 150), ACat(4).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(4).AName
CASE 5: PAINT (620, 150), ACat(5).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(5).AName
CASE 6: PAINT (620, 150), ACat(6).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(6).AName
CASE 7: PAINT (620, 150), ACat(7).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(7).AName
CASE 8: PAINT (620, 150), ACat(8).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(8).AName
CASE 9: PAINT (620, 150), ACat(9).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(9).AName
CASE 10: PAINT (620, 150), ACat(10).Color32, LightGray: UPRINTSTRING (650, 139), "Category: " + ACat(10).AName
END SELECT
'Placing the radio button on screen.
SELECT CASE Radio1
CASE 1:
CLEARCOLOR Black
PUTIMAGE (240, 225), RadioButton
IF Radio2 = 3 THEN Radio2 = 1: Gli(5).DefaultColor = White
IF Radio3 = 3 THEN Radio3 = 2: Gli(6).DefaultColor = White
IF MaxDisabled THEN: Gli(3).InputText = "1000": Gli(3).CursorPosition = 4: Gli(3).DefaultColor = White
IF WeightDisabled THEN: Gli(7).InputText = "1000": Gli(7).CursorPosition = 4: Gli(7).DefaultColor = White
MaxDisabled = FALSE
WeightDisabled = FALSE
CASE 2:
CLEARCOLOR Black
PUTIMAGE (390, 225), RadioButton
IF Radio2 = 3 THEN Radio2 = 1: Gli(5).DefaultColor = White
IF Radio3 = 3 THEN Radio3 = 2: Gli(6).DefaultColor = White
IF WeightDisabled THEN: Gli(7).InputText = "1000": Gli(7).CursorPosition = 4: Gli(7).DefaultColor = White
MaxDisabled = TRUE
WeightDisabled = FALSE
CASE 3:
CLEARCOLOR Black
PUTIMAGE (630, 225), RadioButton
Radio2 = 3
Radio3 = 3
MaxDisabled = TRUE
WeightDisabled = TRUE
CASE 4:
CLEARCOLOR Black
PUTIMAGE (870, 225), RadioButton
IF Radio2 = 3 THEN Radio2 = 1: Gli(5).DefaultColor = White
Radio3 = 3
IF WeightDisabled THEN: Gli(7).InputText = "1000": Gli(7).CursorPosition = 4: Gli(7).DefaultColor = White
MaxDisabled = TRUE
WeightDisabled = FALSE
CASE 5:
CLEARCOLOR Black
PUTIMAGE (1030, 225), RadioButton
Radio2 = 3
Radio3 = 3
MaxDisabled = TRUE
WeightDisabled = TRUE
END SELECT
'Radio 2 is "Include in final grade"
'Case 3 is to disable selections based on score type
SELECT CASE Radio2
CASE 1:
CLEARCOLOR Black
PUTIMAGE (390, 263), RadioButton
CASE 2:
CLEARCOLOR Black
PUTIMAGE (490, 263), RadioButton
CASE 3:
CLEARCOLOR Black
PUTIMAGE (385, 256), GrayRadio
Gli(5).DefaultColor = DarkGray
END SELECT
'Radio 3 is "Allow extra points"
SELECT CASE Radio3
CASE 1:
CLEARCOLOR Black
PUTIMAGE (975, 263), RadioButton
CASE 2:
CLEARCOLOR Black
PUTIMAGE (1075, 263), RadioButton
CASE 3:
CLEARCOLOR Black
PUTIMAGE (970, 256), GrayRadio
Gli(6).DefaultColor = DarkGray
END SELECT
'No points? Then max points is pointless...
IF MaxDisabled THEN
Gli(3).DefaultColor = DarkGray
Gli(3).InputText = "N/AA"
IF GLICURRENT = 3 THEN GLIFORCE 7
END IF
'Can't be scaled? Then weight is pointless...
IF WeightDisabled THEN
Gli(7).DefaultColor = DarkGray
Gli(7).InputText = "N/AA"
IF GLICURRENT = 7 THEN GLIFORCE 8
END IF
GLIUPDATE
'Trappping 'Due Date Month' between 01 and 12
Month = VAL(GLIOUTPUT(GLInput(8)))
IF Month < 0 OR Month > 12 THEN
Month = VAL(MID$(DATE$, 1, 2))
Gli(8).InputText = TRIM$(STR$(Month) + "1")
Gli(8).CursorPosition = LEN(TRIM$(STR$(Month) + "1"))
END IF
'Trappping 'Due Date Day' between 01 and 31
Day = VAL(GLIOUTPUT(GLInput(9)))
IF Day < 0 OR Day > 31 THEN
Day = VAL(MID$(DATE$, 4, 2))
Gli(9).InputText = TRIM$(STR$(Day) + "1")
Gli(9).CursorPosition = LEN(TRIM$(STR$(Day) + "1"))
END IF
'Trappping 'Due Date Year' between 00 and 99
Year = VAL(GLIOUTPUT(GLInput(10)))
IF Year < 0 OR Year > 100 THEN
Year = VAL(MID$(DATE$, 9))
Gli(10).InputText = TRIM$(STR$(Year) + "1")
Gli(10).CursorPosition = LEN(TRIM$(STR$(Year) + "1"))
END IF
'Trappping 'Assigned Date Month' between 01 and 12
Month = VAL(GLIOUTPUT(GLInput(11)))
IF Month < 0 OR Month > 12 THEN
Month = VAL(MID$(DATE$, 1, 2))
Gli(11).InputText = TRIM$(STR$(Month) + "1")
Gli(11).CursorPosition = LEN(TRIM$(STR$(Month) + "1"))
END IF
'Trappping 'Assigned Date Day' between 01 and 31
Day = VAL(GLIOUTPUT(GLInput(12)))
IF Day < 0 OR Day > 31 THEN
Day = VAL(MID$(DATE$, 4, 2))
Gli(12).InputText = TRIM$(STR$(Day) + "1")
Gli(12).CursorPosition = LEN(TRIM$(STR$(Day) + "1"))
END IF
'Trappping 'Assigned Date Year' between 00 and 99
Year = VAL(GLIOUTPUT(GLInput(13)))
IF Year < 0 OR Year > 100 THEN
Year = VAL(MID$(DATE$, 9))
Gli(13).InputText = TRIM$(STR$(Year) + "1")
Gli(13).CursorPosition = LEN(TRIM$(STR$(Year) + "1"))
END IF
'Keyboard flag checks - F2 save and check if all enteris are valid in the outer loop; F12 cancels
IF KEYDOWN(15360) THEN HLCount = 21
IF KEYDOWN(34304) THEN HLCount = 22
MOUSE "Poll"
MOUSE "Release"
'Check if our mouse is moving or a button is being held
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct THEN
FOR Counter = 1 TO 23
IF M.X > MBox(Counter).X1 AND M.X < MBox(Counter).X2 AND M.Y > MBox(Counter).Y1 AND M.Y < MBox(Counter).Y2 THEN
CanidateHL = Counter
END IF
NEXT Counter
'Move the target box if clicked and held over the same "mouse box"
IF MLButAct THEN
FOR Counter = 1 TO 23
IF M.X > MBox(Counter).X1 AND M.X < MBox(Counter).X2 AND M.Y > MBox(Counter).Y1 AND M.Y < MBox(Counter).Y2 AND Counter = CanidateHL THEN
HLCount = Counter
MFlag = TRUE
END IF
NEXT Counter
END IF
END IF
MOUSE "Loop"
DISPLAY
LOOP UNTIL KEYDOWN(34304) OR KEYDOWN(15360) OR MFlag
'Process mouse click
SELECT CASE HLCount
CASE 1: Radio1 = 1
CASE 2: Radio1 = 2
CASE 3: Radio1 = 3
CASE 4: Radio1 = 4
CASE 5: Radio1 = 5
CASE 6: Radio2 = 1
CASE 7: Radio2 = 2
CASE 8: Radio3 = 1
CASE 9: Radio3 = 2
CASE 10: GLIFORCE 1
CASE 11: GLIFORCE 2
CASE 12: GLIFORCE 3
CASE 13: GLIFORCE 7
CASE 14: GLIFORCE 8
CASE 15: GLIFORCE 9
CASE 16: GLIFORCE 10
CASE 17: GLIFORCE 11
CASE 18: GLIFORCE 12
CASE 19: GLIFORCE 13
CASE 20: GLIFORCE 14
CASE 21: Save = TRUE
CASE 22: Save = FALSE: Cancel = TRUE
CASE 23: ACatSelectedCanidate = ACategory%: IF ACatSelectedCanidate <> 11 THEN ACatSelected = ACatSelectedCanidate 'Code 11 is cancel, do not overwrite.
END SELECT
'Verify that fields are vaild and required one are completed.
IF Save THEN
Save = FALSE
IF GLIOUTPUT(1) = "" THEN QUICKMESSAGE "Please give your assignment a name": Redo = TRUE
IF LEN(GLIOUTPUT(1)) > 30 THEN QUICKMESSAGE "Assignment name can only be 30 total characters long": Redo = TRUE
IF GLIOUTPUT(2) = "" THEN QUICKMESSAGE "Please give your assignment an on-screen name (short name)": Redo = TRUE
IF LEN(GLIOUTPUT(2)) > 15 THEN QUICKMESSAGE "Assignment short name can only be 10 total characters long": Redo = TRUE
IF ACatSelected = 0 THEN QUICKMESSAGE "Please select a category": Redo = TRUE
IF Radio1 = 1 AND VAL(GLIOUTPUT(3)) <= 0 THEN QUICKMESSAGE "Max points must be grater than zero (0)": Redo = TRUE
IF Radio1 = 1 OR Radio1 = 2 OR Radio1 = 4 THEN
IF VAL(GLIOUTPUT(7)) <= 0 THEN QUICKMESSAGE "Weight must be greater than zero (0)": Redo = TRUE
END IF
IF NOT Redo THEN Verify = TRUE: Save = TRUE
END IF
LOOP UNTIL Verify OR Cancel
'Code to record enteries to the MA()
IF Save THEN
Count = Count + 1
MA(Count).ARName = GLIOUTPUT(1)
MA(Count).ADName = GLIOUTPUT(2)
MA(Count).AType = Radio1
MA(Count).ACat = ACat(ACatSelected).AName
MA(Count).ACatID = ACatSelected
MA(Count).AColor = ACat(ACatSelected).Color32
IF Radio2 = 1 THEN MA(Count).ACode = 2
IF Radio3 = 1 THEN MA(Count).ACode = MA(Count).ACode + 1
IF Radio1 = 1 THEN MA(Count).APts = VAL(GLIOUTPUT(3)) ELSE MA(Count).APts = 0
IF Radio1 = 1 OR Radio1 = 2 OR Radio1 = 4 THEN MA(Count).AWght = VAL(GLIOUTPUT(7)) ELSE MA(Count).AWght = 0
MA(Count).Month = VAL(GLIOUTPUT(8))
MA(Count).Day = VAL(GLIOUTPUT(9))
MA(Count).Year = VAL(GLIOUTPUT(10))
MA(Count).AMonth = VAL(GLIOUTPUT(11))
MA(Count).ADay = VAL(GLIOUTPUT(12))
MA(Count).AYear = VAL(GLIOUTPUT(13))
MA(Count).ADetails = GLIOUTPUT(14)
Teacher.LastUsedAID = Teacher.LastUsedAID + 1
MA(Count).AID = Teacher.LastUsedAID
TEACHERWRITER
END IF
'Restore the main screen
SCREEN MainScreen: DEST MainScreen
GLICLOSE 0, -1
END SUB
'Gradebook - Copy assignment - F3
SUB GBCopyA
QUICKMESSAGE "Copy Assignment"
END SUB
'Gradebook - Modify assignment - F4
SUB GBModifyA
QUICKMESSAGE "Modify Assignment"
END SUB
'Gradebook - Copy grades - F5
SUB GBCopyG (CopyFromTo AS INTEGER, AllStudents AS INTEGER)
STATIC AS INTEGER SourceAssign
DIM AS INTEGER MessageLen, TargetAssign, Counter
DIM AS BYTE Hit
DIM AS STRING Message
'**********************************************************|
'|Programmer's note: |
'| |
'|This has not been programmed to check for different types|
'|or point max. This is something that needs to be done. |
'|*********************************************************|
'Set the source and allow the user to select the target assignment to copy to.
IF SourceAssign = 0 THEN
FONT FontHandle(17)
PAUSE TIME: PAUSE TIME
Hit = FALSE
Message = "Please press F5 again on the target assignmnet to paste grades. Grades will be overwritten. Press any key to continue..."
MessageLen = UPRINTWIDTH(Message) / 2
DO
LINE (640 - MessageLen - 17, 360 - UFONTHEIGHT / 2 - 17)-(640 + MessageLen + 17, 360 + UFONTHEIGHT / 2 + 17), Black, BF
LINE (640 - MessageLen - 15, 360 - UFONTHEIGHT / 2 - 15)-(640 + MessageLen + 15, 360 + UFONTHEIGHT / 2 + 15), DarkGray, BF
LINE (640 - MessageLen - 10, 360 - UFONTHEIGHT / 2 - 10)-(640 + MessageLen + 10, 360 + UFONTHEIGHT / 2 + 10), Black, BF
COLOR RGB32(212, 212, 0)
UPRINTSTRING (640 - MessageLen, 360 - UFONTHEIGHT / 2), Message
COLOR White
DISPLAY
IF INKEY$ <> "" THEN Hit = TRUE
LOOP UNTIL Hit
FONT FontHandle(2)
SourceAssign = CopyFromTo
'Check if the user try copying to the source. Also reset the source to 0 to allow a new source selection.
ELSEIF SourceAssign = CopyFromTo THEN
FONT FontHandle(17)
PAUSE TIME: PAUSE TIME
Hit = FALSE
Message = "Target cannot be the same as source. Please select the source again with F5. Press any key to continue..."
MessageLen = UPRINTWIDTH(Message) / 2
DO
LINE (640 - MessageLen - 17, 360 - UFONTHEIGHT / 2 - 17)-(640 + MessageLen + 17, 360 + UFONTHEIGHT / 2 + 17), Black, BF
LINE (640 - MessageLen - 15, 360 - UFONTHEIGHT / 2 - 15)-(640 + MessageLen + 15, 360 + UFONTHEIGHT / 2 + 15), DarkGray, BF
LINE (640 - MessageLen - 10, 360 - UFONTHEIGHT / 2 - 10)-(640 + MessageLen + 10, 360 + UFONTHEIGHT / 2 + 10), Black, BF
COLOR RGB32(212, 212, 0)
UPRINTSTRING (640 - MessageLen, 360 - UFONTHEIGHT / 2), Message
COLOR White
DISPLAY
IF INKEY$ <> "" THEN Hit = TRUE
LOOP UNTIL Hit
FONT FontHandle(2)
SourceAssign = 0
'Process the copy
ELSE
TargetAssign = CopyFromTo
FOR Counter = 1 TO AllStudents
GBCells(TargetAssign, Counter).Entry = GBCells(SourceAssign, Counter).Entry
NEXT Counter
SourceAssign = 0
END IF
END SUB
'Gradebook - Clear grades - F6
SUB GBClearG (ClearAssign AS INTEGER, StudentCount AS INTEGER, Prompt AS BYTE)
DIM AS STRING Message
DIM AS INTEGER MessageLen, Y
DIM AS BIT Hit, ClearGrades
IF Prompt THEN
FONT FontHandle(17)
PAUSE TIME: PAUSE TIME
Hit = FALSE: ClearGrades = FALSE
Message = "Please press F6 again to clear all grades for this assignmnet or any other key to cancel..."
MessageLen = UPRINTWIDTH(Message) / 2
DO
LINE (640 - MessageLen - 17, 360 - UFONTHEIGHT / 2 - 17)-(640 + MessageLen + 17, 360 + UFONTHEIGHT / 2 + 17), Black, BF
LINE (640 - MessageLen - 15, 360 - UFONTHEIGHT / 2 - 15)-(640 + MessageLen + 15, 360 + UFONTHEIGHT / 2 + 15), DarkGray, BF
LINE (640 - MessageLen - 10, 360 - UFONTHEIGHT / 2 - 10)-(640 + MessageLen + 10, 360 + UFONTHEIGHT / 2 + 10), Black, BF
COLOR RGB32(212, 212, 0)
UPRINTSTRING (640 - MessageLen, 360 - UFONTHEIGHT / 2), Message
COLOR White
DISPLAY
IF KEYDOWN(16384) THEN Hit = TRUE: ClearGrades = TRUE
IF INKEY$ <> "" THEN Hit = TRUE
LOOP UNTIL Hit
FONT FontHandle(2)
ELSE
ClearGrades = TRUE
END IF
'clear all grades for selected assignment
IF ClearGrades THEN
FOR Y = 1 TO StudentCount
GBCells(ClearAssign, Y).Entry = VAL("")
NEXT Y
END IF
END SUB
'Gradebook - Assingment comments - F7
SUB GBCommentsA
QUICKMESSAGE "Assignment Comments"
END SUB
'Gradebook - Remove assignment - F8
SUB GBRemA (DelAssign AS INTEGER, AssignCount AS INTEGER, StudentCount AS INTEGER)
DIM AS STRING Message
DIM AS INTEGER MessageLen, Counter, CounterX
DIM AS BIT Hit, DeleteAssignment, OOO
PAUSE TIME: PAUSE TIME
Hit = FALSE: DeleteAssignment = FALSE: OOO = FALSE
FONT FontHandle(17)
Message = "Please press F8 again to delete this assignmnet or any other key to cancel..."
MessageLen = UPRINTWIDTH(Message) / 2
DO
LINE (640 - MessageLen - 17, 360 - UFONTHEIGHT / 2 - 17)-(640 + MessageLen + 17, 360 + UFONTHEIGHT / 2 + 17), Black, BF
LINE (640 - MessageLen - 15, 360 - UFONTHEIGHT / 2 - 15)-(640 + MessageLen + 15, 360 + UFONTHEIGHT / 2 + 15), DarkGray, BF
LINE (640 - MessageLen - 10, 360 - UFONTHEIGHT / 2 - 10)-(640 + MessageLen + 10, 360 + UFONTHEIGHT / 2 + 10), Black, BF
COLOR RGB32(212, 212, 0)
UPRINTSTRING (640 - MessageLen, 360 - UFONTHEIGHT / 2), Message
COLOR White
DISPLAY
IF KEYDOWN(16896) THEN Hit = TRUE: DeleteAssignment = TRUE
IF INKEY$ <> "" THEN Hit = TRUE
LOOP UNTIL Hit
FONT FontHandle(2)
'clear all grades for selected assignment
IF DeleteAssignment THEN
GBClearG DelAssign, StudentCount, FALSE
'Remove assignmnet from MA() by not writing to file
IF AssignCount > DelAssign THEN
FOR Counter = DelAssign TO AssignCount - 1
SWAP MA(Counter), MA(Counter + 1)
NEXT Counter
END IF
AssignCount = AssignCount - 1
FOR CounterX = DelAssign TO AssignCount
FOR Counter = 1 TO StudentCount
SWAP GBCells(CounterX, Counter), GBCells(CounterX + 1, Counter)
NEXT Counter
NEXT CounterX
END IF
'Reloads the gradebook to re-establish GBCells()
GBRestart = TRUE
END SUB
'Gradebook - Flags for students - F9
SUB GBFlags
QUICKMESSAGE "Flags for students"
END SUB
'Gradebook - Scroll assignment page - +: Next page/ -: Prior page
SUB GBScrollA
QUICKMESSAGE "Assignment Scroll"
END SUB
'Gradebook - Scroll student page - Page Down: Next set of students/Page Up: Prior set of students.
SUB GBScrollS
QUICKMESSAGE "Student Scroll"
END SUB
'Valid commands - Master for Master file (*.gka) Slave
SUB GBWriter (WriteWhat AS STRING, AssignmentCount AS INTEGER)
DIM AS INTEGER Counter
'Update the .gka file
IF UCASE$(WriteWhat) = "MASTER" OR UCASE$(WriteWhat) = "BOTH" THEN
OPEN TRIM$(Teacher.LastFile) + ".gka" FOR OUTPUT AS #3
FOR Counter = 1 TO AssignmentCount
WRITE #3, MA(Counter).ARName
WRITE #3, MA(Counter).ADName
WRITE #3, MA(Counter).AType
WRITE #3, MA(Counter).ACat
WRITE #3, MA(Counter).ACatID
WRITE #3, MA(Counter).AColor
WRITE #3, MA(Counter).ACode
WRITE #3, MA(Counter).APts
WRITE #3, MA(Counter).AWght
WRITE #3, MA(Counter).Month
WRITE #3, MA(Counter).Day
WRITE #3, MA(Counter).Year
WRITE #3, MA(Counter).AMonth
WRITE #3, MA(Counter).ADay
WRITE #3, MA(Counter).AYear
WRITE #3, MA(Counter).ADetails
WRITE #3, MA(Counter).AID
NEXT Counter
CLOSE #3
END IF
'Update the .gkb file
IF UCASE$(WriteWhat) = "SLAVE" OR UCASE$(WriteWhat) = "BOTH" THEN
OPEN TRIM$(Teacher.LastFile) + ".gkb" FOR OUTPUT AS #4
FOR Counter = 1 TO SlaveCounter
WRITE #4, SA(Counter).UID
WRITE #4, SA(Counter).AID
WRITE #4, SA(Counter).MPts
WRITE #4, SA(Counter).Flags
WRITE #4, SA(Counter).Flags2
WRITE #4, SA(Counter).Notes
NEXT Counter
CLOSE #4
END IF
END SUB
SUB GBReader (ReadWhat AS STRING, AssignmentCount AS INTEGER, StudentCount AS INTEGER)
DIM AS INTEGER Counter
'Update the .gka file
IF UCASE$(ReadWhat) = "MASTER" THEN
ERASE MA
REDIM MA(1 TO 400) AS MasterAssignmentType
OPEN TRIM$(Teacher.LastFile) + ".gka" FOR INPUT AS #3
AssignmentCount = 0
WHILE NOT EOF(3)
AssignmentCount = AssignmentCount + 1
INPUT #3, MA(AssignmentCount).ARName
INPUT #3, MA(AssignmentCount).ADName
INPUT #3, MA(AssignmentCount).AType
INPUT #3, MA(AssignmentCount).ACat
INPUT #3, MA(AssignmentCount).ACatID
INPUT #3, MA(AssignmentCount).AColor
INPUT #3, MA(AssignmentCount).ACode
INPUT #3, MA(AssignmentCount).APts
INPUT #3, MA(AssignmentCount).AWght
INPUT #3, MA(AssignmentCount).Month
INPUT #3, MA(AssignmentCount).Day
INPUT #3, MA(AssignmentCount).Year
INPUT #3, MA(AssignmentCount).AMonth
INPUT #3, MA(AssignmentCount).ADay
INPUT #3, MA(AssignmentCount).AYear
INPUT #3, MA(AssignmentCount).ADetails
INPUT #3, MA(AssignmentCount).AID
WEND
CLOSE #3
END IF
'Update the .gkb file
IF UCASE$(ReadWhat) = "SLAVE" THEN
ERASE SA
REDIM SA(AssignmentCount * StudentCount) AS SlaveAssignmentType
OPEN TRIM$(Teacher.LastFile) + ".gkb" FOR INPUT AS #4
Counter = 0
WHILE NOT EOF(4)
Counter = Counter + 1
INPUT #4, SA(Counter).UID
INPUT #4, SA(Counter).AID
INPUT #4, SA(Counter).MPts
INPUT #4, SA(Counter).Flags
INPUT #4, SA(Counter).Flags2
INPUT #4, SA(Counter).Notes
WEND
CLOSE #4
END IF
END SUB
'Places assignments in Due Date order
SUB GBSort (MACount AS INTEGER)
DIM AS BYTE OOO
DIM AS INTEGER Z
DO
OOO = FALSE
FOR Z = 1 TO MACount - 1
IF MA(Z).Year > MA(Z + 1).Year THEN
SWAP MA(Z), MA(Z + 1)
OOO = TRUE
ELSEIF MA(Z).Year = MA(Z + 1).Year AND MA(Z).Month > MA(Z + 1).Month THEN
SWAP MA(Z), MA(Z + 1)
OOO = TRUE
ELSEIF MA(Z).Year = MA(Z + 1).Year AND MA(Z).Month = MA(Z + 1).Month AND MA(Z).Day > MA(Z + 1).Day THEN
SWAP MA(Z), MA(Z + 1)
OOO = TRUE
ELSEIF MA(Z).Year = MA(Z + 1).Year AND MA(Z).Month = MA(Z + 1).Month AND MA(Z).Day = MA(Z + 1).Day AND MA(Z).ACatID > MA(Z + 1).ACatID THEN
SWAP MA(Z), MA(Z + 1)
OOO = TRUE
END IF
NEXT Z
LOOP WHILE OOO
END SUB
'Connect the quads
LINE (58, 34)-(1220, 30), , BF 'Top
LINE (58, 685)-(1220, 689), , BF 'Bottom
LINE (34, 54)-(38, 665), , BF 'Left
LINE (1240, 54)-(1244, 665), , BF 'Right
END SUB
'15 selections per column, 3 columns, total of 45 options
SUB CSRoster
STATIC AS INTEGER Counter, Page, Pages, Selection
STATIC AS INTEGER X, Y, XOffset, YStep, Highlight(1 TO 500000)
DIM AS BYTE ExitLoop, F2
'Inital settings for printing and stepping
FONT FontHandle(4)
X = 39: Y = 99
XOffset = 402: YStep = FONTHEIGHT + 3
Page = 1: Selection = 1
'If student count is over 42, we need a second page.
IF NumberOfStudents > 42 THEN
Counter = 42
Pages = INT(NumberOfStudents / 42) + 1 'Total number of pages needed to display all students.
ELSE
Counter = NumberOfStudents
Pages = 1
END IF
'Draw and print the student names on a formatted background
CSrosterBg
FONT FontHandle(4)
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 14), "Back"
'Display up to the first 42 names by first name
SORT Students(), 1
FOR Counter = 1 TO Counter
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF Counter MOD 15 = 0 THEN X = X + XOffset: Y = 99
NEXT Counter
'Initial highlighted box for selection
DO
X = 39: Y = 99
GET (X, Y)-(435, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'Add page turning tools and gray out disabled commands
IF Page <> 1 THEN
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 12), "Previous page"
ELSE
COLOR DarkGray
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 12), "Previous page"
COLOR White
END IF
IF Page <> Pages AND Pages > 1 THEN
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 13), "Next page"
ELSE
COLOR DarkGray
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 13), "Next page"
COLOR White
END IF
'Add student command
COLOR Yellow
UPRINTSTRING (50, 640), "F2 - Add student to roster"
COLOR White
'Up cases
IF KEYDOWN(18432) THEN
'Remove current highlight
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'----------Rules----------
'Top of menu check - go to "back"
IF Selection MOD 45 = 1 THEN
X = 39 + XOffset * 2: Y = 99 + YStep * 14: Selection = 45 * Page
'Top of second column (go back to the bottom of the first one)
ELSEIF Selection MOD 45 = 16 THEN
X = X - XOffset: Y = 99 + YStep * 14: Selection = Selection - 1
'Top of third column (go back to the bottom of the second one)
ELSEIF Selection MOD 45 = 31 THEN
X = X - XOffset: Y = 99 + YStep * 14: Selection = Selection - 1
'Multiple pages and on the first page; need to skip the disabled command
ELSEIF Pages > 1 AND Page = 1 AND Selection MOD 45 = 44 THEN
Y = Y - 2 * YStep: Selection = Selection - 2
'Multiple pages and on the last page; need to skip the disabled command
ELSEIF Pages > 1 AND Page = Pages AND Selection MOD 45 = 0 THEN
Y = Y - 2 * YStep: Selection = Selection - 2
'Mulitple pages and less than a full page of students; skip blanks.
ELSEIF Pages > 1 AND Page = Pages AND (Selection - 2 * (Page - 1)) MOD 43 = 0 THEN
'This locates where the last stuend is and sets the X and Y properly (Multi page)
IF (NumberOfStudents + (Pages - 1) * 3) MOD 45 < 16 THEN
X = 39: Y = 99 + ((NumberOfStudents + (Pages - 1) * 3) MOD 45 - 1) * YStep
ELSEIF (NumberOfStudents + (Pages - 1) * 3) MOD 45 < 31 THEN
X = 39 + XOffset: Y = 99 + ((NumberOfStudents + (Pages - 1) * 3) MOD 45 - 16) * YStep
ELSE
X = 39 + 2 * XOffset: Y = 99 + ((NumberOfStudents + (Pages - 1) * 3) MOD 45 - 31) * YStep
END IF
Selection = NumberOfStudents + 3 * (Pages - 1)
'One page and both commands are disabled
ELSEIF Pages = 1 AND Selection = 45 AND NumberOfStudents = 42 THEN
Y = Y - 3 * YStep: Selection = Selection - 3
'One page and both commands are disabled and less than 42 students
ELSEIF Pages = 1 AND Selection = 45 AND NumberOfStudents < 42 THEN
'This locates where the last stuend is and sets the X and Y properly
IF NumberOfStudents < 16 THEN
X = 39: Y = 99 + (NumberOfStudents - 1) * YStep
ELSEIF NumberOfStudents < 31 THEN
X = 39 + XOffset: Y = 99 + (NumberOfStudents - 16) * YStep
ELSE
X = 39 + 2 * XOffset: Y = 99 + (NumberOfStudents - 31) * YStep
END IF
Selection = NumberOfStudents
'Normal moving up case
ELSE
Y = Y - YStep: Selection = Selection - 1
END IF
'Add new highlight and flush buffer
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
PAUSE TIME
END IF
'Down case
IF KEYDOWN(20480) THEN
'Remove current highlight
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'-----------Rules----------
'Bottom of third column - go to the top of the first
IF Selection MOD 45 = 0 THEN
X = 39: Y = 99: Selection = 1 + ((Page - 1) * 45)
'Bottom of second column - go to the top of the third
ELSEIF Selection MOD 45 = 30 THEN
IF Selection + 1 >= NumberOfStudents + 3 * (Page - 1) THEN
ELSE
X = X + XOffset: Y = 99: Selection = Selection + 1
END IF
'Bottom of first column - go to the top of the second
ELSEIF Selection MOD 45 = 15 THEN
IF Selection + 1 >= NumberOfStudents + 3 * (Page - 1) THEN
ELSE
X = X + XOffset: Y = 99: Selection = Selection + 1
END IF
'Multiple pages and on the first page; need to skip the disabled command (prev page)
ELSEIF Pages > 1 AND Page = 1 AND Selection = 42 THEN
X = 39 + 2 * XOffset: Y = 99 + 13 * YStep: Selection = 44
'Multiple pages and on the last page; skip to prev page
ELSEIF Pages > 1 AND Page = Pages AND Selection = NumberOfStudents + 3 * (Page - 1) THEN
X = 39 + 2 * XOffset: Y = 99 + 12 * YStep: Selection = 45 * Page - 2
'Final page, skip disabled command (next page)
ELSEIF Pages > 1 AND Page = Pages AND Selection MOD 45 = 43 THEN
Y = Y + 2 * YStep: Selection = Selection + 2
'One page and both commands are disabled
ELSEIF Pages = 1 AND Selection = NumberOfStudents THEN
X = 39 + 2 * XOffset: Y = 99 + 14 * YStep: Selection = 45
'Normal down case
ELSE
Y = Y + YStep: Selection = Selection + 1
END IF
'Add new highlight and flush buffer
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
PAUSE TIME
END IF
'Right case
IF KEYDOWN(19712) THEN
'Remove current highlight
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'-----------Rules----------
'First page, no prev command, ignore input
IF Selection MOD 45 = 28 AND Page = 1 THEN
'Last page, no next command, ignore input
ELSEIF Selection MOD 45 = 29 AND Page = Pages THEN
'Normal right case
ELSEIF NumberOfStudents + (Page - 1) * 3 >= Selection + 15 AND Selection MOD 45 < 31 AND Selection MOD 45 <> 0 THEN
X = X + XOffset: Selection = Selection + 15
'If the position does not exisit, jump to back
ELSE
X = 39 + XOffset * 2: Y = 99 + YStep * 14: Selection = 45 * Page
END IF
'Add new highlight and flush buffer
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
PAUSE TIME
END IF
'Left case
IF KEYDOWN(19200) THEN
'Remove current highlight
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'-----------Rules----------
'Jumping to back if in the first column
IF Selection MOD 45 < 16 AND Selection MOD 45 <> 0 THEN
X = 39 + XOffset * 2: Y = 99 + YStep * 14: Selection = 45 * Page
'From second column to first - must be populated if selection is here
ELSEIF Selection MOD 45 < 31 AND Selection MOD 45 <> 0 THEN
X = X - XOffset: Selection = Selection - 15
'move from commands to the 2nd or 1st column
ELSEIF Selection MOD 45 = 44 OR Selection MOD 45 = 43 OR Selection MOD 45 = 0 THEN
'Populated
IF Selection - 15 <= NumberOfStudents + (Page - 1) * 3 THEN
X = X - XOffset: Selection = Selection - 15
'Check the bottom of the first coloumn
ELSEIF Selection - 3 <= NumberOfStudents + (Page - 1) * 3 THEN
X = X - 2 * XOffset: Selection = Selection - 30
'go to first entry
ELSE
X = 39: Y = 99: Selection = Page * 45 - 44
END IF
'third column non-commands, known target is populated
ELSE
X = X - XOffset: Selection = Selection - 15
END IF
'Add new highlight and flush buffer
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
PAUSE TIME
END IF
'Checking if user wants add student
IF KEYDOWN(15360) THEN F2 = TRUE
'Refresh screen
DISPLAY
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) OR F2
'Dehighlight choice
GET (X, Y)-(X + 396, Y + YStep), Highlight()
PUT (X, Y), Highlight(), PRESET
'Execute choice
IF NOT F2 THEN
SELECT CASE Selection MOD 45
'Selecting back
CASE 0: ExitLoop = TRUE
'Selecting a student
CASE 1 TO 42:
SHOWSTUDENT Selection - ((Page - 1) * 3)
IF NumberOfStudents = 0 THEN EXIT SUB
X = 39: Y = 99
CSrosterBg
FONT FontHandle(4)
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 14), "Back"
IF Page <> Pages THEN
FOR Counter = 1 + ((Page - 1) * 42) TO Page * 42
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF Page > 1 THEN
IF (Counter - 42 * (Page)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
ELSE
IF Counter MOD 15 = 0 THEN X = X + XOffset: Y = 99
END IF
NEXT Counter
'At the final page
ELSE
FOR Counter = 1 + ((Page - 1) * 42) TO NumberOfStudents
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF Page > 1 THEN
IF (Counter - 42 * (Page)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
ELSE
IF Counter MOD 15 = 0 THEN X = X + XOffset: Y = 99
END IF
NEXT Counter
END IF
'Prior page
CASE 43:
'Reset X and Y and screen
X = 39: Y = 99
CSrosterBg
FONT FontHandle(4)
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 14), "Back"
Page = Page - 1
'Display the prior 42 names
FOR Counter = 1 + ((Page - 1) * 42) TO Page * 42
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF (Counter - 42 * (Page - 1)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
NEXT Counter
'Next Page
CASE 44:
'Reset X and Y and screen
X = 39: Y = 99
CSrosterBg
FONT FontHandle(4)
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 14), "Back"
Page = Page + 1
'Display the next 42 names if not final page
IF Page <> Pages THEN
FOR Counter = 1 + ((Page - 1) * 42) TO Page * 42
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF (Counter - 42 * (Page - 1)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
NEXT Counter
'At the final page
ELSE
FOR Counter = 1 + ((Page - 1) * 42) TO NumberOfStudents
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF (Counter - 42 * (Page - 1)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
NEXT Counter
END IF
END SELECT
'Adding a student
ELSE
'Add at the end of file
OPEN TRIM$(Teacher.LastFile) + ".gkn" FOR APPEND AS #1
ADDSTUDENT
CLOSE #1
'Reset the Add Student flag, reestablish the student database in the proper order
F2 = FALSE
ERASE Students
REDIM AS StudentsType Students(1 TO 100)
OPEN TRIM$(Teacher.LastFile) + ".gkn" FOR INPUT AS #1
READSTUDENTDATA
CLOSE #1
SORT Students(), 1
'Restore the roster to screen
X = 39: Y = 99
CSrosterBg
FONT FontHandle(4)
UPRINTSTRING (X + 8 + XOffset * 2, Y + YStep * 14), "Back"
'Not final page
IF Page <> Pages THEN
FOR Counter = 1 + ((Page - 1) * 42) TO Page * 42
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF Page > 1 THEN
IF (Counter - 42 * (Page)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
ELSE
IF Counter MOD 15 = 0 THEN X = X + XOffset: Y = 99
END IF
NEXT Counter
'At the final page
ELSE
FOR Counter = 1 + ((Page - 1) * 42) TO NumberOfStudents
UPRINTSTRING (X + 8, Y), TRIM$(Students(Counter).FirstName) + " " + TRIM$(Students(Counter).LastName)
Y = Y + YStep
IF Page > 1 THEN
IF (Counter - 42 * (Page)) MOD 15 = 0 THEN X = X + XOffset: Y = 99
ELSE
IF Counter MOD 15 = 0 THEN X = X + XOffset: Y = 99
END IF
NEXT Counter
END IF
END IF
'Reset selection to the top of the current page
Selection = (Page - 1) * 45 + 1
PAUSE TIME
LOOP UNTIL ExitLoop
END SUB
'Shows students data and gives options for mod
SUB SHOWSTUDENT (Student AS INTEGER)
DIM AS BIT ExitFlag
DIM AS INTEGER Counter
DIM AS STRING StudentFile
'Initalize the sub
ROSTERBG FALSE, "Roster Info"
ExitFlag = FALSE
FONT FontHandle(4)
'Add directions to screen
FONT FontHandle(3)
COLOR _RGB32(195, 254, 14)
UPRINTSTRING (75, 100 + 17.5 * UFONTHEIGHT), "Press 'M' to modify,"
UPRINTSTRING (75, 100 + 18.5 * UFONTHEIGHT), "Press 'D' to delete,"
UPRINTSTRING (75, 100 + 19.5 * UFONTHEIGHT), "or any other key to go back."
FONT FontHandle(4)
COLOR White
DISPLAY
PAUSE TIME
'Ask the user to modify, delete or exit out.
DO
LIMIT LIMITRATE
'Modify - Press M
IF KEYDOWN(109) OR KEYDOWN(77) THEN
DIM AS INTEGER X, DayOffset, YearOffset
DIM AS STRING Blank8, Blank20, Blank30
DIM AS BYTE MonthDay
DIM AS StudentsType Temp
'Null stings to check VS no input and other intialization
Blank8 = " "
Blank20 = " "
Blank30 = " "
MonthDay = FALSE
FONT FontHandle(10)
X = 75: DayOffset = UPRINTWIDTH("Month "): YearOffset = UPRINTWIDTH("Month Day ")
'Buffer flusb
PAUSE TIME
'Update the background with relevant info
FONT FontHandle(3)
COLOR Black
LINE (70, 595)-(400, 680), , BF
COLOR _RGB32(196, 255, 14)
UPRINTSTRING (75, 100 + 18 * UFONTHEIGHT), "Please update the data fields that need updating only."
UPRINTSTRING (75, 100 + 19 * UFONTHEIGHT), "All other data will remain unchanged. Press enter to go to the next field."
FONT FontHandle(4)
COLOR White
AUTODISPLAY
'Modify data collection
LOCATE 7, X + 200, 1: INPUT "", Temp.LastName
DO
LOCATE 7, X + 470, 1: INPUT "", Temp.Month
LOOP UNTIL Temp.Month >= 0 AND Temp.Month < 13
DO
LOCATE 7, X + 470 + DayOffset, 1: INPUT "", Temp.Day
SELECT CASE Temp.Month
CASE 1, 3, 5, 7, 8, 10, 12: IF Temp.Day < 32 THEN MonthDay = TRUE
CASE 2: IF Temp.Day < 29 THEN MonthDay = TRUE 'Legally, you can't have a birthday on the 29th...
CASE ELSE: IF Temp.Day < 31 THEN MonthDay = TRUE
END SELECT
LOOP UNTIL Temp.Month >= 0 AND MonthDay
DO
LOCATE 7, X + 470 + YearOffset, 1: INPUT "", Temp.Year
LOOP UNTIL Temp.Year = 0 OR Temp.Year > 1999 AND Temp.Year < 2100 'Hard coded for this century!
LOCATE 7, X + 750, 1: INPUT "", Temp.NickName
LOCATE 10, X, 1: INPUT "", Temp.FirstName
LOCATE 10, X + 275, 1: INPUT "", Temp.MiddleName
LOCATE 10, X + 515, 1: INPUT "", Temp.AddInfo
LOCATE 14, X, 1: INPUT "", Temp.MomName
LOCATE 14, X + 350, 1: INPUT "", Temp.MomPhone
LOCATE 14, X + 650, 1: INPUT "", Temp.MomEmail
LOCATE 17, X, 1: INPUT "", Temp.DadName
LOCATE 17, X + 350, 1: INPUT "", Temp.DadPhone
LOCATE 17, X + 650, 1: INPUT "", Temp.DadEmail
'If no entry, update the temp with the current data to updating
IF Temp.LastName = Blank20 THEN Temp.LastName = Students(Student).LastName
IF Temp.Month = 0 THEN Temp.Month = Students(Student).Month
IF Temp.Day = 0 THEN Temp.Day = Students(Student).Day
IF Temp.Year = 0 THEN Temp.Year = Students(Student).Year
IF Temp.NickName = Blank20 THEN Temp.NickName = Students(Student).NickName
IF Temp.FirstName = Blank20 THEN Temp.FirstName = Students(Student).FirstName
IF Temp.MiddleName = Blank20 THEN Temp.MiddleName = Students(Student).MiddleName
IF Temp.AddInfo = Blank30 + Blank30 + Blank20 + Blank8 THEN Temp.AddInfo = Students(Student).AddInfo
IF Temp.MomName = Blank30 THEN Temp.MomName = Students(Student).MomName
IF Temp.MomPhone = Blank20 THEN Temp.MomPhone = Students(Student).MomPhone
IF Temp.MomEmail = Blank30 + Blank8 THEN Temp.MomEmail = Students(Student).MomEmail
IF Temp.DadName = Blank30 THEN Temp.DadName = Students(Student).DadName
IF Temp.DadPhone = Blank20 THEN Temp.DadPhone = Students(Student).DadPhone
IF Temp.DadEmail = Blank30 + Blank8 THEN Temp.DadEmail = Students(Student).DadEmail
'Add directions to screen
FONT FontHandle(3)
COLOR _RGB32(147, 237, 255)
UPRINTSTRING (75, 100 + 19 * UFONTHEIGHT), "This is the proposed update."
UPRINTSTRING (75, 100 + 20 * UFONTHEIGHT), "Press 'A' to accept, any other key to discard changes."
FONT FontHandle(4)
COLOR White
PAUSE TIME
DISPLAY
'Accept user input and save with 'A' or discard with any other input
DO
LIMIT LIMITRATE
IF KEYDOWN(97) OR KEYDOWN(65) THEN
UPDATEROSTER Temp, Student
StudentFile = TRIM$(Teacher.LastFile) + ".gkn"
OPEN StudentFile FOR OUTPUT AS #1
FOR Counter = 1 TO NumberOfStudents
WRITESTUDENTDATA Students(Counter)
NEXT Counter
CLOSE #1
QUICKMESSAGE "Entry updated succesfully!"
ExitFlag = TRUE
ELSEIF INKEY$ <> "" THEN
QUICKMESSAGE "Changes discarded, please try again if desired."
ExitFlag = TRUE
END IF
LOOP UNTIL ExitFlag
DISPLAY
'---------------Delete - Press D--------------------
ELSEIF KEYDOWN(100) OR KEYDOWN(68) THEN
'Buffer flush
PAUSE TIME
'Final warning to delete, use the other hand to avoid accidents.
FONT FontHandle(3)
COLOR Black
LINE (70, 595)-(400, 680), , BF
COLOR _RGB32(255, 79, 79)
UPRINTSTRING (75, 100 + 18 * UFONTHEIGHT), "Deleting student from list. Records will be kept. Can be undone."
UPRINTSTRING (75 + UPRINTWIDTH("Deleting student from list. Records will be kept. Can be undone.") / 2 - UPRINTWIDTH("ARE YOU SURE") / 2, 100 + 19.5 * UFONTHEIGHT), "ARE YOU SURE?"
UPRINTSTRING (75, 100 + 21 * UFONTHEIGHT), "Press 'K' to confirm, any other key to abort deletion. "
DISPLAY
FONT FontHandle(4)
COLOR White
'Process user's choice
DO
LIMIT LIMITRATE
'K hit, delete confirmed.
IF KEYDOWN(107) OR KEYDOWN(75) THEN
'Open the file to hide the student
StudentFile = TRIM$(Teacher.LastFile) + ".gkn"
OPEN StudentFile FOR OUTPUT AS #1
'UID is flipped to negative to indicate an inactive student.
Students(Student).UID = -Students(Student).UID
FOR Counter = 1 TO NumberOfStudents
WRITESTUDENTDATA Students(Counter)
NEXT Counter
'Close the file, reopen for input, clear Students, estore with a fresh call, and infomed the user
CLOSE #1
OPEN StudentFile FOR INPUT AS #1
REDIM AS StudentsType Students(1 TO 100)
READSTUDENTDATA
CLOSE #1
SORT Students(), 1
ExitFlag = TRUE
QUICKMESSAGE "Deletion confirmed. File updated succesfully!"
'Aborting out
ELSEIF INKEY$ <> "" THEN
ExitFlag = TRUE
QUICKMESSAGE "Deletion cancelled. Try again if desired."
END IF
LOOP UNTIL ExitFlag = TRUE
'---------------Exit out the loop with any other key hit-------------
ELSEIF KEYHIT THEN
ExitFlag = TRUE
END IF
LOOP UNTIL ExitFlag
END SUB
'Changes a student's data with another. Data source, destination postion
SUB UPDATEROSTER (DataSource AS StudentsType, Student AS INTEGER)
IF UBOUND(Students) <= Student THEN REDIM PRESERVE Students(Student + 1) AS StudentsType
Students(Student).NickName = DataSource.NickName
Students(Student).Month = DataSource.Month
Students(Student).Day = DataSource.Day
Students(Student).Year = DataSource.Year
Students(Student).AddInfo = DataSource.AddInfo
Students(Student).FirstName = DataSource.FirstName
Students(Student).MiddleName = DataSource.MiddleName
Students(Student).LastName = DataSource.LastName
Students(Student).MomName = DataSource.MomName
Students(Student).MomPhone = DataSource.MomPhone
Students(Student).MomEmail = DataSource.MomEmail
Students(Student).DadName = DataSource.DadName
Students(Student).DadPhone = DataSource.DadPhone
Students(Student).DadEmail = DataSource.DadEmail
Students(Student).UID = DataSource.UID
END SUB
'Verifies an active roster (or creates one), loads it into memory, and proceeds to the menu C_CSOPTIONS
SUB CSSelect
DIM AS STRING * 20 Blank20 'Null string
DIM AS STRING * 1 Confirm
IF FILEEXISTS(TRIM$(Teacher.LastFile) + ".gkn") AND FILEEXISTS(TRIM$(Teacher.LastFile) + ".gka")_
AND FILEEXISTS(TRIM$(Teacher.LastFile) + ".gkb") THEN
OPEN TRIM$(Teacher.LastFile) + ".gkn" FOR INPUT AS #1
IF LOF(1) = 0 THEN
CLS
CLOSE #1
OPEN TRIM$(Teacher.LastFile) + ".gkn" FOR OUTPUT AS #1
AUTODISPLAY
PUTIMAGE , BGImage
Menu(1) = "Roster Creation"
Menu(2) = "*"
MENUMAKER Menu()
FONT FontHandle(5)
UPRINTSTRING (640 - UPRINTWIDTH("No roster data detected.") / 2, 270), "No roster data detected."
UPRINTSTRING (640 - UPRINTWIDTH("Would you like to enter data now?") / 2, 270 + UFONTHEIGHT * 1.5), "Would you like to enter data now?"
UPRINTSTRING (640 - UPRINTWIDTH("Y/N:"), 268 + UFONTHEIGHT * 3), "Y/N:"
NumberOfStudents = 0
PAUSE TIME
DO
LOCATE 10, 660, 1: INPUT "", Confirm
LOOP UNTIL UCASE$(Confirm) = "Y" OR UCASE$(Confirm) = "N"
PAUSE TIME
IF UCASE$(Confirm) = "Y" THEN
ADDSTUDENT
CLOSE #1
ELSE
QUICKMESSAGE "Roster data must be inputed before you can countinue."
END IF
ELSE
READSTUDENTDATA
CLOSE #1
C_CSOPTIONS
END IF
ELSE
QUICKMESSAGE CHR$(34) + TRIM$(Teacher.LastFile) + CHR$(34) + " class set is missing a file."
NumberOfStudents = 0
Teacher.LastFile = Blank20
TEACHERWRITER
END IF
END SUB
SUB CSNew
DIM AS STRING FileCanidate, NameList, Master, Slave
DIM AS STRING * 1 Confirm
Menu(1) = "New Class Set"
Menu(2) = "*"
'Create the new class set (3 files, roster, master, and slave assignments
DO
CLS
PUTIMAGE , BGImage
MENUMAKER Menu()
AUTODISPLAY
FONT FontHandle(4)
UPRINTSTRING (50, 250), "This will help you setup (or copy) a roster which will be tied to this gradebook. In"
UPRINTSTRING (50, 250 + UFONTHEIGHT), "addition, all reports will be only drawn from the data and grades from this class set."
UPRINTSTRING (50, 250 + UFONTHEIGHT * 2), "Type " + CHR$(34) + "EXIT" + CHR$(34) + " to cancel this operation."
UPRINTSTRING (50, 232 + UFONTHEIGHT * 4), "What do you wish to call the class set?"
PAUSE TIME
LOCATE 13, 515, 1: INPUT "", FileCanidate
IF TRIM$(UCASE$(FileCanidate)) = "EXIT" THEN EXIT SUB
IF NOT ISVALID(FileCanidate) THEN QUICKMESSAGE "Filename: " + CHR$(34) + FileCanidate + CHR$(34) + " is not valid, please try again."
LOOP UNTIL ISVALID(FileCanidate)
DISPLAY
FileCanidate = UCASE$(MID$(FileCanidate, 1, 1)) + RIGHT$(FileCanidate, LEN(FileCanidate) - 1)
NameList = FileCanidate + ".gkn"
Master = FileCanidate + ".gka"
Slave = FileCanidate + ".gkb"
IF FILEEXISTS(NameList) THEN
QUICKMESSAGE "Class set exists, open with " + CHR$(34) + "Open another class set" + CHR$(34) + " on the prior screen."
EXIT SUB
END IF
OPEN NameList FOR OUTPUT AS #1
OPEN Master FOR BINARY AS #3
OPEN Slave FOR BINARY AS #4
CLS
'Check if the user is ready to enter the roster details now or later.
Menu(1) = "New Roster"
Menu(2) = "*"
DO
CLS
MENUMAKER Menu()
AUTODISPLAY
FONT FontHandle(4)
UPRINTSTRING (50, 250), "The basic setup is complete. Before the gradebook and accompanying reports can"
UPRINTSTRING (50, 250 + UFONTHEIGHT), "be used, the class needs first and last names to be entered."
UPRINTSTRING (50, 250 + UFONTHEIGHT * 2), "For the other reports to be useful, all fields should be filled."
UPRINTSTRING (50, 250 + UFONTHEIGHT * 3), "Are you ready to enter roster details or copy an exisiting roster now?"
UPRINTSTRING (50, 259 + UFONTHEIGHT * 5), "Press Y - New Students, C - Copy a roster, and N - Not now: "
PAUSE TIME
LOCATE 15, 765, 1: INPUT "", Confirm
Confirm = UCASE$(Confirm)
LOOP UNTIL Confirm = "Y" OR Confirm = "N" OR Confirm = "C"
'Exwcute choice
SELECT CASE Confirm
CASE "Y":
ADDSTUDENT
'Update our quick open with the new file set,
Teacher.LastFile = FileCanidate
TEACHERWRITER
'Close files
CLOSE #1, #3, #4
CASE "C":
'Close files
CLOSE #1, #3, #4
'Clone the name list
COPYFILE FileCanidate
END SELECT
END SUB
'Copies a given roster to another file
SUB COPYFILE (DestFile AS STRING)
DIM AS STRING SourceFile
DIM AS INTEGER Counter
QUICKMESSAGE "Select the source file to copy from on the next screen"
SourceFile = CSFile$(DestFile)
'User selected 'cancel'
IF SourceFile = "" THEN
QUICKMESSAGE "Copy roster aborted. Please add names when ready."
EXIT SUB
END IF
'File must be edited to provide different UIDs than the soruce file - Import data
OPEN DestFile FOR INPUT AS #1
ERASE Students
REDIM AS StudentsType Students(1 TO 100)
READSTUDENTDATA
CLOSE #1
'Update with new UIDs and save to file
OPEN DestFile FOR OUTPUT AS #1
FOR Counter = 1 TO NumberOfStudents
Teacher.LastUsedUID = Teacher.LastUsedUID + 1
IF Students(Counter).UID < 0 THEN Students(Counter).UID = -Teacher.LastUsedUID ELSE Students(Counter).UID = Teacher.LastUsedUID
WRITESTUDENTDATA Students(Counter)
NEXT Counter
TEACHERWRITER
CLOSE #1
QUICKMESSAGE "Roster copied successfully."
END SUB
SUB CSrosterBg
DIM AS STRING Titlee
Titlee = "Student Roster"
FONT FontHandle(7)
CLS
PUTIMAGE , BGImage
'Title of the page
UPRINTSTRING (640 - UPRINTWIDTH(Titlee) / 2, 30), Titlee
'Connect the quads and line splits
LINE (58, 34)-(1220, 30), , BF 'Top
LINE (38, 98)-(1240, 94), , BF 'Under the word
LINE (34, 625)-(1244, 629), , BF 'Bottom
LINE (34, 54)-(38, 625), , BF 'Left
LINE (402 + 34, 98)-(402 + 38, 625), , BF 'Left-center
LINE (402 * 2 + 34, 98)-(402 * 2 + 34 + 4, 625), , BF 'Right-center
LINE (1240, 54)-(1244, 625), , BF 'Right
END SUB
SUB ADDSTUDENT
DIM AS MenuPosType MBox(1 TO 18)
DIM AS StudentsType NewStudent
DIM AS STRING Texty
DIM AS INTEGER LongPrompt, Allowed, Counter, X, Y, StartY, CanidateHL, HLCount
DIM AS INTEGER ColorFade, StudentCounterX, StudentCounterY
DIM AS LONG GL(1 TO 14), Buttons(1 TO 4), NewStudentBG
DIM AS DOUBLE TimeStart, TimeEnd
DIM AS BIT Save, Verify, AddAnother, Success, Redo, Cancel, Fade, MonthDay
'Build the buttons
RESTORE AddButtons
FOR Counter = 1 TO 4
Buttons(Counter) = NEWIMAGE(200, 50, 32)
DEST Buttons(Counter)
PRINTMODE KEEPBACKGROUND
FONT FontHandle(3)
LINE (0, 0)-(199, 49), RGB32(210, 210, 210), BF
LINE (0, 0)-(199, 49), Gray, B
READ Texty
COLOR Black
UPRINTSTRING (100 - UPRINTWIDTH(Texty) / 2, 25 - UFONTHEIGHT / 2), Texty
NEXT Counter
'Student info
LINE (50, 125)-(700, 600), RGB32(210, 210, 210), B
LINE (50, 125)-(700, 175), RGB32(210, 210, 210), BF
Texty = "Student Information"
COLOR Black
UPRINTSTRING (375 - UPRINTWIDTH(Texty) / 2, 150 - UFONTHEIGHT / 2), Texty
LongPrompt = PRINTWIDTH("Date of birth (MM/DD/YY): ")
'Student info section
FONT FontHandle(3)
COLOR White
StartY = 195
X = LongPrompt + 60: Y = StartY
FOR Counter = 1 TO 5
READ Texty, Allowed
UPRINTSTRING (X - PRINTWIDTH(Texty), Y), Texty
GL(Counter) = GLIINPUT(X, Y + 3, Allowed, "", TRUE)
MBox(Counter).X1 = 60: MBox(Counter).Y1 = Y - 2
MBox(Counter).X2 = 690: MBox(Counter).Y2 = Y + UFONTHEIGHT + 2
Y = Y + 60
NEXT Counter
MBox(5).X2 = X + 28
READ Texty, Allowed
Y = Y - 60
UPRINTSTRING (X + 28, Y), "/"
GL(6) = GLIINPUT(X + 38, Y + 3, Allowed, "", TRUE)
MBox(6).X1 = X + 33: MBox(6).Y1 = Y - 2
MBox(6).X2 = X + 67: MBox(6).Y2 = Y + UFONTHEIGHT + 2
READ Texty, Allowed
UPRINTSTRING (X + 68, Y), "/"
GL(7) = GLIINPUT(X + 78, Y + 3, Allowed, "", TRUE)
MBox(7).X1 = X + 74: MBox(7).Y1 = Y - 2
MBox(7).X2 = X + 125: MBox(7).Y2 = Y + UFONTHEIGHT + 2
READ Texty, Allowed
Y = Y + 60
UPRINTSTRING (X - PRINTWIDTH(Texty), Y), Texty
GL(8) = GLIINPUT(X, Y + 3, Allowed, "", TRUE)
MBox(8).X1 = 60: MBox(8).Y1 = Y - 2
MBox(8).X2 = 690: MBox(8).Y2 = Y + UFONTHEIGHT + 2
'Guardian info
LINE (740, 125)-(1229, 600), RGB32(210, 210, 210), B
LINE (740, 125)-(1229, 175), RGB32(210, 210, 210), BF
FONT FontHandle(14)
Texty = "Contact Information"
COLOR Black
UPRINTSTRING (985 - UPRINTWIDTH(Texty) / 2, 150 - UFONTHEIGHT / 2), Texty
FONT FontHandle(3)
COLOR White
LongPrompt = PRINTWIDTH("Mother/Guardian phone: ")
X = LongPrompt + 750: Y = StartY
'Mother's section
FOR Counter = 9 TO 11
READ Texty, Allowed
UPRINTSTRING (X - PRINTWIDTH(Texty), Y), Texty
GL(Counter) = GLIINPUT(X, Y + 3, Allowed, "", TRUE)
MBox(Counter).X1 = 750: MBox(Counter).Y1 = Y - 2
MBox(Counter).X2 = 1219: MBox(Counter).Y2 = Y + UFONTHEIGHT + 2
Y = Y + 60
NEXT Counter
Y = Y + 60
'Father's section
FOR Counter = 12 TO 14
READ Texty, Allowed
UPRINTSTRING (X - PRINTWIDTH(Texty), Y), Texty
GL(Counter) = GLIINPUT(X, Y + 3, Allowed, "", TRUE)
MBox(Counter).X1 = 750: MBox(Counter).Y1 = Y - 2
MBox(Counter).X2 = 1219: MBox(Counter).Y2 = Y + UFONTHEIGHT + 2
Y = Y + 60
NEXT Counter
'Restore main screen
DEST MainScreen
FONT FontHandle(3)
'Image, Mouse clicks and verfication
DO
LIMIT LIMITRATE
MOUSE "Inital"
PAUSE TIME
'Reset all bits to false except fade
IF Success THEN ColorFade = 255: Fade = TRUE: TimeStart = TIMER
Redo = FALSE: AddAnother = FALSE: Verify = FALSE: Save = FALSE: Cancel = FALSE: MonthDay = FALSE: Success = FALSE
'Data collection for the student
DO
LIMIT LIMITRATE
GLICLEAR
PUTIMAGE , NewStudentBG
'Success image
IF Fade THEN
FONT FontHandle(14)
LINE (910, 44)-(1210, 104), RGB32(ColorFade, ColorFade, ColorFade), B
LINE (915, 49)-(1205, 99), RGB32(ColorFade, ColorFade, ColorFade), B
PAINT (911, 45), RGB32(ColorFade, ColorFade, ColorFade), RGB32(ColorFade, ColorFade, ColorFade)
COLOR RGB32(ColorFade, ColorFade, ColorFade)
UPRINTSTRING (1060 - UPRINTWIDTH("Written succesfully") / 2, 74 - UFONTHEIGHT / 2), "Written succesfully"
TimeEnd = TIMER - 3
IF TimeStart < TimeEnd THEN ColorFade = ColorFade - 5
COLOR White
FONT FontHandle(3)
IF ColorFade = 0 THEN Fade = FALSE
END IF
'Check if our mouse is moving or a button is being held
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct THEN
FOR Counter = 1 TO 18
IF M.X > MBox(Counter).X1 AND M.X < MBox(Counter).X2 AND M.Y > MBox(Counter).Y1 AND M.Y < MBox(Counter).Y2 THEN
CanidateHL = Counter
END IF
NEXT Counter
'Move the target box if clicked and held over the same "mouse box"
IF MLButAct THEN
FOR Counter = 1 TO 18
IF M.X > MBox(Counter).X1 AND M.X < MBox(Counter).X2 AND M.Y > MBox(Counter).Y1 AND M.Y < MBox(Counter).Y2 AND Counter = CanidateHL THEN
HLCount = Counter
MFlag = TRUE
END IF
NEXT Counter
END IF
END IF
'Ensure the user can't exceed the character limit
'GLI(x) codes
'1 - Last Name: 2 - First name: 3 - Middle name: 4 - Nickname
'5 - 7 DOB MM/DD/YY: 8 - Additional info
'9 - 11 Mother's info (name, phone, email)
'12 -14 Father's info (name, phone, email)
IF Gli(1).CursorPosition > 20 THEN Gli(1).CursorPosition = 20: Gli(1).InputText = LEFT$(Gli(1).InputText, 21)
IF Gli(2).CursorPosition > 20 THEN Gli(2).CursorPosition = 20: Gli(2).InputText = LEFT$(Gli(2).InputText, 21)
IF Gli(3).CursorPosition > 20 THEN Gli(3).CursorPosition = 20: Gli(3).InputText = LEFT$(Gli(3).InputText, 21)
IF Gli(4).CursorPosition > 20 THEN Gli(4).CursorPosition = 20: Gli(4).InputText = LEFT$(Gli(4).InputText, 21)
IF Gli(5).CursorPosition > 2 THEN Gli(5).CursorPosition = 2: Gli(5).InputText = LEFT$(Gli(5).InputText, 3)
IF Gli(6).CursorPosition > 2 THEN Gli(6).CursorPosition = 2: Gli(6).InputText = LEFT$(Gli(6).InputText, 3)
IF Gli(7).CursorPosition > 2 THEN Gli(7).CursorPosition = 2: Gli(7).InputText = LEFT$(Gli(7).InputText, 3)
IF Gli(8).CursorPosition > 88 THEN Gli(8).CursorPosition = 88: Gli(8).InputText = LEFT$(Gli(8).InputText, 89)
IF Gli(9).CursorPosition > 30 THEN Gli(9).CursorPosition = 30: Gli(9).InputText = LEFT$(Gli(9).InputText, 31)
IF Gli(10).CursorPosition > 20 THEN Gli(10).CursorPosition = 20: Gli(10).InputText = LEFT$(Gli(10).InputText, 21)
IF Gli(11).CursorPosition > 38 THEN Gli(11).CursorPosition = 38: Gli(11).InputText = LEFT$(Gli(11).InputText, 39)
IF Gli(12).CursorPosition > 30 THEN Gli(12).CursorPosition = 30: Gli(12).InputText = LEFT$(Gli(12).InputText, 31)
IF Gli(13).CursorPosition > 20 THEN Gli(13).CursorPosition = 20: Gli(13).InputText = LEFT$(Gli(13).InputText, 21)
IF Gli(14).CursorPosition > 38 THEN Gli(14).CursorPosition = 38: Gli(14).InputText = LEFT$(Gli(14).InputText, 39)
MOUSE "Loop"
GLIUPDATE
DISPLAY
LOOP UNTIL MFlag
SELECT CASE HLCount
CASE 1: GLIFORCE 1
CASE 2: GLIFORCE 2
CASE 3: GLIFORCE 3
CASE 4: GLIFORCE 4
CASE 5: GLIFORCE 5
CASE 6: GLIFORCE 6
CASE 7: GLIFORCE 7
CASE 8: GLIFORCE 8
CASE 9: GLIFORCE 9
CASE 10: GLIFORCE 10
CASE 11: GLIFORCE 11
CASE 12: GLIFORCE 12
CASE 13: GLIFORCE 13
CASE 14: GLIFORCE 14
CASE 15: Save = TRUE: AddAnother = TRUE
CASE 16: Save = TRUE
CASE 17:
FOR Counter = 1 TO 14
Gli(Counter).InputText = ""
Gli(Counter).CursorPosition = 1
NEXT Counter
GLIFORCE 1
CASE 18: Cancel = TRUE
END SELECT
'Validate entries
'GLI(x) codes
'1 - Last Name: 2 - First name: 3 - Middle name: 4 - Nickname
'5 - 7 DOB MM/DD/YY: 8 - Additional info
'9 - 11 Mother's info (name, phone, email)
'12 -14 Father's info (name, phone, email)
IF Save THEN
Save = FALSE: MonthDay = TRUE: Redo = FALSE
IF GLIOUTPUT(1) = "" THEN QUICKMESSAGE "Last name required": Redo = TRUE
IF GLIOUTPUT(2) = "" THEN QUICKMESSAGE "First name required": Redo = TRUE
IF GLIOUTPUT(5) = "" THEN QUICKMESSAGE "Date of birth: month required": Redo = TRUE
IF GLIOUTPUT(6) = "" THEN QUICKMESSAGE "Date of birth: day required": Redo = TRUE
IF GLIOUTPUT(7) = "" THEN QUICKMESSAGE "Date of birth: year required": Redo = TRUE
IF VAL(GLIOUTPUT(5)) < 1 OR VAL(GLIOUTPUT(4)) > 12 THEN QUICKMESSAGE "Please enter a vaild month (1-12)": Redo = TRUE: MonthDay = FALSE
IF MonthDay THEN
SELECT CASE VAL(GLIOUTPUT(5))
CASE 1, 3, 5, 7, 8, 10, 12
IF VAL(GLIOUTPUT(6)) < 1 OR VAL(GLIOUTPUT(6)) > 31 THEN QUICKMESSAGE "Enter a valid day for the month (1-31)": Redo = TRUE
CASE 4, 6, 9, 11
IF VAL(GLIOUTPUT(6)) < 1 OR VAL(GLIOUTPUT(6)) > 30 THEN QUICKMESSAGE "Enter a valid day for the month (1-30)": Redo = TRUE
CASE 2
IF VAL(GLIOUTPUT(6)) < 1 OR VAL(GLIOUTPUT(6)) > 31 THEN QUICKMESSAGE "Enter a valid day for the month (1-28)": Redo = TRUE
END SELECT
END IF
IF NOT Redo THEN Verify = TRUE: Save = TRUE
IF Verify AND NOT AddAnother THEN QUICKMESSAGE "Written Succesfully."
END IF
IF AddAnother AND Verify THEN
FOR Counter = 1 TO 14
Gli(Counter).InputText = ""
Gli(Counter).CursorPosition = 1
NEXT Counter
GLIFORCE 1
Fade = TRUE
END IF
LOOP UNTIL NOT AddAnother AND Verify OR Cancel
GLICLOSE 0, TRUE
END SUB
'General Roster BG, ADD being true prints some additional things to the screen
'such as "* - Required" and "Add another", only used with ADDSTUDENT
SUB ROSTERBG (ADD AS BYTE, Titlee AS STRING)
DIM AS INTEGER X, Y, Y1
MENUFRAME Titlee
FONT FontHandle(10)
'Top row labels
Y = 105 + UFONTHEIGHT: Y1 = Y + UFONTHEIGHT: X = 75
IF ADD THEN
UPRINTSTRING (X + 200, Y), "*Last Name"
UPRINTSTRING (X + 525, Y - UFONTHEIGHT), "*Birthday"
LINE (X + 200, Y1)-(X + 200 + UPRINTWIDTH("*Last Name"), Y1 + 1), , BF
ELSE
UPRINTSTRING (X + 200, Y), "Last Name"
UPRINTSTRING (X + 525, Y - UFONTHEIGHT), "Birthday"
LINE (X + 200, Y1)-(X + 200 + UPRINTWIDTH("Last Name"), Y1 + 1), , BF
END IF
'Fifth row labels
Y = 530 + UFONTHEIGHT: Y1 = Y + UFONTHEIGHT
IF ADD THEN
UPRINTSTRING (X, Y), "Entry correct - Y/N:"
UPRINTSTRING (X + 500, Y), "Add another - Y/N:"
LINE (X, Y1 + 2)-(X + UPRINTWIDTH("Entry correct - Y/N:"), Y1 + 3), , BF
LINE (X + 500, Y1 + 2)-(X + 500 + UPRINTWIDTH("Add another - Y/N:"), Y1 + 3), , BF
UPRINTSTRING (X + 900, Y), "* - Required"
END IF
DISPLAY
END SUB
'This routinue deletes a class set
SUB CSDelete
DIM AS STRING Delete
DIM AS INTEGER X, Y
DIM AS STRING ConfirmStatement, NameList, Master, Slave
DIM AS STRING * 1 Confirm
DIM AS BIT ConfirmDelete
PAUSE TIME
Delete = CSFile$("")
IF Delete = "" THEN QUICKMESSAGE "Deletion aborted.": EXIT SUB
ConfirmStatement = "Once removed, " + Delete + " is not a recoverable class set! Are you sure (Y/N)"
CLS: PUTIMAGE , BGImage
X = (HEIGHT / FONTHEIGHT) / 2 - 1
Y = 1280 / 2 - PRINTWIDTH(ConfirmStatement) / 2
AUTODISPLAY
DO
LOCATE X, Y: PRINT ConfirmStatement;: INPUT ; Confirm
LOOP UNTIL UCASE$(Confirm) = "Y" OR UCASE$(Confirm) = "N"
DISPLAY
IF UCASE$(Confirm) = "Y" THEN ConfirmDelete = TRUE ELSE ConfirmDelete = FALSE
PAUSE TIME
IF ConfirmDelete THEN
NameList = Delete + ".gkn"
Master = Delete + ".gka"
Slave = Delete + ".gkb"
SHELL HIDE "del /q " + CHR$(34) + NameList + CHR$(34)
SHELL HIDE "del /q " + CHR$(34) + Master + CHR$(34)
SHELL HIDE "del /q " + CHR$(34) + Slave + CHR$(34)
IF Teacher.LastFile = Delete THEN Teacher.LastFile = "": TEACHERWRITER
QUICKMESSAGE "Class set: " + Delete + " was removed."
ELSE
QUICKMESSAGE "Deletion aborted."
END IF
END SUB
'This will delete all files and force close the application to clear all memory as well.
SUB RESETPROGRAM
DIM AS INTEGER X, Y
DIM AS STRING ConfirmStatement
DIM AS STRING * 1 Confirm
DIM AS BIT ConfirmDelete
PAUSE TIME
FONT FontHandle(3)
ConfirmStatement = "This will permanently remove all student, grade, and teacher info. Are you sure (Y/N)"
CLS: PUTIMAGE , BGImage
X = (HEIGHT / FONTHEIGHT) / 2 - 1
Y = 1280 / 2 - PRINTWIDTH(ConfirmStatement) / 2
AUTODISPLAY
DO
LOCATE X, Y: PRINT ConfirmStatement;: INPUT ; Confirm
LOOP UNTIL UCASE$(Confirm) = "Y" OR UCASE$(Confirm) = "N"
DISPLAY
IF UCASE$(Confirm) = "Y" THEN ConfirmDelete = TRUE ELSE ConfirmDelete = FALSE
PAUSE TIME
QUICKMESSAGE "All files were removed. The program will now close. Please destroy backups and reports."
SYSTEM
ELSE
QUICKMESSAGE "Reset aborted."
END IF
END SUB
'Gathers and stores user info (the teacher)
SUB TEACHERINFO
DIM AS STRING * 1 OverWrite
OverWrite = "N"
CLS
PUTIMAGE , BGImage
'Prompt for overwrite
IF Teacher.TeacherName <> NullStr THEN
QUICKMESSAGE "Info is on file. You may go back on the next screen."
FONT FontHandle(6)
LOCATE 4, 1280 / 2 - PRINTWIDTH("OVERWRITE!") / 2: PRINT "OVERWRITE!"
FONT FontHandle(5)
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 Teacher.TeacherName = NullStr OR OverWrite = "Y" THEN
FONT FontHandle(4)
CLS
PUTIMAGE , BGImage
AUTODISPLAY
LOCATE 4, 1280 / 2 - PRINTWIDTH("Teacher Info") / 2: PRINT "Teacher Info"
PAUSE (TIME)
LOCATE 7, 50: INPUT "Please enter your name (Mr./Ms. Smith): ", Teacher.TeacherName
PAUSE (TIME)
LOCATE 8, 50: INPUT "Please enter the name of your school: ", Teacher.School
PAUSE (TIME)
LOCATE 9, 50: INPUT "Please enter your grade/subject: ", Teacher.Grade
PAUSE (TIME)
LOCATE 10, 50: INPUT "Please enter your class name/section ID: ", Teacher.Class
PAUSE (TIME)
LOCATE 11, 50: INPUT "Pleae enter your classroom number: ", Teacher.Classroom
DISPLAY
TEACHERWRITER
QUICKMESSAGE "Teacher info written succesfully!"
END IF
END SUB
'Write the teacher file with updates
SUB TEACHERWRITER
OPEN "teacher.gkt" FOR OUTPUT AS #2
WRITE #2, Teacher.TeacherName
WRITE #2, Teacher.School
WRITE #2, Teacher.Grade
WRITE #2, Teacher.Class
WRITE #2, Teacher.Classroom
WRITE #2, Teacher.LastFile
WRITE #2, Teacher.LastUsedUID
WRITE #2, Teacher.LastUsedAID
WRITE #2, Teacher.Custom1
WRITE #2, Teacher.Custom2
WRITE #2, Teacher.Custom3
WRITE #2, Teacher.Custom4
WRITE #2, Teacher.Custom5
CLOSE #2
END SUB
'Quick about the program and the release to public domain
SUB ABOUT
CLS
PUTIMAGE , BGImage
Menu(2) = "*"
MENUMAKER Menu()
FONT FontHandle(4): LOCATE 8, 1280 / 2 - UPRINTWIDTH("Alpha Version 4.1.2") / 2: PRINT "Alpha Version 4.1.2"
FONT FontHandle(3): LOCATE 15, 50: PRINT "Public alpha release #6. Released May 23rd, 2023. 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 comments, questions, or suggestions. No warranty or guarantee explicitly"
LOCATE 19, 50: PRINT "or implicitly made with the use of this software. Source code avaliable upon request."
LOCATE 20, 50: PRINT "Built with QB64-PE V3.7.0 Avalable through the forum: https://qb64phoenix.com/forum/index.php"
LOCATE 22, 50: PRINT "Press any key or click the mouse to go back..."
DISPLAY
PAUSE TIME
MOUSE "Inital"
DO
LIMIT LIMITRATE
MOUSE "Poll"
MOUSE "Click"
LOOP UNTIL INKEY$ <> "" OR M.LBut
PAUSE TIME
END SUB
SUB MENUMAKER (Elements() AS STRING)
DIM AS INTEGER StartX, StartY, Count
FONT FontHandle(9)
StartX = 640 - UPRINTWIDTH(Elements(1)) / 2: StartY = 75: Count = 2
UPRINTSTRING (StartX, StartY), Elements(1)
LINE (640 - UPRINTWIDTH(Elements(1)) / 2, StartY + UFONTHEIGHT - 18)-(640 + UPRINTWIDTH(Elements(1)) / 2, StartY + UFONTHEIGHT - 22), , BF
StartY = StartY + UFONTHEIGHT + 15
FONT FontHandle(8)
DO WHILE Elements(Count) <> "*"
StartX = 640 - UPRINTWIDTH(Elements(Count)) / 2
UPRINTSTRING (StartX, StartY), Elements(Count)
MenuPos(Count).X1 = StartX
MenuPos(Count).Y1 = StartY
MenuPos(Count).X2 = StartX + UPRINTWIDTH(Elements(Count))
MenuPos(Count).Y2 = StartY + UFONTHEIGHT
StartY = StartY + UFONTHEIGHT
Count = Count + 1
LOOP
MenuPos(Count).X1 = -1 'Flag for the mouse routinue to stop producing boundary boxes for the checkmark to jump to.
END SUB
SUB QUICKMESSAGE (ToPrint AS STRING)
DIM AS INTEGER Rows, Columns
'Save prior screen
SCREEN NEWIMAGE(1280, 720, 32)
'Write the message
FONT FontHandle(4)
CLS
PUTIMAGE (0, 0), BGImage
Rows = (HEIGHT / FONTHEIGHT) / 2 - 1
Columns = 1280 / 2 - PRINTWIDTH(ToPrint) / 2
LOCATE Rows, Columns: PRINT ToPrint
Columns = 1280 / 2 - PRINTWIDTH("Press any key or click the mouse.") / 2
LOCATE Rows + 2, Columns: PRINT "Press any key or click the mouse."
DISPLAY
MOUSE "Inital"
PAUSE TIME
DO
LIMIT LIMITRATE
MOUSE "Poll"
MOUSE "Click"
LOOP UNTIL INKEY$ <> "" OR M.LBut
PAUSE TIME
'Restore prior screen before call
SCREEN MainScreen
END SUB
SUB PAUSE (Dlay AS FLOAT)
DELAY Dlay
KEYCLEAR 'Clear any key press
END SUB
'Mouse updating
SUB MOUSE (Status AS STRING)
STATIC AS BIT LB, RB, LButHeld, RButHeld
DIM AS INTEGER Count
SELECT CASE Status:
'Run at the begining before entering a DO/LOOP
CASE "Inital":
LB = FALSE: M.LBut = 0: LButHeld = FALSE: MLButAct = FALSE
RB = FALSE: M.RBut = 0: RButHeld = FALSE: MRButAct = FALSE
MFlag = FALSE: M.X = 0: M.Y = 0: M.OldX = 0: M.OldY = 0: M.Pointer = -1
'Current state of the mouse
CASE "Poll"
WHILE MOUSEINPUT: WEND
M.X = MOUSEX
M.Y = MOUSEY
M.LBut = MOUSEBUTTON(1)
M.RBut = MOUSEBUTTON(2)
'Left click
CASE "Click":
IF M.LBut THEN MLButAct = TRUE
'Right click
CASE "R_Click:"
IF M.RBut THEN MRButAct = TRUE
'This detects when left mouse button is released - programmer's choice to use click or release as trigger
CASE "Release":
IF M.LBut THEN '1) Button is down we need to see if it is still down
IF NOT LB THEN '2) Record that the button is down and then empty loop while held
LB = TRUE
END IF
ELSE
IF LB THEN '4) Once the mouse has been released and been pressed before
IF LButHeld THEN MLButAct = TRUE '5) Process the action with a true flag
LB = FALSE: LButHeld = FALSE '6) Reset the button to up and button being held
END IF
END IF
IF LB AND NOT LButHeld THEN LButHeld = TRUE '3) If the button is pressed and record the holding state
'This detects when right mouse button is released - programmer's choice to use click or release as trigger
CASE "R-Release":
IF M.RBut THEN '1) Button is down we need to see if it is still down
IF NOT RB THEN '2) Record that the button is down and then empty loop while held
RB = TRUE
END IF
ELSE
IF RB THEN '4) Once the mouse has been released and been pressed before
IF RButHeld THEN MRButAct = TRUE '5) Process the action with a true flag
RB = FALSE: RButHeld = FALSE '6) Reset the button to up and button being held
END IF
END IF
IF RB AND NOT RButHeld THEN RButHeld = TRUE '3) If the button is pressed and record the holding state
'Needs to be called after all mouse checking is finished and before the end of the loop
CASE "Loop":
M.OldX = M.X: M.OldY = M.Y
MLButAct = FALSE
MRButAct = FALSE
'--This is used to process my menu screens, you will want to make your own for repeative DO/LOOPs, if you have them--
'Positions start at index 2 (Title of the screen is index 1, not tracked)
CASE "Action":
Count = 2
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct THEN 'Check if our mouse is moving or a button is being held
DO WHILE MenuPos(Count).X1 <> -1
IF M.X > MenuPos(Count).X1 AND M.X < MenuPos(Count).X2 AND M.Y > MenuPos(Count).Y1 AND M.Y < MenuPos(Count).Y2 THEN M.Pointer = Count - 2: Pointer = Count - 2
Count = Count + 1
LOOP
IF MLButAct THEN 'Once the mouse is released, are we stil over the same box? If so then MFlag is true and we can exit the loop using M.pointer as our pointer of the mouse
Count = 2
DO WHILE MenuPos(Count).X1 <> -1
IF M.X > MenuPos(Count).X1 AND M.X < MenuPos(Count).X2 AND M.Y > MenuPos(Count).Y1 AND M.Y < MenuPos(Count).Y2 AND M.Pointer = Count - 2 THEN MFlag = TRUE
Count = Count + 1
LOOP
END IF
END IF
'Debugging in case of mistype
CASE ELSE: PRINT "Keyword: " + Status + " is not valid": SLEEP: SYSTEM
END SELECT
END SUB
'Loads the student data into memory - #1 must be open
SUB READSTUDENTDATA
DIM AS INTEGER Counter, TempStudents
DIM AS StudentsType ReadIn(1 TO 100)
'This reads the number of students in the file
NumberOfStudents = 0: TempStudents = 0
WHILE NOT EOF(1)
NumberOfStudents = NumberOfStudents + 1
IF UBOUND(ReadIn) = NumberOfStudents THEN REDIM PRESERVE ReadIn(NumberOfStudents + 1) AS StudentsType
INPUT #1, ReadIn(NumberOfStudents).NickName
INPUT #1, ReadIn(NumberOfStudents).Month
INPUT #1, ReadIn(NumberOfStudents).Day
INPUT #1, ReadIn(NumberOfStudents).Year
INPUT #1, ReadIn(NumberOfStudents).AddInfo
INPUT #1, ReadIn(NumberOfStudents).FirstName
INPUT #1, ReadIn(NumberOfStudents).MiddleName
INPUT #1, ReadIn(NumberOfStudents).LastName
INPUT #1, ReadIn(NumberOfStudents).MomName
INPUT #1, ReadIn(NumberOfStudents).MomPhone
INPUT #1, ReadIn(NumberOfStudents).MomEmail
INPUT #1, ReadIn(NumberOfStudents).DadName
INPUT #1, ReadIn(NumberOfStudents).DadPhone
INPUT #1, ReadIn(NumberOfStudents).DadEmail
INPUT #1, ReadIn(NumberOfStudents).UID
WEND
'Sort 4 arranges our student list from largest to smallest UID - required for proper copying.
SORT ReadIn(), 4
'Ignore the removed students, removing all UIDs below zero as the proper student count and insert into the master student lis5t
FOR Counter = 1 TO NumberOfStudents
IF ReadIn(Counter).UID > 0 THEN
TempStudents = TempStudents + 1
UPDATEROSTER ReadIn(TempStudents), TempStudents
END IF
NEXT Counter
NumberOfStudents = TempStudents
END SUB
'Writes a StudentsType to file - #1 must be open
SUB WRITESTUDENTDATA (DataSource AS StudentsType)
WRITE #1, DataSource.NickName
WRITE #1, DataSource.Month
WRITE #1, DataSource.Day
WRITE #1, DataSource.Year
WRITE #1, DataSource.AddInfo
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
WRITE #1, DataSource.UID
END SUB
'Bubble sorted, by which array element: 1 - first name, 2 - last name, 3 - birthday
SUB SORT (StudentList() AS StudentsType, Element AS INTEGER)
'Programer's note: OOO (or triple 'oooo') is a reference to my unlce David. As a car mechanic, he hated oil changes.
'thus he would tell the others it is triple ooo time or out of oil time. Worked everytime, no one questioned it for years.
'May he rest after losing his battle with cancer, RIP.
'* still out of order (OOO)
DIM AS BYTE OOO
DIM AS INTEGER SortCounter
SELECT CASE Element
'First name sort
CASE 1:
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF StudentList(SortCounter).FirstName > StudentList(SortCounter + 1).FirstName THEN
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
ELSEIF StudentList(SortCounter).FirstName = StudentList(SortCounter + 1).FirstName AND _
StudentList(SortCounter).LastName > StudentList(SortCounter + 1).LastName THEN 'Used for same first names only
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
'Last name sort
CASE 2:
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF StudentList(SortCounter).LastName > StudentList(SortCounter + 1).LastName THEN
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
ELSEIF StudentList(SortCounter).LastName = StudentList(SortCounter + 1).LastName AND _
StudentList(SortCounter).FirstName > StudentList(SortCounter + 1).FirstName THEN 'Used for same last names only
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
'Birthday Sort
CASE 3:
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF StudentList(SortCounter).Month > StudentList(SortCounter + 1).Month THEN
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
ELSEIF StudentList(SortCounter).Month = StudentList(SortCounter + 1).Month AND _
StudentList(SortCounter).Day > StudentList(SortCounter + 1).Day THEN 'Sort the days inside a month
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
ELSEIF StudentList(SortCounter).Month = StudentList(SortCounter + 1).Month AND _
StudentList(SortCounter).Day = StudentList(SortCounter + 1).Day AND _
StudentList(SortCounter).FirstName > StudentList(SortCounter + 1).FirstName THEN 'Secondary sort first name
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
ELSEIF StudentList(SortCounter).Month = StudentList(SortCounter + 1).Month AND _
StudentList(SortCounter).Day = StudentList(SortCounter + 1).Day AND _
StudentList(SortCounter).FirstName = StudentList(SortCounter + 1).FirstName AND _
StudentList(SortCounter).LastName > StudentList(SortCounter + 1).LastName THEN 'Trinary sort last name
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
'Sort by UID
CASE 4:
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF StudentList(SortCounter).UID < StudentList(SortCounter + 1).UID THEN
SWAP StudentList(SortCounter), StudentList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
END SELECT
END SUB
SUB DISPLAYIMAGE (Image AS LONG, x AS INTEGER, y AS INTEGER, xscale AS SINGLE, yscale AS SINGLE, angle AS SINGLE, mode AS INTEGER)
'Image is the image handle which we use to reference our image.
'x,y is the X/Y coordinates where we want the image to be at on the screen.
'angle is the angle which we wish to rotate the image.
'mode determines HOW we place the image at point X,Y.
'Mode 0 we center the image at point X,Y
'Mode 1 we place the Top Left corner of oour image at point X,Y
'Mode 2 is Bottom Left
'Mode 3 is Top Right
'Mode 4 is Bottom Right
DIM px(0 TO 3) AS INTEGER, py(0 TO 3) AS INTEGER, w AS INTEGER, h AS INTEGER
DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
DIM AS SINGLE x2, y2
w = _WIDTH(Image): h = _HEIGHT(Image)
SELECT CASE mode
CASE 0 'center
px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
CASE 1 'top left
px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
px(1) = 0: py(1) = h: px(2) = w: py(2) = h
CASE 2 'bottom left
px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
CASE 3 'top right
px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
CASE 4 'bottom right
px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
END SELECT
sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
FOR i = 0 TO 3
x2 = xscale * (px(i) * cosr + sinr * py(i)) + x: y2 = yscale * (py(i) * cosr - px(i) * sinr) + y
px(i) = x2: py(i) = y2
NEXT
_MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
'-----------Functions-----------
FUNCTION ACategory%
DIM AS ACatType ACat(1 TO 10)
DIM AS MenuPosType Mbox(1 TO 11)
DIM AS INTEGER Counter, X, Y, Canidate
RESTORE ACat
FOR Counter = 1 TO 10
READ ACat(Counter).AName, ACat(Counter).Color32, ACat(Counter).Custom
NEXT Counter
MENUFRAME "Category Select"
'Print category options to screen (1st column - built in)
FONT FontHandle(4)
X = 100: Y = 125
FOR Counter = 1 TO 5
LINE (X, Y)-(X + 35, Y + 35), ACat(Counter).Color32, BF
UPRINTSTRING (X + 75, Y), "- " + ACat(Counter).AName
Mbox(Counter).X1 = X - 10: Mbox(Counter).Y1 = Y - 10
Mbox(Counter).X2 = X + 500: Mbox(Counter).Y2 = Y + UFONTHEIGHT + 10
'LINE (Mbox(Counter).X1, Mbox(Counter).Y1)-(Mbox(Counter).X2, Mbox(Counter).Y2), White, B
Y = Y + 100
NEXT Counter
'Print category options to screen (2nd column - Customizable)
X = 680: Y = 125
FOR Counter = 6 TO 10
LINE (X, Y)-(X + 35, Y + 35), ACat(Counter).Color32, BF
UPRINTSTRING (X + 75, Y), "- " + ACat(Counter).AName
Mbox(Counter).X1 = X - 10: Mbox(Counter).Y1 = Y - 10
Mbox(Counter).X2 = X + 500: Mbox(Counter).Y2 = Y + UFONTHEIGHT + 10
'LINE (Mbox(Counter).X1, Mbox(Counter).Y1)-(Mbox(Counter).X2, Mbox(Counter).Y2), White, B
Y = Y + 100
NEXT Counter
'Cancel button
LINE (500, 600)-(780, 655), RGB32(240, 240, 240), BF
COLOR Black, RGB32(240, 240, 240)
UPRINTSTRING (640 - UPRINTWIDTH("Cancel") / 2, 610), "Cancel"
COLOR White, Black
Mbox(11).X1 = 500: Mbox(11).Y1 = 600
Mbox(11).X2 = 780: Mbox(11).Y2 = 655
DISPLAY
MOUSE "Inital"
PAUSE TIME
'Allow the user to make a selection with the mouse
DO
LIMIT LIMITRATE
MOUSE "Poll"
MOUSE "Release"
'Check if our mouse is moving or a button is being held
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct THEN
FOR Counter = 1 TO 11
IF M.X > Mbox(Counter).X1 AND M.X < Mbox(Counter).X2 AND M.Y > Mbox(Counter).Y1 AND M.Y < Mbox(Counter).Y2 THEN
Canidate = Counter
END IF
NEXT Counter
'Return the counter (integer) as selected if clicked and held over the same "mouse box"
IF MLButAct THEN
FOR Counter = 1 TO 11
IF M.X > Mbox(Counter).X1 AND M.X < Mbox(Counter).X2 AND M.Y > Mbox(Counter).Y1 AND M.Y < Mbox(Counter).Y2 AND Counter = Canidate THEN
ACategory% = Counter
EXIT FUNCTION
END IF
NEXT Counter
END IF
END IF
MOUSE "Loop"
LOOP
END FUNCTION
'This function returns a filename from *.gkn.
FUNCTION CSFile$ (DoNotDisplay AS STRING)
DIM AS STRING FileList(1 TO 15), Titlee
DIM AS INTEGER Counter, FileCount, Wide, X, Y, HL(500000)
DIM AS BIT AllShown
'To shorten counter by one if tripped by DoNotDisplay
AllShown = TRUE
'Checking for class set dump results into a temp file
SHELL HIDE "dir *.gkn /b > temp.tmp"
OPEN "temp.tmp" FOR INPUT AS #5
'Checking for files... If none, abort out.
IF LOF(5) = 0 THEN
QUICKMESSAGE "No gradebooks exist. Please create a 'New Gradebook'"
CLOSE #5
KILL "temp.tmp"
EXIT FUNCTION
END IF
'Formatting the text from the file
Counter = 1
WHILE NOT EOF(5)
INPUT #5, FileList(Counter)
FileList(Counter) = TRIM$(LEFT$(FileList(Counter), INSTRREV(FileList(Counter), ".") - 1))
Counter = Counter + 1
WEND
FileCount = Counter - 1
FileList(Counter) = "*"
CLOSE #5
KILL "temp.tmp"
'Drawing the background for menu selection
Titlee = "Class Set Select"
FONT FontHandle(7)
Wide = UPRINTWIDTH(Titlee) / 2
CLS
PUTIMAGE , BGImage
'Title of the page
UPRINTSTRING (640 - Wide, 30), Titlee
'Connect the quads
LINE (640 - Wide - 10, 34)-(640 + Wide + 10, 30), , BF 'Top
LINE (640 - Wide - 30, 98)-(640 + Wide + 30, 94), , BF 'Under the word
LINE (640 - Wide - 30, 625)-(640 + Wide + 30, 629), , BF 'Bottom
LINE (640 - Wide - 30, 54)-(640 - Wide - 34, 629), , BF 'Left
LINE (640 + Wide + 30, 54)-(640 + Wide + 34, 629), , BF 'Right
'Print class sets
FONT FontHandle(4)
X = 640 - Wide - 29: Y = 99
Counter = 1
DO WHILE FileList(Counter) <> "*"
IF AllShown THEN
IF FileList(Counter) <> DoNotDisplay THEN
UPRINTSTRING (640 - UPRINTWIDTH(FileList(Counter)) / 2, Y + ((Counter - 1) * (UFONTHEIGHT - 2))), FileList(Counter)
ELSE
AllShown = FALSE
END IF
ELSE
UPRINTSTRING (640 - UPRINTWIDTH(FileList(Counter)) / 2, Y + ((Counter - 2) * (UFONTHEIGHT - 2))), FileList(Counter)
END IF
Counter = Counter + 1
LOOP
'Set the inital selection
Counter = 1
GET (X, Y)-(X + Wide * 2 + 58, Y + (UFONTHEIGHT - 2)), HL()
PUT (X, Y), HL(), PRESET
'Selection loop
DO
LIMIT LIMITRATE
'Up case
IF KEYDOWN(18432) THEN
PAUSE TIME
GET (X, Y)-(X + Wide * 2 + 58, Y + UFONTHEIGHT - 2), HL()
PUT (X, Y), HL(), PRESET
'Top of menu check
IF Counter = 1 THEN
Y = 99 + (UFONTHEIGHT - 2) * 14: Counter = 15
'Less than 14 files to select from, jump to cancel
ELSEIF Counter = 15 AND FileCount <> 14 AND AllShown THEN
Y = 99 + (UFONTHEIGHT - 2) * (FileCount - 1): Counter = FileCount
ELSEIF Counter = 15 AND FileCount <> 14 AND NOT AllShown THEN
Y = 99 + (UFONTHEIGHT - 2) * (FileCount - 2): Counter = FileCount - 1
'Normal operation
ELSE
Y = Y - (UFONTHEIGHT - 2): Counter = Counter - 1
END IF
GET (X, Y)-(X + Wide * 2 + 58, Y + (UFONTHEIGHT - 2)), HL()
PUT (X, Y), HL(), PRESET
END IF
'Down case
IF KEYDOWN(20480) THEN
PAUSE TIME
GET (X, Y)-(X + Wide * 2 + 58, Y + (UFONTHEIGHT - 2)), HL()
PUT (X, Y), HL(), PRESET
'Bottom of menu check
IF Counter = 15 THEN
Y = 99: Counter = 1
'Last file check with a hidden selection
ELSEIF FileList(Counter + 2) = "*" THEN
IF NOT AllShown THEN
Y = 99 + (UFONTHEIGHT - 2) * 14: Counter = 15
ELSE
Y = Y + (UFONTHEIGHT - 2): Counter = Counter + 1
END IF
'All file names are limited to 20
IF LEN(FileNameCanidate) >= 21 THEN ISVALID` = FALSE: EXIT FUNCTION
'Filenames can not start or end with a space
IF MID$(FileNameCanidate, 1, 1) = " " THEN ISVALID` = FALSE: EXIT FUNCTION
IF MID$(FileNameCanidate, LEN(FileNameCanidate), 1) = " " THEN ISVALID` = FALSE: EXIT FUNCTION
'Each part of the canidate name is pulled apart to check.
FOR LoopCounter = 1 TO LEN(FileNameCanidate)
FileNameParts(LoopCounter) = MID$(FileNameCanidate, LoopCounter, 1)
NEXT LoopCounter
'Check the canidate vs the legal characters.
'If a legal character is not found in a position, false is returned without further checking.
FOR LoopCounter = 1 TO LEN(FileName)
ISVALID` = FALSE 'Reset the tripwire
FOR LoopCounter1 = 1 TO NumberOfVaildCharacters
IF FileNameParts(LoopCounter) = Legal(LoopCounter1) THEN ISVALID` = TRUE: EXIT FOR
NEXT LoopCounter1
IF NOT ISVALID` THEN EXIT FUNCTION 'If not tripped to true, exit with further checking.
NEXT LoopCounter
'If all tests are passed then return true
ISVALID` = TRUE
END FUNCTION
'Formats birthday formatted as DayOfWeek, Month Day, Year
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
'Returns today in a formatted way "Month ##, 20XX"
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!
'Retuns the day of the week for any given date
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.
'Returns the time as HH:MM AM/PM
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
FUNCTION TEXTTOIMAGE& (text$, fonth&, fc&, bfc&, mode AS _BYTE)
'text$ is the text that we wish to transform into an image.
'font& is the handle of the font we want to use.
'fc& is the color of the font we want to use.
'bfc& is the background color of the font.
'Mode 1 is print forwards
'Mode 2 is print backwards
'Mode 3 is print from top to bottom
'Mode 4 is print from bottom up
'Mode 0 got lost somewhere, but it's OK. We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
DIM AS LONG dc, bgc, D, F, T2Idown, T2Iright, w, h, i, TextToImage_temp, fx
DIM AS STRING temp
IF mode < 1 OR mode > 4 THEN mode = 1
dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
D = _DEST
F = _FONT
T2Idown = CSRLIN: T2Iright = POS(0)
IF fonth& <> 0 THEN _FONT fonth&
IF mode < 3 THEN
'print the text lengthwise
w& = UPRINTWIDTH(text$): h& = UFONTHEIGHT
ELSE
'print the text vertically
FOR i = 1 TO LEN(text$)
IF w& < UPRINTWIDTH(MID$(text$, i, 1)) THEN w& = UPRINTWIDTH(MID$(text$, i, 1))
NEXT
h& = UFONTHEIGHT * (LEN(text$))
END IF
TextToImage_temp& = _NEWIMAGE(w&, h&, 32)
TEXTTOIMAGE = TextToImage_temp&
_DEST TextToImage_temp&
IF fonth& <> 0 THEN _FONT fonth&
COLOR fc&, bfc&
SELECT CASE mode
CASE 1
'Print text forward
UPRINTSTRING (0, 0), text$
CASE 2
'Print text backwards
temp$ = ""
FOR i = 0 TO LEN(text$) - 1
temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
NEXT
UPRINTSTRING (0, 0), temp$
CASE 3
'Print text upwards
'first lets reverse the text, so it's easy to place
temp$ = ""
FOR i = 0 TO LEN(text$) - 1
temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
NEXT
'then put it where it belongs
FOR i = 1 TO LEN(text$)
fx = (w& - UPRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
UPRINTSTRING (fx, UFONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
NEXT
CASE 4
'Print text downwards
FOR i = 1 TO LEN(text$)
fx = (w& - UPRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
UPRINTSTRING (fx, UFONTHEIGHT * (i - 1)), MID$(text$, i, 1)
NEXT
END SELECT
_DEST D
COLOR dc&, bgc&
_FONT F
LOCATE T2Idown, T2Iright
END FUNCTION
Check one of the two included "BI-suffix" files for a symbol named "Shutdown".
That might cause a conflict with your BASIC code and therefore you will have to change the label in your code so it's different from one of the "dot-BI" files. Check for a "Shutdown" array being declared by DIM, or a subprogram or function being called that way, inside the included files.
When I get a "Duplicate definition" error it's seems to always be related to my misuse of the CONST statement. Somewhere in my program I tried to change the variables value when it supposed to have been fixed.
(06-02-2023, 11:19 AM)Dimster Wrote: When I get a "Duplicate definition" error it's seems to always be related to my misuse of the CONST statement. Somewhere in my program I tried to change the variables value when it supposed to have been fixed.
Always place:
OPTION _EXPLICIT
as your very first line of code. This will catch the most common variable related errors during the coding phase.
There are two ways to write error-free programs; only the third one works. QB64 Tutorial
Hi Terry - hope I'm not taking this tread down a different road but on that Option_Explicit, do you find it highlights an "undefined variable" error when the variable is just a local loop control type. I don't DIM or DIM SHARED those loop control variables.
Ie
For XYZ = 1 to 10
XYZ$ = str$(XYZ)
FileName$ = "MyFileNumber"
File$ = FileName$ + LTrim$(XYZ$)
Print File$
Next XYZ
In this case I'm just trying to add a number to the file name and XYZ does not need to be Dimensioned as I believe it's a Single by default. But I take your suggestion as a very good one to debug for a "Duplicate Definition".
06-02-2023, 01:28 PM (This post was last modified: 06-02-2023, 02:16 PM by bplus.)
To make sure work is saved before exit (using _Exit),
First I have Global variable Saved = 0 or -1
1. Set when worked is saved to -1 or when work has changed to 0,
2. A sub that saves the work so it can be conveniently called, it can reset saved from 0 to -1 when work is saved.
So when user indicates they want to quit using _Exit, the Saved variable is checked and If Saved = 0 the user is prompted if they want to save then save routine called and then exit is allowed. If saved is already true then no need to delay exit.
If your program has multiple points to exit just call up a CheckedSaved routine that does the above described stuff.
As mnrvovrfc says, no need to check at regular intervals throughout program. Just check the Saved Flag variable when user wants to exit.
BTW I use that very system with my Account Tracker app in all my GUI apps updates.
PS I had to look at that again, I had a MainRouter sub that jobbed out the execution flow to all other subs from the one MainRouter loop. The only way to exit it was by passing through an _Exit check. The CheckSaved Routine was called after the Main loop was exited. So I was checking for exit every loop through the MainRouter not in timed intervals but in every loop through MainRouter (handling all keypresses and mouse clicks, which basically makes your program event driven).
(06-02-2023, 12:28 PM)Dimster Wrote: Hi Terry - hope I'm not taking this tread down a different road but on that Option_Explicit, do you find it highlights an "undefined variable" error when the variable is just a local loop control type. I don't DIM or DIM SHARED those loop control variables.
(06-02-2023, 11:19 AM)Dimster Wrote: When I get a "Duplicate definition" error it's seems to always be related to my misuse of the CONST statement. Somewhere in my program I tried to change the variables value when it supposed to have been fixed.
Option _Explicit is not called for in this case, everything already has worked for your protection.
You declared a variable name to be constant and the IDE is telling you of your blunder of trying to use a Constant like a true variable.
Option _Explicit is just good programming practice, specially for large projects.
![[Image: Option-Explicit-im-ganzen-P.jpg]](https://i.ibb.co/K2FKbTc/Option-Explicit-im-ganzen-P.jpg)