13-2.BAS
Published in DevCode 2001. Original code and wording are preserved.
DECLARE SUB SEARCHGRADE ()
DECLARE SUB SearchMenu ()
DECLARE SUB searchTITLE ()
DECLARE SUB sEARCHAUTHOR ()
DECLARE SUB SEARCHROOM ()
DECLARE SUB SORTbyTITLE ()
DECLARE SUB SORTbyAUTHOR ()
DECLARE SUB SORTbyLOCATION ()
DECLARE SUB printSORT ()
DECLARE SUB SORTbyNAME ()
DECLARE SUB SORTbyADDRESS ()
DECLARE SUB SORTbyPHONE ()
DECLARE SUB SORTbyGRADE ()
DECLARE SUB SortMenu ()
DECLARE SUB PrintFile ()
DECLARE SUB CreateFile ()
DECLARE SUB addtofile ()
DECLARE SUB errormessage ()
DECLARE SUB pause ()
DECLARE SUB menu ()
DECLARE SUB quit ()
DIM SHARED Title$(50), author$(50), Grade(50), room(50)
COMMON SHARED choice$, sort$, max, index
REM ---> MENU MAINLINE EXAMPLE <---
DO
CALL menu
SELECT CASE choice$ 'variable must match INPUT variable
CASE "A", "a" 'Case letters/numbers must match
CALL CreateFile 'MENU letters/numbers
CASE "B", "b"
CALL addtofile
CASE "C", "c"
CALL PrintFile
CASE "D", "d"
CALL SortMenu
CASE "E", "e"
SearchMenu
CASE "Q", "q"
CALL quit
CASE ELSE
CALL errormessage
END SELECT
LOOP UNTIL UCASE$(choice$) = "Q"
END
SUB addtofile
CLS 'Adds to records already there
OPEN "A:book.dat" FOR APPEND AS #1
INPUT "Enter a book name (Q to Quit)", Title$
DO UNTIL UCASE$(Title$) = "Q"
INPUT "Author ", author$
INPUT " Grade ", Grade
INPUT "Room Location ", room
WRITE #1, Title$, author$, Grade, room
INPUT "Enter a book name (Q to Quit)", Title$
LOOP
CLOSE #1 'creates an end of file mark
END SUB
SUB CreateFile
CLS 'Creates file from scratch - erases current data
COLOR 31
PRINT "W A R N I N G"
COLOR 15
PRINT "You are about to erase all records in your file"
INPUT "Is this what you want to do? (Y or N) ", ans$
IF UCASE$(ans$) = "Y" THEN
OPEN "A:BOOKS.DAT" FOR OUTPUT AS #1
INPUT "Enter a book name (Q to Quit)", Title$
DO UNTIL UCASE$(Title$) = "Q"
INPUT "Author ", author$
INPUT " Grade ", Grade
INPUT "Room Location ", room
WRITE #1, Title$, author$, Grade, room
INPUT "Enter a book name (Q to Quit)", Title$
LOOP
CLOSE #1 'creates an end of file mark
END IF
END SUB
SUB errormessage
LET frequency = 50
LET duration = .259
DO WHILE frequency <= 5000
SOUND frequency, duration
LET frequency = frequency + 250
LOOP
LOCATE 18, 25
PRINT "Press correct entry"
CALL pause
END SUB
SUB menu
CLS
COLOR 15
LOCATE 4, 25
PRINT "Sequential File Handling Example"
COLOR 14
LOCATE 6, 25
PRINT "(A) Create The File"
LOCATE 8, 25
PRINT "(B) Add To The File"
LOCATE 10, 25
PRINT "(C) Print The File"
LOCATE 12, 25
PRINT "(D) Sort The Data"
LOCATE 14, 25
PRINT "(E) Search for Data"
LOCATE 16, 25
PRINT "(Q) Quit"
COLOR 9
LOCATE 18, 25
INPUT "Make your choice ", choice$
END SUB
SUB pause
LOCATE 23, 10
PRINT "Press any key to continue"
x$ = INPUT$(1) 'waits for 1 keypress before going on
END SUB
SUB PrintFile
CLS 'read file and print to screen
PRINT
PRINT "Book", "Author", "Grade", "Room Location" 'Heading
OPEN "A:Books.dat" FOR INPUT AS #1
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
INPUT #1, Title$, author$, Grade, room
PRINT Title$, author$, Grade, room
q = q + 1
LOOP
PRINT "The number of books is"; q
CLOSE #1 'creates an end of file mark
CALL pause
END SUB
SUB printSORT
CLS 'read file and print to screen
PRINT
PRINT "Title", "Author", "Grade", "Room" 'Heading
FOR count = 1 TO max + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
NEXT count
END SUB
SUB quit
CLS
LOCATE 10, 30
PRINT "The Program is over"
CALL pause
END SUB
SUB sEARCHAUTHOR
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
CLS
COLOR 5
p = 0
INPUT "What author do you want to seach for----> "; TeacherGuess$
PRINT
PRINT
FOR count = 1 TO index
IF author$(count) = TeacherGuess$ THEN
flag = 1
IF p < 1 THEN
PRINT "Title", "Author", "Grade", "Room" 'Heading
END IF
p = p + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
END IF
NEXT
IF flag <> 1 THEN PRINT "NOT FOUND!!!!!"
pause
END SUB
SUB SEARCHGRADE
CLS
COLOR 5
p = 0
INPUT "What grade do you want to seach for----> "; TeacherGuess
PRINT
PRINT
FOR count = 1 TO index
IF Grade(count) = TeacherGuess THEN
flag = 1
IF p < 1 THEN
PRINT "Title", "Author", "Grade", "Room" 'Heading
END IF
p = p + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
END IF
NEXT
IF flag <> 1 THEN PRINT "NOT FOUND!!!!!"
pause
END SUB
SUB SearchMenu
CLS
LOCATE 4, 25
PRINT "Search Menu"
LOCATE 6, 25
PRINT "(A) Search By Title"
LOCATE 8, 25
PRINT "(B) Search By Author"
LOCATE 10, 25
PRINT "(C) Search By Grade"
LOCATE 12, 25
PRINT "(D) Search by Room Number"
LOCATE 14, 25
PRINT "(E) Go Back"
INPUT "Enter your selection", search$
SELECT CASE search$
CASE "A", "a"
searchTITLE
CASE "B", "b"
sEARCHAUTHOR
CASE "C", "c"
SEARCHGRADE
CASE "D", "d"
SEARCHROOM
CASE "E", "e"
menu
CASE ELSE
errormessage
END SELECT
END SUB
SUB SEARCHROOM
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
INPUT "What room do you want to seach for----> "; TeacherGuess
PRINT
PRINT
FOR count = 1 TO index
IF room(count) = TeacherGuess THEN
flag = 1
IF p < 1 THEN
PRINT "Title", "Author", "Grade", "Room" 'Heading
END IF
p = p + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
END IF
NEXT
IF flag <> 1 THEN PRINT "NOT FOUND!!!!!"
pause
END SUB
SUB searchTITLE
CLS
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
INPUT "What Title do you want to seach for----> "; TeacherGuess$
PRINT
PRINT
FOR count = 1 TO index
IF Title$(count) = TeacherGuess$ THEN
flag = 1
IF p < 1 THEN
PRINT "Title", "Author", "Grade", "Room" 'Heading
END IF
p = p + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
END IF
NEXT
IF flag <> 1 THEN PRINT "NOT FOUND!!!!!"
pause
END SUB
SUB SORTbyAUTHOR
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
max = index - 1
swapflag = 0
DO WHILE swapflag = 0
swapflag = 1
FOR count = 1 TO max
IF author$(count) > author$(count + 1) THEN
SWAP Title$(count), Title$(count + 1)
SWAP author$(count), author$(count + 1)
SWAP Grade(count), Grade(count + 1)
SWAP room(count), room(count + 1)
swapflag = 0
END IF
NEXT count
LOOP
printSORT
pause
END SUB
SUB SORTbyGRADE
OPEN "A:books.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
max = index - 1
swapflag = 0
DO WHILE swapflag = 0
swapflag = 1
FOR count = 1 TO max
IF Grade(count) > Grade(count + 1) THEN
SWAP Title$(count), Title$(count + 1)
SWAP author$(count), author$(count + 1)
SWAP Grade(count), Grade(count + 1)
SWAP room(count), room(count + 1)
swapflag = 0
END IF
NEXT count
LOOP
printSORT
pause
END SUB
SUB SORTbyLOCATION
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
max = index - 1
swapflag = 0
DO WHILE swapflag = 0
swapflag = 1
FOR count = 1 TO max
IF room(count) > room(count + 1) THEN
SWAP Title$(count), Title$(count + 1)
SWAP author$(count), author$(count + 1)
SWAP Grade(count), Grade(count + 1)
SWAP room(count), room(count + 1)
swapflag = 0
END IF
NEXT count
LOOP
printSORT
pause
END SUB
SUB SORTbyTITLE
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
max = index - 1
swapflag = 0
DO WHILE swapflag = 0
swapflag = 1
FOR count = 1 TO max
IF Title$(count) > Title$(count + 1) THEN
SWAP Title$(count), Title$(count + 1)
SWAP author$(count), author$(count + 1)
SWAP Grade(count), Grade(count + 1)
SWAP room(count), room(count + 1)
swapflag = 0
END IF
NEXT count
LOOP
printSORT
pause
END SUB
SUB sortgrade
CLS
COLOR 5
p = 0
OPEN "A:bOOKS.dat" FOR INPUT AS #1
index = 0
DO UNTIL EOF(1) 'end of file mark put there by CLOSE #1 command
index = index + 1
INPUT #1, Title$(index), author$(index), Grade(index), room(index)
LOOP
CLOSE #1 'creates an end of file mark '** reads data from file to an array
INPUT "What grade do you want to seach for----> "; TeacherGuess
PRINT
PRINT
FOR count = 1 TO index
IF Grade(count) = TeacherGuess THEN
flag = 1
IF p < 1 THEN
PRINT "Title", "Author", "Grade", "Room" 'Heading
END IF
p = p + 1
PRINT Title$(count), author$(count), Grade(count), room(count)
END IF
NEXT
IF flag <> 1 THEN PRINT "NOT FOUND!!!!!"
pause
END SUB
SUB SortMenu
top:
CLS
COLOR 15
LOCATE 4, 25
PRINT "Sort Menu"
COLOR 10
LOCATE 6, 25
PRINT "(A) Sort by title"
LOCATE 8, 25
PRINT "(B) Sort by author"
LOCATE 10, 25
PRINT "(C) sort by grade"
LOCATE 12, 25
PRINT "(D) Sort by location"
LOCATE 14, 25
PRINT "(E) GO Back"
COLOR 11
LOCATE 16, 25
INPUT "Make your choice ", sort$
SELECT CASE sort$
CASE "A", "a"
3 SORTbyTITLE
CASE "B", "b"
SORTbyAUTHOR
CASE "C", "c"
SORTbyGRADE
CASE "D", "d"
SORTbyLOCATION
CASE "E", "e"
GOTO bottom
CASE ELSE
CALL errormessage
END SELECT
GOTO top
bottom:
END SUB