home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
entry141.zip
/
ENTRY.BAS
next >
Wrap
BASIC Source File
|
1991-02-18
|
27KB
|
1,155 lines
'***************************************************************************
'* ENTRY -- A simple editor for generating fixed field data files *
'* written in QuickBASIC 4.5 COLOR VERSION 1.41 *
'* (c) 1988, 1990 by DAVID WESSON, PhD. *
'***************************************************************************
'
' $INCLUDE: 'entry.dec'
'
'============================ PROGRAM STARTS ===============================
OPTION BASE 1
CLS
initialize
header
readcommandline
filebusiness
savebakfile
DO
menuroutine
LOOP
'============================ PROGRAM ENDS ==================================
SUB autosave STATIC
savecursor
IF saveinterval = 0 THEN EXIT SUB
IF time2 >= (time1 + saveinterval) THEN
time1 = time2
savebakfile
OPEN outfile$ FOR APPEND AS #1
END IF
LOCATE saverow, savecol
END SUB
SUB checkname STATIC
COLOR fore, back
CLS 2
askname$ = "Datafile: " + infile$ + " [Return] use this name, [Space] use new name."
prompt askname$
getkey
in$ = UCASE$(in$)
SELECT CASE in$
CASE enter$
EXIT SUB
CASE esc$
EXIT SUB
CASE CHR$(32)
numcases = 0
datalines = 0
getfilename
filebusiness
CASE ELSE
checkname
END SELECT
END SUB
SUB clear25 STATIC
LOCATE 25, 1
COLOR back, fore
PRINT SPACE$(80);
END SUB
SUB clearcard STATIC
COLOR black, fore
LOCATE 8, col
PRINT CHR$(32);
FOR x = 0 TO 9
LOCATE 10 + x, col
PRINT MID$(STR$(x), 2, 1);
NEXT x
LOCATE 20, col
PRINT CHR$(32)
LOCATE row, col
END SUB
SUB click STATIC
IF soundonoff = 0 THEN
EXIT SUB
ELSE s = VAL(data$(col))
SOUND (210 + (s * 32)), .6
END IF
END SUB
SUB counter STATIC
savecursor
IF escape = 0 THEN
COLOR fore, back
LOCATE row - 1, 1
PRINT SPACE$(80)
LOCATE row - 1, col
COLOR 26, back
PRINT CHR$(24)
LOCATE saverow, savecol
END IF
END SUB
SUB cursor (value) STATIC
SELECT CASE value
CASE 0
LOCATE , , 0, 0, 0
CASE 1
LOCATE , , 1, 6, 7
END SELECT
END SUB
SUB dataroutine STATIC
DO
COLOR fore, back
LOCATE 3, 1: PRINT "CASE:"; numcases
LOCATE 4, 1: PRINT "LINE:"; card
LOCATE 6, 1: PRINT SPACE$(80)
LOCATE 6, 1: PRINT cardset$(card)
filecard row
col = 1
eol = 0
COLOR 0, 6
GetCase:
DO
readcolumn
IF eol = 1 THEN EXIT DO
LOCATE row, col
counter
numpadscan
COLOR 0, 6
getkey
SELECT CASE in$
CASE "EOL"
EXIT DO
CASE enter$
filecard row
col = 1
CASE esc$
datalines = datalines - 1
numberpad 0
cursor 0
COLOR fore, back
CLS 2
CLOSE
makedeffile
EXIT SUB
CASE bksp$
BackUp:
IF col > 1 THEN
col = col - 1
clearcard
IF column$(col, card) = "C" OR column$(col, card) = "P" OR column$(col, card) = "B" THEN GOTO BackUp
ELSE BEEP
END IF
CASE lft$
LeftSpace:
IF col > 1 THEN
col = col - 1
LOCATE row, col
IF column$(col, card) = "C" OR column$(col, card) = "P" OR column$(col, card) = "B" THEN GOTO LeftSpace
ELSE BEEP
END IF
CASE rght$
IF col < 80 THEN
col = col + 1
LOCATE row, col
ELSE BEEP
END IF
CASE home$
LOCATE row, 1
col = 1
IF column$(1, card) = "C" THEN LOCATE row, 5: col = 5
CASE end$
col = LEN(cardset$(card))
IF column$(col, card) = "+" THEN col = col - 1
LOCATE row, col
CASE fkey$(1)
savecursor
minihelp
LOCATE saverow, savecol
CASE fkey$(2)
savecursor
COLOR fore, back
LOCATE 21, 1: PRINT SPACE$(320)
LOCATE saverow, savecol
CASE fkey$(3) TO fkey$(10)
BEEP
CASE delete$
IF data$(col) < CHR$(58) THEN clearcard
data$(col) = CHR$(32)
LOCATE row, col
PRINT CHR$(32);
col = col + 1
CASE insert$
IF data$(col) < CHR$(58) THEN clearcard
data$(col) = CHR$(32)
LOCATE row, col
PRINT CHR$(32);
CASE plus$
b = INSTR(col, cardset$(card), "B")
p = INSTR(col, cardset$(card), "P")
IF b = 0 AND p = 0 THEN
col = LEN(cardset$(card)) + 1
ELSEIF p = 0 OR b = 0 THEN
IF p = 0 THEN col = b
IF b = 0 THEN col = p
ELSE
IF p < b THEN col = p
IF b < p THEN col = b
END IF
LOCATE row, col
CASE ELSE
IF column$(col, card) = "N" AND (in$ < CHR$(32) OR in$ > CHR$(58)) THEN BEEP: GOTO GetCase
data$(col) = UCASE$(in$)
clearcard
LOCATE row, col
PRINT data$(col);
IF data$(col) < CHR$(58) AND data$(col) > CHR$(42) THEN punch
col = col + 1
END SELECT
LOOP
LOOP UNTIL numcases = 10000
END SUB
SUB editline25 STATIC
clear25
LOCATE 25, 1
COLOR high, fore
PRINT " [Esc] MENU "; CHR$(179);
PRINT " [F1] MiniHelp "; CHR$(179);
PRINT " NumberPad: ";
COLOR back, fore
PRINT pad$;
COLOR high, fore
PRINT " "; CHR$(179);
PRINT " Autosave:"; saveinterval; "sec.";
END SUB
SUB editlines STATIC
Top:
LOCATE 3, 1: PRINT "Datafile: "; outfile$;
PRINT TAB(40); "Total Cases:"; numcases; TAB(60); "Cards per Case:"; card
prompt "Hit any key to edit a card, or [Esc] to EXIT."
LOCATE 25, 1
getkey
IF in$ = esc$ THEN EXIT SUB
COLOR fore, back
cursor 1
numberpad 1
prompt "Edit CASE: CARD: "
LOCATE 25, 37
keyin 4
IF k$ = "" THEN k$ = STR$(editcase)
IF in$ = esc$ THEN EXIT SUB
editcase = VAL(k$)
IF editcase = 0 THEN editcase = 1
LOCATE 25, 52
keyin 1
IF k$ = "" THEN k$ = STR$(editcard)
IF in$ = esc$ THEN EXIT SUB
editcard = VAL(k$)
IF editcard > 3 OR editcard = 0 THEN editcard = 1
editline = ((editcase - 1) * card) + editcard
LOCATE 6, 1: PRINT "CASE:"; editcase
LOCATE 7, 1: PRINT "CARD:"; editcard
ruler 8
row = 10: col = 1
numberpad 0
LOCATE 9, 1: PRINT cardset$(editcard)
getdataline
LOCATE row, col: PRINT dataline$
cardlength = LEN(dataline$)
saveline$ = dataline$
IF saveline$ = "" THEN
prompt "Can't edit empty data line. Hit a key to continue."
getkey
COLOR fore, back
CLS 2
GOTO Top
END IF
editline25
escape = 0
cursor 0
DO
LOCATE row + 1, 1: PRINT SPACE$(80)
LOCATE row + 1, col: COLOR fore, back: PRINT CHR$(24)
LOCATE row, col
getkey
click
SELECT CASE in$
CASE lft$
IF col > 1 THEN col = col - 1
CASE rght$
IF col < cardlength THEN col = col + 1
CASE home$
col = 1
CASE end$
col = cardlength
CASE bksp$
IF col > 1 THEN col = col - 1
CASE delete$
MID$(dataline$, col, 1) = CHR$(32)
PRINT CHR$(32);
IF col < cardlength THEN col = col + 1
CASE insert$
MID$(dataline$, col, 1) = CHR$(32)
PRINT CHR$(32);
CASE esc$
dataline$ = saveline$
escape = 1
COLOR fore, back
CLS 2
GOTO Top
CASE enter$
COLOR fore, back
CLS 2
escape = 1
writedataline
GOTO Top
CASE fkey$(1)
savecursor
minihelp
LOCATE saverow, savecol
CASE fkey$(2)
savecursor
COLOR fore, back
LOCATE 21, 1: PRINT SPACE$(320)
LOCATE saverow, savecol
CASE fkey$(3) TO fkey$(10), up$, down$
BEEP
CASE ELSE
MID$(dataline$, col, 1) = in$
PRINT in$;
IF col < cardlength THEN
col = col + 1
ELSE BEEP
END IF
END SELECT
LOOP
END SUB
SUB editor STATIC
cursor 0
escape = 0
editline25
COLOR fore, back
LOCATE 2, 1
PRINT "FILE: "; UCASE$(infile$)
ruler 5
numberpad 1
OPEN outfile$ FOR APPEND AS #1
time1 = TIMER
datalines = datalines + 1
numcases = numcases + 1
row = 8
card = 1
dataroutine
numberpad 0
cursor 0
COLOR fore, back
CLS 2
savebakfile
CLOSE
END SUB
SUB filebusiness STATIC
splitfilename
bakfile$ = file$ + ".BAK"
outfile$ = infile$
deffile$ = file$ + ".DEF"
tempfile$ = file$ + ".TMP"
END SUB
SUB filecard (row) STATIC
LOCATE row, 1
COLOR black, fore
PRINT SPACE$(160)
FOR x = 0 TO 9
PRINT STRING$(80, CHR$(48 + x))
NEXT x
PRINT SPACE$(80)
COLOR fore, back
END SUB
SUB getbyte STATIC
DO
counter
getkey
byte$ = in$
IF byte$ = enter$ THEN EXIT SUB
IF byte$ = esc$ THEN escape = 1: EXIT SUB
readbyte
LOOP
END SUB
SUB getdataline STATIC
prompt "Please wait, getting data line."
OPEN infile$ FOR INPUT AS #1
FOR x = 1 TO editline
LINE INPUT #1, dataline$
NEXT x
CLOSE #1
END SUB
SUB getdeffile STATIC
OPEN deffile$ FOR RANDOM AS #1
IF LOF(1) = 0 THEN CLOSE : setup
CLOSE
card = 1
OPEN deffile$ FOR INPUT AS #1
INPUT #1, datalines
DO
LINE INPUT #1, cardset$(card)
FOR l = 1 TO LEN(cardset$(card))
column$(l, card) = MID$(cardset$(card), l, 1)
NEXT l
IF RIGHT$(cardset$(card), 1) = "+" THEN
card = card + 1
ELSE EXIT DO
END IF
LOOP
CLOSE #1
numcases = FIX(datalines / card)
END SUB
SUB getdirectory STATIC
cursor 0
clear25
COLOR fore, back
CLS 2
dirlist$ = drive$ + "dir.lst"
dir$ = "dir " + drive$ + " > " + dirlist$
SHELL dir$
OPEN dirlist$ FOR INPUT AS #1
prompt "Hit any key to continue."
COLOR fore, back
VIEW PRINT 2 TO 24
LOCATE 3, 3
DO WHILE NOT EOF(1)
l = l + 1
LINE INPUT #1, l$
LOCATE , 3: PRINT l$
IF l = 23 THEN getkey: l = 1
IF in$ = esc$ THEN EXIT DO
LOOP
VIEW PRINT 2 TO 25
CLOSE #1
KILL dirlist$
IF in$ <> esc$ THEN getkey
END SUB
SUB getdirname STATIC
COLOR fore, back
CLS 2
l$(18) = "Which DRIVE are your files stored on?"
l$(19) = " A: for A: drive"
l$(20) = " B: for B: drive"
l$(21) = " \path for subdirectory "
l$(23) = "[Return] for current drive or directory"
writescreen 20
prompt "Enter drive or path: "
keyin 30
IF k$ = esc$ THEN goodbye
IF LEN(k$) = 1 THEN k$ = k$ + ":"
IF NOT LEN(k$) = 2 AND NOT k$ = "" AND NOT RIGHT$(k$, 1) = "\" THEN k$ = k$ + "\"
drive$ = UCASE$(k$)
END SUB
SUB getfilename STATIC
COLOR fore, back
CLS 2
l$(23) = "Hit [Return] to see directory list."
writescreen 21
prompt "Enter filename: "
LOCATE 25, 37
keyin 12
IF in$ = esc$ THEN EXIT SUB
IF k$ = "" THEN
getdirectory
getfilename
ELSE infile$ = drive$ + k$
END IF
END SUB
SUB getinifile
OPEN "entry.ini" FOR APPEND AS 1
IF LOF(1) <> 0 THEN
CLOSE 1
OPEN "entry.ini" FOR INPUT AS 1
a$ = INPUT$(6, #1)
INPUT #1, fore
a$ = INPUT$(6, #1)
INPUT #1, back
a$ = INPUT$(6, #1)
INPUT #1, high
a$ = INPUT$(6, #1)
INPUT #1, saveinterval
a$ = INPUT$(7, #1)
INPUT #1, soundonoff
ELSE
IF monitortype = 2 THEN
fore = 14
back = 4
high = 3
black = 0
ELSE
fore = 7
back = 0
high = 15
black = 0
END IF
saveinterval = 120
soundonoff = 1
END IF
CLOSE 1
END SUB
SUB getkey STATIC
w: in$ = INKEY$: IF in$ = "" THEN numpadscan: GOTO w
END SUB
SUB getset STATIC
DO
col = POS(0)
getkey
in$ = UCASE$(in$)
SELECT CASE in$
CASE enter$
EXIT DO
CASE esc$
EXIT SUB
CASE bksp$, lft$
IF col > 1 THEN
col = col - 1
LOCATE , col
PRINT CHR$(32);
LOCATE , col
cardset$(card) = LEFT$(cardset$(card), col - 1)
ELSE col = 1
END IF
CASE "C", "A", "N", "B", "P", "+", ".", ","
IF in$ = "+" THEN
IF card = 3 THEN EXIT DO
cardset$(card) = cardset$(card) + in$
PRINT in$;
card = card + 1
setuproutine
ELSE cardset$(card) = cardset$(card) + in$
PRINT in$;
END IF
CASE ELSE
BEEP
END SELECT
LOOP UNTIL col = 80
END SUB
SUB goodbye STATIC
COLOR 7, 0
VIEW PRINT
CLS
IF infile$ = "" THEN GOTO FastOut
writeinifile
PRINT "THANKS for using ENTRY."
PRINT "To renter this file in the future, type ENTRY "; infile$
PRINT "Original file, if any, is now in "; bakfile$
FastOut:
numberpad 0
CLOSE
END
END SUB
SUB header
VIEW PRINT
COLOR back, fore
LOCATE 1, 1: PRINT SPACE$(80);
LOCATE 1, 20
COLOR high, fore
PRINT "ENTRY: Dr.Funkey's Data Entry Program v1.41"
VIEW PRINT 2 TO 25
END SUB
SUB helpscreen STATIC
l$(4) = "DATA ENTRY AND EDITING OPTIONS"
l$(6) = " [Space] Enters an blank column."
l$(7) = " [Return] Aborts current line. Starts over."
l$(8) = " [BackSpace] Deletes left of cursor, moves to left. "
l$(9) = " [*] Accepted as Missing Value in Numeric Field"
l$(10) = " [Esc] EXIT to MENU."
l$(12) = "Hit [NumLock] to use following keys. Hit again to use numberpad."
l$(14) = " [<--] [-->] Move left or right."
l$(16) = " [Home] Cursor to beginning of line."
l$(18) = " [End] Cursor to end of line"
l$(20) = " [Delete] Deletes at cursor, moves to right."
l$(22) = " [Insert] Delete at cursor, cursor stays put."
prompt "Hit any key to continue."
writescreen 10
getkey
END SUB
SUB initialize
cards = 3
items = 11
escape = 1
DIM menu$(items)
DIM l$(25)
DIM column$(81, cards)
DIM data$(80)
DIM fkey$(items)
DIM cardset$(cards)
getinifile
setnames
END SUB
SUB issuecommand STATIC
COLOR fore, back
CLS
LOCATE 20, 1
PRINT "Type EXIT to return to ENTRY."
SHELL
header
END SUB
SUB keyin (length) STATIC
inlen = length
cursor 1
k$ = ""
getbyte
END SUB
SUB makedeffile STATIC
OPEN deffile$ FOR OUTPUT AS #1
PRINT #1, datalines
FOR c = 1 TO 3
IF cardset$(c) <> "" THEN PRINT #1, cardset$(c)
NEXT c
CLOSE #1
END SUB
SUB menufunctions STATIC
COLOR fore, back
CLS 2
SELECT CASE in$
CASE fkey$(1)
getdeffile
editor
CASE fkey$(2)
helpscreen
CASE fkey$(3)
checkname
setup
CASE fkey$(4)
getdeffile
editlines
CASE fkey$(5)
prompt "Please wait, saving backup file first."
savebakfile
CLOSE
issuecommand
CASE fkey$(6)
setcolor
setsave
writeinifile
CASE fkey$(7)
getdeffile
printfile
CASE fkey$(8)
soundoff
CASE fkey$(9)
getdirname
CASE fkey$(10)
getdirectory
CASE esc$
goodbye
END SELECT
END SUB
SUB menuinput STATIC
item = 1
DO
LOCATE (item * 2) + 1, 24
COLOR high, fore
PRINT menu$(item)
COLOR fore, back
getkey
LOCATE (item * 2) + 1, 24: PRINT menu$(item)
FOR a = 1 TO 11
IF in$ = fkey$(a) THEN EXIT SUB
NEXT a
SELECT CASE in$
CASE esc$: EXIT SUB
CASE enter$: in$ = fkey$(item)
EXIT SUB
CASE up$: item = item - 1
CASE down$: item = item + 1
END SELECT
IF item = items + 1 THEN item = 1
IF item = 0 THEN item = items
LOOP
END SUB
SUB menuroutine STATIC
COLOR fore, back
CLS
escape = 1
menuscreen
menuinput
menufunctions
END SUB
SUB menuscreen STATIC
COLOR fore, back
FOR l = 1 TO 24
l$(l) = ""
NEXT l
l$(3) = "[F1] Enter data in datafile": menu$(1) = l$(3)
l$(5) = "[F2] Help with entering data": menu$(2) = l$(5)
l$(7) = "[F3] Set up new datafile": menu$(3) = l$(7)
l$(9) = "[F4] Edit existing data": menu$(4) = l$(9)
l$(11) = "[F5] Issue a DOS command": menu$(5) = l$(11)
l$(13) = "[F6] Set autosave and color": menu$(6) = l$(13)
l$(15) = "[F7] Print this file": menu$(7) = l$(15)
l$(17) = "[F8] Turn sound ON/OFF": menu$(8) = l$(17)
l$(19) = "[F9] Change drive": menu$(9) = l$(19)
l$(21) = "[F10] See drive directory": menu$(10) = l$(21)
l$(23) = "[Esc] EXIT program to DOS": menu$(11) = l$(23)
writescreen 24
IF soundonoff = 1 THEN s$ = "OFF " ELSE s$ = "ON "
LOCATE 17, 41
COLOR high, back
PRINT s$
prompt "Use cursor keys, then [Return] or hit Function Key."
END SUB
SUB minihelp STATIC
COLOR fore, back
LOCATE 21, 1
PRINT "[Space] enter BLANK col [Return] ABORT line [BackSpace] Delete to left"
PRINT "[Home] goto BEGIN line [End] goto END line [Insert] Delete at cursor"
PRINT "[F2] remove this MINIHELP panel [Delete] Delete, move right "
PRINT "[NumLock] to use arrow keys. [Numlock] again to enter data"
END SUB
FUNCTION monitortype
DEF SEG = 0
IF (PEEK(&H410) AND &H30) = &H30 THEN
monotype = 1
ELSE monotype = 2
END IF
DEF SEG
END FUNCTION
SUB numberpad (value) STATIC
IF value = 1 THEN
DEF SEG = &H40
POKE &H17, PEEK(&H17) OR 32
ELSEIF value = 0 THEN
DEF SEG = &H40
POKE &H17, PEEK(&H17) AND 223
END IF
END SUB
SUB numpadscan STATIC
num = PEEK(&H17)
IF num = 0 THEN
pad$ = "OFF"
ELSE IF num = 32 OR num = 128 THEN pad$ = "ON "
END IF
IF escape = 0 THEN
savecursor
COLOR back, fore
LOCATE 25, 51: PRINT pad$;
COLOR fore, back
LOCATE saverow, savecol
END IF
END SUB
SUB openingscreen STATIC
l$(5) = "If you remember the bad old days of datacards, you remember bad"
l$(6) = "old cardpunch machines. But there was one function on that clunker"
l$(7) = "that was quite useful--the program drum. It permitted you to program"
l$(8) = "the datatype for each column of data, skip columns and automatically"
l$(9) = "start a new case. Good aids for data entry!"
l$(11) = "This program combines these functions with some of the advantages of"
l$(12) = "screen data entry, such as the ability to backspace for corrections."
l$(13) = "This program is limited to data for 9,999 cases of 3 cards per case"
l$(14) = "with 80 columns maximum each."
l$(16) = "If you use this program for commercial purposes, you are obligated to"
l$(17) = "the author for a payment of £10. Otherwise, use and enjoy."
l$(23) = " (c) 1988, 90, 91 David A. Wesson"
prompt "Hit any key to continue or [Esc] to EXIT. "
cursor 1
writescreen 6
getkey
IF in$ = esc$ THEN goodbye
END SUB
SUB printfile STATIC
OPEN infile$ FOR INPUT AS #1
IF LOF(1) = 0 THEN
prompt "Empty datafile. Hit a key"
getkey
EXIT SUB
END IF
prompt "Make sure printer is turned on. Hit a key."
getkey
IF in$ = esc$ THEN EXIT SUB
prompt "Hit [Esc] to ABORT printing (except what is already in buffer.)"
LOCATE 24, 1
FOR n = 1 TO datalines
i$ = INKEY$
IF i$ = esc$ THEN CLOSE #1: LPRINT CHR$(24): EXIT SUB
INPUT #1, data$
LPRINT data$
NEXT n
CLOSE #1
END SUB
SUB prompt (p$) STATIC
cursor 0
clear25
COLOR high, fore
LOCATE 25, (40 - (LEN(p$) / 2))
PRINT p$;
END SUB
SUB punch STATIC
IF VAL(data$(col)) >= 0 AND VAL(data$(col)) < 10 THEN
savecursor
LOCATE row + 2 + VAL(data$(col)), col
COLOR black, black
PRINT CHR$(255)
click
COLOR back, fore
LOCATE saverow, savecol
END IF
END SUB
SUB readbyte STATIC
col = POS(0): row = CSRLIN
IF byte$ = fkey$(2) THEN savecursor: setsave: LOCATE saverow, savecol
IF byte$ = home$ THEN GOTO HomeKey
IF byte$ = end$ THEN GOTO EndKey
IF byte$ = bksp$ THEN GOTO BackSpace
IF byte$ = lft$ THEN GOTO LeftKey
IF byte$ = rght$ THEN GOTO RightKey
IF byte$ = delete$ THEN GOTO DeleteKey
IF byte$ < CHR$(32) OR byte$ > CHR$(126) THEN EXIT SUB
IF LEN(k$) = inlen THEN BEEP: EXIT SUB
PRINT byte$;
k$ = k$ + byte$
EXIT SUB
BackSpace:
IF col > 1 AND k$ <> "" THEN
LOCATE , col - 1: PRINT CHR$(32);
LOCATE , col - 1
k$ = LEFT$(k$, LEN(k$) - 1)
ELSE click: getbyte
END IF
EXIT SUB
LeftKey:
IF col > 1 AND k$ <> "" THEN
col = col - 1
LOCATE row, col
ELSE click: getbyte
END IF
EXIT SUB
RightKey:
IF col < length THEN
col = col + 1
ELSE click: getbyte
END IF
EXIT SUB
EndKey:
col = LEN(k$)
LOCATE row, col
EXIT SUB
HomeKey:
col = 1
LOCATE row, col
EXIT SUB
DeleteKey:
IF k$ <> "" THEN
k$ = LEFT$(k$, incol - 1) + MID$(k$, incol + 1)
LOCATE , 1: PRINT k$ + SPACE$(1)
END IF
EXIT SUB
InsertKey:
k$ = LEFT$(k$, col - 1) + CHR$(32) + MID$(k$, col + 1)
LOCATE row, 1: PRINT k$;
LOCATE row, col
EXIT SUB
END SUB
SUB readcolumn STATIC
COLOR back, fore
SELECT CASE column$(col, card)
CASE ""
BEEP
writeline
time2 = TIMER
autosave
card = 1
numcases = numcases + 1
eol = 1
CASE "C"
IF numcases < 10 THEN casenum$ = "0" + "0" + "0" + MID$(STR$(numcases), 2, 1)
IF numcases > 9 AND numcases < 100 THEN casenum$ = "0" + "0" + MID$(STR$(numcases), 2, 2)
IF numcases > 99 AND numcases < 1000 THEN casenum$ = "0" + MID$(STR$(numcases), 2, 3)
IF numcases > 999 AND numcases < 10000 THEN casenum$ = MID$(STR$(numcases), 2, 4)
FOR c = 1 TO 4
data$(col) = MID$(casenum$, c, 1)
COLOR black, fore
LOCATE row, col: PRINT data$(col)
punch
col = col + 1
NEXT c
readcolumn
CASE "B"
LOCATE row, col
data$(col) = CHR$(32)
col = col + 1
readcolumn
CASE "P"
BEEP
data$(col) = CHR$(32)
col = col + 1
readcolumn
CASE "."
data$(col) = CHR$(46)
PRINT CHR$(46);
col = col + 1
readcolumn
CASE ","
data$(col) = CHR$(44)
PRINT CHR$(44);
col = col + 1
readcolumn
CASE "+"
BEEP
writeline
card = card + 1
eol = 1
END SELECT
END SUB
SUB readcommandline STATIC
infile$ = UCASE$(COMMAND$)
IF infile$ = "" THEN
openingscreen
getdirname
getfilename
END IF
END SUB
SUB ruler (row) STATIC
LOCATE row, 1
FOR z = 1 TO 8
COLOR black, fore: PRINT "123456789";
COLOR high, fore: PRINT MID$(STR$(z), 2, 1);
NEXT z
END SUB
SUB savebakfile STATIC
CLOSE
LOCATE 24, 1
makebak$ = "COPY " + outfile$ + " " + bakfile$ + " > nul"
SHELL makebak$
END SUB
SUB savecursor STATIC
savecol = POS(0)
saverow = CSRLIN
END SUB
SUB setcolor
prompt "Hit [Return] to reset entry to original setting."
COLOR back, fore
LOCATE 18, 15
PRINT " Enter a number for each color selection. "
LOCATE 19, 15
PRINT " 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 "
LOCATE 20, 15
FOR x = 0 TO 9
COLOR x, fore: PRINT STRING$(3, 254);
NEXT x
FOR x = 10 TO 15
COLOR x, fore: PRINT STRING$(4, 254);
NEXT x
COLOR fore, back
LOCATE 23, 15
PRINT " FOREGROUND: " + STRING$(2, 254) + " BACKGROUND: " + STRING$(2, 254) + " HIGHLIGHT: " + STRING$(2, 254) + " "
LOCATE 23, 30
keyin 2
f = VAL(k$)
IF f <> 0 THEN fore = f
header
LOCATE 23, 47
keyin 2
b = VAL(k$)
IF b <> fore THEN back = b
header
LOCATE 23, 63
keyin 2
h = VAL(k$)
IF h <> back THEN high = h
header
END SUB
SUB setnames
esc$ = CHR$(27)
bksp$ = CHR$(8)
tab$ = CHR$(9)
enter$ = CHR$(13)
delete$ = CHR$(0) + CHR$(83)
insert$ = CHR$(0) + CHR$(82)
btab$ = CHR$(0) + CHR$(15)
pgup$ = CHR$(0) + CHR$(73)
pgdn$ = CHR$(0) + CHR$(81)
home$ = CHR$(0) + CHR$(71)
end$ = CHR$(0) + CHR$(79)
up$ = CHR$(0) + CHR$(72)
lft$ = CHR$(0) + CHR$(75)
rght$ = CHR$(0) + CHR$(77)
down$ = CHR$(0) + CHR$(80)
plus$ = CHR$(43)
fkey$(1) = CHR$(0) + CHR$(59)
fkey$(2) = CHR$(0) + CHR$(60)
fkey$(3) = CHR$(0) + CHR$(61)
fkey$(4) = CHR$(0) + CHR$(62)
fkey$(5) = CHR$(0) + CHR$(63)
fkey$(6) = CHR$(0) + CHR$(64)
fkey$(7) = CHR$(0) + CHR$(65)
fkey$(8) = CHR$(0) + CHR$(66)
fkey$(9) = CHR$(0) + CHR$(67)
fkey$(10) = CHR$(0) + CHR$(68)
numlock$ = CHR$(&H20) + CHR$(45)
altminus$ = CHR$(0) + CHR$(130)
altplus$ = CHR$(0) + CHR$(131)
END SUB
SUB setsave STATIC
escape = 1
saveline$ = "Current Autosave interval is" + STR$(saveinterval) + " seconds. New interval: "
prompt saveline$
LOCATE 25, 68
keyin 3
IF k$ = "" THEN EXIT SUB
IF VAL(k$) < 20 OR VAL(k$) > 999 THEN
saveinterval = 0
ELSE saveinterval = VAL(k$)
END IF
escape = 0
END SUB
SUB setup STATIC
IF in$ = esc$ THEN EXIT SUB
l$(6) = "C Enter CCCC for case numbers. Program assumes 9,999 cases max."
l$(7) = " The computer will enter the sequential numbers for you."
l$(9) = "A Alphanumerics are Any letter or number, but numbers will "
l$(10) = " not be treated as numerical data. Use N for numerical data."
l$(12) = "B Enter B for a blank column to help section data."
l$(14) = "P Enter P where you turn a page in your instrument. Will BEEP here."
l$(15) = " Program will beep and enter a blank column for you."
l$(17) = ". , Enter a period or comma to have these automatically entered."
l$(19) = "+ Enter a plus to continue onto next card. 3 card maximum."
l$(21) = "Use BackSpace or Left Cursor [ <-- ] to make corrections."
l$(23) = "Hit [Return] to FINISH data entry setup. Hit [Esc] to ABORT."
writescreen 8
prompt "Enter C A N B P . , + [Esc] Abort [Return] Finish."
card = 1
FOR x = 1 TO 3
cardset$(x) = ""
NEXT x
setuproutine
END SUB
SUB setuproutine STATIC
COLOR fore, back
LOCATE 2, 1: PRINT "DATA LINE:"; card; TAB(40); "DATA FILE: "; UCASE$(infile$)
ruler 3
COLOR fore, back
LOCATE 4, 1: PRINT SPACE$(80)
cursor 1
LOCATE 4, 1
getset
IF in$ <> esc$ THEN makedeffile
COLOR fore, back
CLS 2
END SUB
SUB soundoff STATIC
IF soundonoff = 1 THEN
soundonoff = 0
ELSEIF soundonoff = 0 THEN soundonoff = 1
END IF
writeinifile
END SUB
SUB splitfilename STATIC
period = INSTR(infile$, ".")
IF period = 0 THEN
file$ = infile$
ext$ = ""
ELSE
file$ = LEFT$(infile$, period - 1)
ext$ = MID$(infile$, period + 1)
END IF
END SUB
SUB writedataline STATIC
prompt "Please wait, saving datafile."
OPEN infile$ FOR INPUT AS #1
OPEN tempfile$ FOR OUTPUT AS #2
WHILE EOF(1) = 0
n = n + 1
LINE INPUT #1, a$
IF n = editline THEN a$ = dataline$
PRINT #2, a$
WEND
CLOSE
KILL infile$
NAME tempfile$ AS infile$
END SUB
SUB writeinifile
OPEN "entry.ini" FOR OUTPUT AS 1
PRINT #1, "FORE ="; fore
PRINT #1, "BACK ="; back
PRINT #1, "HIGH ="; high
PRINT #1, "SAVE ="; saveinterval
PRINT #1, "SOUND ="; soundonoff
CLOSE 1
END SUB
SUB writeline STATIC
dataline$ = ""
FOR c = 1 TO LEN(cardset$(card))
dataline$ = dataline$ + data$(c)
data$(c) = ""
NEXT c
PRINT #1, dataline$
datalines = datalines + 1
END SUB
SUB writescreen (indent)
cursor 0
VIEW PRINT 2 TO 24
COLOR fore, back
CLS 2
FOR x = 3 TO 24
IF NOT l$(x) = "" THEN
LOCATE x, indent: PRINT l$(x);
l$(x) = ""
END IF
NEXT x
VIEW PRINT 2 TO 25
END SUB