home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
pb
/
library3
/
fentry-u.bas
< prev
next >
Wrap
BASIC Source File
|
1990-11-20
|
26KB
|
868 lines
'==============================================================================
' HB'S ALL-PURPOSE LIBRARY, FORMATTED ENTRY UNIT -- FENTRY-U.BAS
'==============================================================================
' -- 2-13-90
$COMPILE UNIT
$ERROR ALL OFF
DEFINT A-Z
%False = 0
%True = NOT %False
%ReadRodent = 3
%LeftButton = 1
%RightButton = 2
%MaxDecPlaces = 4
%Center = 0
EXTERNAL RD$, ColorDisplay, NeedDCon, SoundOn
EXTERNAL BoxColor, FldColor, WinColor, ScrColor
EXTERNAL CursorTop, CursorBottom, Ln, Col
EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
EXTERNAL LocalAreaCode$,InsertStatus, Record%
SHARED AdvanceCursor
DECLARE FUNCTION FigDate& (STRING)
DECLARE FUNCTION WriteDate$ (LONG)
DECLARE FUNCTION GetDate$ ()
DECLARE SUB CloseFiles ()
DECLARE SUB Mouse (INTEGER, INTEGER, INTEGER, INTEGER)
DECLARE SUB BOXMESSAGE2 (INTEGER, INTEGER, INTEGER, STRING ARRAY,_
INTEGER, INTEGER)
DECLARE SUB SCREENPUSH ()
DECLARE SUB SCREENPOP ()
SUB ENTERSTRING (Wkg$,FLength,Opt$) PUBLIC
' WHAT IS THIS ?? This routine provides a field right at the present cursor
' location for the operator to enter something into (if it starts off
' blank) or edit. Wkg$ is the current value of the field. FLength =
' length of field.
'
' Opt$ may be "" or may hold the strings "Cap" for all uppercase,
' "Auto" to automatically go on when the field is full, "UpOut" or
' "BackOut" if UpArrow or Left/ backspace keys are to be able to end
' entry; also may include "Ins" to start up in the insert mode, and/or
' "-" if the minus sign is allowed to be entered.
'
' Active keys also include: ^Y to clear the line
' ^T to delete one word (to right)
' ^U to undo (restore original string)
' Home, End, cursor rt/left,
' ^cursor (jumps to beginning of a word)
'
' If there is something in the field to begin with and the operator
' starts typing something else, the field clears. If the cursor is
' moved around first, that doesn't happen.
'
' On exiting sub, Opt$ will be reset as "Left", "Auto", "Up", "Down",
' "HELP!", "F2", "ESC" or "CR", "Tab" or "ShfTab" according to what
' event terminated the entry process. At any time during string entry
' the operator can press [CR] or DOWN-ARROW to enter & go on; [F2] can
' be pressed (I use F2 for Database Function commands -- Clear,
' Find, Next/Prev, Save etc.) or F1 can also be made active (for a
' help key) ...
' UPDATE NOTE 11-90: InsertStatus is now an external var so it
' remains on or off from data field to data field.
LOCAL Fpos, Masq$,Starting$, Numeric, Auto, Caps, UpOut, BackOut, K$,_
NoNeg, Z, NumKStrokes, StartWord, EndWord, Done
Wkg$ = LEFT$ (Wkg$, FLength)
Starting$ = Wkg$ ' save starting string --
Ln = CSRLIN: Col = POS
' Scan the Option String for Codes ...
' and set flags accordingly
Numeric = INSTR(Opt$,"Num")
Auto = INSTR(Opt$,"Auto")
Caps = INSTR(Opt$,"Cap")
UpOut = INSTR(Opt$,"UpOut")
BackOut = INSTR(Opt$,"BackOut")
IF INSTR (Opt$, "-") = 0 THEN NoNeg = %True
'' IF INSTR (Opt$, "Ins") THEN InsertStatus = %True
IF FLength > 1 THEN
Masq$ = "\"+SPACE$(FLength-2)+"\"
ELSEIF FLength = 1 THEN
Masq$ = "!"
ELSE
PRINT "SETUP ERROR -- STRING FIELD HAS LENGTH < 1 !!"
Done = %True
END IF
FPos = 1 + AdvanceCursor ' this simulates a part-full
NumKStrokes = AdvanceCursor ' field. Used in ROTADATE.
' ============ WRITE THE FIELD TO DISPLAY =============
DO UNTIL Done
LOCATE Ln, Col,0 ' print the string
PRINT USING Masq$;Wkg$
' now, if you already pressed Up or ShfTab,
' we'll exit after printing restored line
IF Opt$ = "Up" OR Opt$ = "ShfTab" THEN EXIT LOOP
' if "auto-CR" is on and we have reached the end, quit ...
IF Auto AND FPos > FLength THEN Opt$ = "Auto": EXIT LOOP
' if there are trailing spaces, get rid of them
' unless the cursor is out to the right of the last chr ...
IF FPos =< LEN(Wkg$) THEN Wkg$ = RTRIM$(Wkg$)
' ================== SET CURSOR: ===========================
IF ColorDisplay THEN
LOCATE Ln,(Col+FPos-1),1,(6+2*InsertStatus),7
ELSE
LOCATE Ln,(Col+FPos-1),1,(11+4*InsertStatus),12
END IF
DO:LOOP UNTIL INSTAT ' ****************************
K$ = INKEY$ ' ** RECEIVE KEYPRESS ... **
' ****************************
INCR NumKStrokes
SELECT CASE K$
CASE CHR$(0)+CHR$(&H48)
GOSUB EUpArrow
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(&H4B)
GOSUB ELeftArrow
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(&H4D)
GOSUB ERightArrow
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(&H50)
GOSUB EDownArrow
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(&H47)
GOSUB EHomeKey
CASE CHR$(0)+CHR$(&H4F)
GOSUB EEndKey
CASE CHR$(0)+CHR$(&H53)
GOSUB EDelKey
CASE CHR$(0)+CHR$(&H52)
GOSUB EInsKey
CASE CHR$(0)+CHR$(&H3B)
GOSUB EF1Key
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(&H3C)
GOSUB EF2Key
IF Done THEN EXIT LOOP
CASE CHR$(0)+CHR$(115)
GOSUB ECtrlLeftKey
CASE CHR$(0)+CHR$(116)
GOSUB ECtrlRightKey
CASE CHR$(13) 'you pressed [CR]: exit w/ resulting string
Opt$ = "CR"
EXIT LOOP
CASE CHR$(8) ' You pressed [BACKSPACE].
DECR FPos ' back up 1 space;
IF FPos < 1 THEN ' if cursor is trying
IF BackOut THEN ' to get out the left side
Opt$ = "Left" ' of the box and BackOut
EXIT LOOP ' is on, then exit;
ELSE
FPos = 1 ' otherwise place it at position #1
END IF
ELSE
GOSUB EDelKey ' else delete character.
END IF
CASE CHR$(27) ' you pressed [ESC]: exit
Opt$ = "ESC"
EXIT LOOP
CASE CHR$(9) ' you pressed [TAB]: exit
Opt$ = "Tab"
EXIT LOOP
CASE CHR$(0) + CHR$(15) ' you pressed [ShfTAB]: exit
Opt$ = "ShfTab"
EXIT LOOP
CASE CHR$(20)
StartWord = FPos
DO UNTIL MID$ (Wkg$,StartWord,1) = " " OR StartWord = 1
DECR StartWord
LOOP
EndWord = FPos
DO
INCR EndWord
LOOP UNTIL MID$ (Wkg$,EndWord,1) = " " OR EndWord > LEN(Wkg$)
Wkg$ = LEFT$ (Wkg$, StartWord-1) + MID$ (Wkg$, EndWord)
IF LEFT$(Wkg$,1) = " " THEN Wkg$ = MID$(Wkg$,2)
FPos = StartWord
CASE CHR$(25) ' you pressed ^Y
Wkg$ = ""
FPos = 1
CASE CHR$(21) ' you pressed ^U
Wkg$ = Starting$
FPos = 1
CASE ELSE ' some other key was pressed.
IF FPos <= FLength _
AND NOT (InsertStatus=%True AND (LEN(Wkg$) => FLength) AND NumKStrokes >1)_
THEN
' if field isn't full yet, or
' if it is, you don't have 'insert' on, unless this is the first keystroke ...
' (whew !!)
' INS is off, or just starting
IF NumKStrokes = 1 THEN Wkg$ = ""
' this zaps the old entry if you
SELECT CASE ASC(K$) ' start a new one ...
CASE 1 TO 31, >126
K$ = "": EXIT SELECT ' eliminate invalid chrs ...
CASE 32 TO 44, 47, >57
IF Numeric THEN PLAY "O3 A64":K$ = "": EXIT SELECT
CASE 45
IF Numeric AND NoNeg THEN PLAY "O3 A64":K$ = "": EXIT SELECT
END SELECT
IF Caps THEN K$ = UCASE$(K$)
IF FPos > LEN(Wkg$) THEN
DO WHILE FPos-LEN(Wkg$) > 1: Wkg$ = Wkg$ + " ": LOOP
' add spaces out to cursor pos.
Wkg$=Wkg$+K$ ' ... and tack on K$
ELSE
Wkg$ = LEFT$(Wkg$,FPos-1)+K$+MID$(Wkg$,FPos+1+InsertStatus)
END IF
' the long line plugs K$ in -- the hard way!
IF K$ <> "" THEN INCR FPos
ELSE ' else, the line is full and Auto is off
PLAY "O0 A64" ' so we ignore the keystroke & just Beep
END IF
END SELECT
LOOP
' ***************** END OF MAIN LOOP
LOCATE ,,1,CursorTop,CursorBottom
AdvanceCursor = 0
EXIT SUB
ELeftArrow:
IF FPos > 1 THEN
' Wkg$ = RTRIM$(Wkg$)
FPos = FPos - 1
ELSE
IF BackOut THEN
Opt$ = "Left"
Done = %True
END IF
END IF
RETURN
ERightArrow:
IF FPos =< FLength THEN
INCR FPos
ELSEIF Auto THEN
Opt$ = "Auto"
Done = %True ' if Auto is on then exit
END IF
RETURN
EInsKey:
IF InsertStatus = %False THEN
InsertStatus = %True
ELSE
InsertStatus = %False
END IF
RETURN
EDelKey:
IF FPos = 1 THEN Wkg$ = MID$(Wkg$,2): RETURN
IF FPos = LEN(Wkg$) THEN
Wkg$ = LEFT$ (Wkg$, FPos-1)
ELSEIF FPos < LEN(Wkg$) THEN
Wkg$ = LEFT$(Wkg$, FPos-1) + MID$(Wkg$, FPos+1)
END IF
' (if FPos > LEN don't do nothin')
RETURN
EHomeKey:
FPos = 1
RETURN
EEndKey:
FPos = LEN(Wkg$)+1
RETURN
ECtrlLeftKey:
IF FPos > 1 THEN DECR FPos
DO UNTIL FPos = 1
DECR FPos
LOOP UNTIL MID$ (Wkg$,FPos,1) = " "
IF FPos > 1 THEN INCR FPos
RETURN
ECtrlRightKey:
DO
INCR FPos
LOOP UNTIL MID$ (Wkg$,FPos,1) = " " OR FPos > LEN (Wkg$)
INCR FPos
FPos = MIN (FPos, LEN(Wkg$)+1)
RETURN
EUpArrow:
IF UpOut THEN
'''''' IF LTRIM$ (Wkg$) <> "" THEN Wkg$ = Starting$
Opt$ = "Up"
END IF
RETURN
EDownArrow:
Opt$ = "Down"
Done = %True
RETURN
EF1Key:
IF INSTR (Opt$, "F1") THEN
Opt$ = "HELP!"
Done = %True
END IF
RETURN
EF2Key:
IF INSTR (Opt$, "F2") THEN
Opt$ = "F2"
Done = %True
END IF
RETURN
END SUB REM: ENTERSTRING
' -------------------------------------------------------------------
SUB ENTERNUMBER (Wkg#, Masq$, Opt$) PUBLIC ' note: Shell for
' ENTERSTRING
' ======= This the routine to enter a number onscreen. It
' makes the value into a string if <> 0 and calculates
' the field length based on Masq$. Opt$ is simply
' passed without much alteration to ENTERSTRING.
LOCAL Wkg$, FLength, DecPlaces
IF VERIFY (Masq$, "#.-$!") THEN
COLOR %Wht, %Blk
BEEP: PRINT "ENTERNUMBER: MASK STRING ERROR": EXIT SUB
END IF
IF INSTR (Masq$, ".") THEN
DecPlaces = TALLY (MID$ (Masq$, INSTR (Masq$, ".")), "#")
ELSE
DecPlaces = 0
END IF
Wkg# = ROUNDOFF# (Wkg#, DecPlaces)
Ln = CSRLIN: Col = POS
FLength = LEN (Masq$)
Opt$ = "Num" + Opt$
IF Wkg# = 0 THEN
Wkg$ = ""
ELSE
Wkg$ = LTRIM$ (STR$(Wkg#))' set working $.
END IF
IF INSTR (Wkg$,".") THEN ' strip trailing zeroes ...
Wkg$ = LEFT$(Wkg$,INSTR(Wkg$,".")+4)
Wkg$ = RTRIM$ (Wkg$, "0")
Wkg$ = RTRIM$ (Wkg$, ".")
END IF
' -----------------------------------
CALL ENTERSTRING(Wkg$,FLength,Opt$)
' -----------------------------------
Wkg# = VAL(Wkg$) ' reset Wkg# ...
Wkg# = ROUNDOFF# (Wkg#, DecPlaces)
LOCATE Ln, Col: PRINT USING Masq$;Wkg# ' print it
' ...
END SUB REM ENTERNUMBER
' -------------------------------------------------------------------
SUB ENTERDATE (A$, Opt$) PUBLIC
LOCAL L,C
IF INSTR (Opt$, "N/A") THEN OKToReturnNA = %True
' set up to use the formatted entry
EnterDate1: ' routine ENTERBUNCHES with 3 blank
L = CSRLIN: C = POS ' fields to fill and 2 hyphens
DATA 2,"-",2,"-",2,"END"
RESTORE EnterDate1
Opt$ = Opt$ + "Num"
CALL ENTERBUNCHES(A$, Opt$)
' now check the result for being a
' valid date (FnFigDate& returns > 0)
IF (Opt$ = "CR" OR Opt$ = "Auto") AND FigDate& (A$) = 0 THEN
IF OKToReturnNA THEN
A$ = " N/A "
ELSE
A$ = "": LOCATE L,C: GOTO EnterDate1
END IF
END IF
LOCATE L, C: PRINT A$
END SUB
' -------------------------------------------------------------------
SUB RotaDate (D$,Opt$) PUBLIC
LOCAL L, C, K$, I$(), UseF1, UseF2
DIM I$ (3)
L = CSRLIN: C = POS
IF INSTR (Opt$, "F1") THEN UseF1 = -1
IF INSTR (Opt$, "F2") THEN UseF2 = -1
COLOR BoxColor MOD 16, BoxColor \ 16
I$(1) = "To enter date shown press [CR]."
I$(2) = " Use ["+CHR$(27)+"] or ["+CHR$(26)+"] to change."
I$(3) = "You can also do a normal keyboard entry"
CALL SCREENPUSH
IF L < 19 THEN BoxTopLine = 25 ELSE BoxTopLine = 5
CALL BOXMESSAGE2 (BoxTopLine, %Center, 0, I$(), 3, 47)
LOCATE L+1,C+2 ' print double arrow
PRINT CHR$(17);CHR$(205);CHR$(205);CHR$(16)
COLOR FldColor MOD 16, FldColor \ 16
DO
LOCATE L,C: PRINT D$;
DO:LOOP UNTIL INSTAT
K$ = INKEY$
IF LEN(K$) < 2 THEN
IF K$ = CHR$(13) THEN
Opt$ = "CR"
CALL SCREENPOP
LOCATE L,C: PRINT D$;
EXIT SUB
END IF
IF K$ = CHR$(27) THEN
Opt$ = "ESC"
CALL SCREENPOP
EXIT SUB
END IF
IF INSTR ("0123456789", K$) THEN ' UPDATED 11-90
LOCATE L, C ' ==========
D$ = K$ + " - -" + RIGHT$ (GetDate$, 2) ' If you press a number
CALL SCREENPOP ' key when Rotadate comes
AdvanceCursor = 1
CALL ENTERDATE (D$, Opt$) ' up, it automatically
EXIT SUB ' switches to regular
END IF ' keybd entry mode!
ELSE ' Thanks for the idea, Al!
K$ = RIGHT$(K$,1)
SELECT CASE ASC(K$)
CASE &H4B ' left -- back date 1 day
D$ = WriteDate$(FigDate&(D$) - 1)
CASE &H4D ' right -- advance date 1 day
D$ = WriteDate$(FigDate&(D$) + 1)
CASE &H48 ' up
Opt$ = "Up"
CALL SCREENPOP
LOCATE L,C: PRINT D$
EXIT SUB
CASE &H50 ' down
Opt$ = "Down"
CALL SCREENPOP
LOCATE L,C: PRINT D$
EXIT SUB
CASE &H3B '
IF UseF1 THEN Opt$ = "HELP!": CALL SCREENPOP : EXIT SUB
CASE &H3C '
IF UseF2 THEN
Opt$ = "F2"
CALL SCREENPOP
LOCATE L,C: PRINT D$
EXIT SUB
END IF
END SELECT
END IF
LOOP
END SUB
' -------------------------------------------------------------------
SUB ENTERTIME (A$, Opt$) PUBLIC
LOCAL L, C, Hours, H$, AmPm$
EnterTime1:
DATA 2,":",2,"END"
RESTORE EnterTime1
Opt$ = Opt$ + "Num"
L = CSRLIN: C = POS
CALL ENTERBUNCHES(A$, Opt$)
IF A$ <> "" THEN
IF VAL (LEFT$(A$,2)) > 24 OR VAL (RIGHT$(A$,2)) > 59 THEN
A$ = ""
LOCATE L,C
GOTO EnterTime1
END IF
IF RIGHT$ (A$,2) = " " AND LEFT$ (A$,2) <> " " THEN
Hours = VAL(LEFT$ (A$,2))
IF Hours > 10 THEN
H$ = LEFT$(A$,2)
ELSE
H$ = LEFT$ (STR$(Hours),2)
END IF
A$ = H$ + ":00"
LOCATE L,C: PRINT A$
END IF
AMorPM:
IF LEFT$(A$,2) <> " " AND VAL (LEFT$(A$,2)) < 13 THEN
' dialog box to select a.m. or p.m.
CALL SCREENPUSH
' Code to write Static Window {AM_PM} to Screen
' note: created by StatWindow Writer (PWW) from AM_PM.PW
COLOR BoxColor MOD 16, BoxColor \ 16
LOCATE 9, 24
PRINT "┌──────────────────────────────────────┐"
LOCATE 10, 24
PRINT "│ A - for A.M. │";
LOCATE 11, 24
PRINT "│ P - for P.M. │";
LOCATE 12, 24
PRINT "│ [ESC] to Quit │";
LOCATE 13, 24
PRINT "│ Time entered: │";
LOCATE 14, 24
PRINT "└──────────────────────────────────────┘";
COLOR FldColor MOD 16, FldColor \ 16
LOCATE 13, 53
PRINT USING "\ \";A$;
COLOR ScrColor MOD 16, ScrColor \ 16
' 08-22-1990, 18:40: end of StatWindow generated code for window {AM_PM}
DO
AmPm$ = UCASE$ (INKEY$)
LOOP UNTIL AmPm$ = "A" OR AmPm$ = "P"
CALL SCREENPOP
A$ = A$ + " " + MID$ ("a.m.p.m.", 5 + 4*(AmPm$="A"), 4)
LOCATE L,C: PRINT A$
END IF
END IF
END SUB
' -------------------------------------------------------------------
SUB ENTERSSN (A$, Opt$) PUBLIC
EnterSSN1:
DATA 3," ",2," ",4,"END"
RESTORE EnterSSN1
Opt$ = Opt$ + "Num"
CALL ENTERBUNCHES(A$, Opt$)
END SUB
' -------------------------------------------------------------------
SUB ENTERPHONE (A$, Opt$) PUBLIC
LOCAL L,C
EnterPhone1:
DATA "(",3,") ",3,"-",4," ext. ",5
DATA END
EShortPhone:
DATA "(",3,") ",3,"-",4
DATA END
LOCAL WithExtension
IF INSTR(Opt$,"NoExt") THEN
RESTORE EShortPhone
ELSE
RESTORE EnterPhone1
WithExtension = %True
END IF
A$ = LTRIM$ (RTRIM$ (A$))
IF A$ = "" THEN A$ = "("+LocalAreaCode$+")"
Opt$ = Opt$ + "Num"
CALL ENTERBUNCHES(A$, Opt$)
A$ = LTRIM$ (RTRIM$ (A$))
IF WithExtension THEN
IF RIGHT$ (A$,4) = "ext." THEN A$ = LEFT$ (A$,19) ' if no ext # then trim
PRINT USING "\"+SPACE$(23)+"\"; A$ ' off the word "ext."
ELSE
PRINT USING "\"+SPACE$(14)+"\"; A$
END IF
END SUB '
SUB FASTPHONE (PN$, Opt$) PUBLIC
LOCAL I$(), L, C, PN0$
DIM I$ (2)
L = CSRLIN: C = POS
LOCATE 25,1: COLOR ScrColor MOD 16, ScrColor \ 16
I$(1) = "PHONE # ENTRY: Type in the digits only. No hyphens etc. Include the area code"
I$(2) = "if needed (eg: 5551234 or 7075553456). The computer will add the punctuation."
CALL SCREENPUSH
CALL BOXMESSAGE2 (22, 1, 0, I$(), 2, 78)
PN0$ = PN$
DO
Opt$ = "NumUpOut"
LOCATE L, C: COLOR FldColor MOD 16, FldColor \ 16
CALL ENTERSTRING (PN$, 14, Opt$)
IF Opt$ = "CR" OR Opt$ = "Up" THEN
PN$ = REMOVE$ (PN$, ANY " /,.-_")
IF LEFT$ (PN$, 1) = "1" THEN PN$ = MID$ (PN$, 2)
IF VERIFY (PN$, "0123456789") THEN PN$ = ""
SELECT CASE LEN (PN$)
CASE 7
PN$ = LEFT$ (PN$, 3) + "-" + RIGHT$ (PN$, 4)
CASE 10
PN$ = "1-"+ LEFT$(PN$, 3) +"-" +MID$(PN$, 4, 3) +"-"+ RIGHT$ (PN$, 4)
CASE ELSE
PN$ = ""
END SELECT
END IF
IF Opt$ <> "CR" AND Opt$ <> "Up" THEN PN$ = PN0$
LOOP UNTIL PN$ <> ""
CALL SCREENPOP
LOCATE L, C: COLOR FldColor MOD 16, FldColor \ 16
PRINT USING "\ \"; PN$
END SUB
' -------------------------------------------------------------------
SUB ENTERBUNCHES (A$, Opt$)
LOCAL L, C, FLength, Sep$(), Size(), Bunch%, B$, B%, FPos, Opt0$
DIM Sep$ (20): DIM Size (20)
Bunch% = 1
L = CSRLIN: C = POS
READ B$
DO UNTIL B$ = "END"
IF INSTR("123456789",B$) THEN
Size(Bunch%) = VAL (B$)
INCR FLength, (LEN(Sep$(Bunch%))+Size(Bunch%))
INCR Bunch% ' get sizes of bunches and separator chrs
ELSE
Sep$(Bunch%) = B$
END IF
READ B$
LOOP
A$ = A$ + SPACE$(FLength-LEN(A$))
B% = 1
FPos = 1 ' this is to move the cursor past a
IF Opt$ <> "Up" THEN
DO UNTIL FPos > LEN(A$)
' check each bunch in the string as it already exists. If it doesn't
' contain any blanks, jump to the next one ...
IF INSTR (MID$ (A$, LEN (Sep$(B%)) + FPos, Size (B%)), " ") = 0 THEN
INCR FPos, LEN(Sep$(B%)) + Size(B%)
INCR B% ' if it isn't, jump over it ...
ELSE
EXIT LOOP
END IF
LOOP
' if the ALL the bunches of characters were found to be already full,
' set cursor (FPos) back to the home position (1)
IF Fpos >= FLength THEN B% = 1: FPos = 1
END IF
' now the bunch to start with is B% // the starting $ is A$
TakeEntry:
LOCATE L,C: PRINT USING "\"+SPACE$(FLength-2)+"\"; A$
Opt0$ = Opt$
DO UNTIL Size(B%) = 0
LOCATE L, (C + FPos-1)
PRINT Sep$(B%);
Ln = CSRLIN: Col = POS
Opt$ = Opt0$+"Auto BackOut UpOut"
B$ = MID$ (A$, FPos+LEN(Sep$(B%)), Size(B%))
CALL ENTERSTRING (B$,Size(B%),Opt$)
MID$(A$,FPos) = Sep$(B%)+B$
SELECT CASE Opt$
CASE "Left"
IF B% > 1 THEN
DECR B%
DECR FPos, Size(B%)+LEN(Sep$(B%))
END IF
CASE "Up", "ESC", "F2", "HELP!", "Tab", "ShfTab", "CR", "Down"
EXIT LOOP
CASE "Auto"
INCR FPos, Size(B%)+LEN(Sep$(B%))
INCR B%
CASE ELSE
PRINT "ENTERBUNCHES: Error! Opt$ = "; Opt$; :CALL CloseFiles: STOP
END SELECT
LOOP
BunchDone:
LOCATE L,C
END SUB ' REM ENTERBUNCHES
SUB PressAKey PUBLIC
LOCAL Click
LOCATE 20, 58, 0: COLOR 0,7
PRINT "╔═════════════════╗" ' pcWrite is great for boxing now!
LOCATE 21, 58
PRINT "║ HIT ANY KEY ║" ' (always did do a zippy search/replace)
IF NeedDCon THEN
LOCATE 22, 58
PRINT "║ OR CLICK RODENT ║"
LOCATE 23, 58
PRINT "║ TO GO ON ║"
LOCATE 24, 58
PRINT "╚═════════════════╝";
ELSE
LOCATE 22, 58
PRINT "║ TO GO ON ║"
LOCATE 23, 58
PRINT "╚═════════════════╝";
END IF
IF SoundOn THEN PLAY PressAKeyBeep$
IF NeedDCon THEN
DO
CALL Mouse (%ReadRodent, Click, X, Y)
LOOP UNTIL ((INKEY$ <> "") OR Click)
ELSE
DO: LOOP UNTIL INKEY$ <> ""
END IF
LOCATE ,,1
END SUB
'____________________________________________________________________________
FUNCTION GETYESORNO PUBLIC
LOCAL X$
PRINT " (y/n) ";
DO WHILE X$ <> "Y" AND X$ <> "N"
IF NeedDCon THEN
DO
CALL Mouse (%ReadRodent, Click, X, Y)
LOOP UNTIL (INSTAT OR Click)
ELSE
Click = %False
DO: LOOP UNTIL INSTAT
END IF
X$ = INKEY$
X$ = UCASE$(X$)
IF X$ = CHR$(0)+CHR$(&H50) THEN X$ = "N" ' down arrow = "NO"
IF Click = %LeftButton THEN X$ = "Y"
IF Click = %RightButton THEN X$ = "N"
LOOP
PRINT X$;
GetYesOrNo = (X$ = "Y")
END FUNCTION
SUB ENTERYESNO (Yes) PUBLIC
LOCAL Choice$, L, C
COLOR FldColor MOD 16, FldColor \ 16
L = CSRLIN
C = POS
PRINT "Y"
LOCATE L, C
DO
DO:LOOP UNTIL INSTAT
Choice$ = INKEY$
SELECT CASE Choice$
CASE "y", "Y", CHR$(13)
PRINT "Y"
Yes = %True
EXIT LOOP
CASE "n", "N", CHR$(27)
PRINT "N"
Yes = %False
EXIT LOOP
CASE ELSE
PLAY OopsBeep$
END SELECT
LOOP
END SUB ' REM -- ENTERYESNO
FUNCTION ROUNDOFF# (N#, Places%)
SELECT CASE Places%
CASE 0
ROUNDOFF# = ROUND (N#, 0)
EXIT SELECT
CASE 1
ROUNDOFF# = ROUND (N#, 1)
EXIT SELECT
CASE 2
ROUNDOFF# = ROUND (N#, 2)
EXIT SELECT
CASE 3
ROUNDOFF# = ROUND (N#, 3)
EXIT SELECT
CASE 4
ROUNDOFF# = ROUND (N#, 4)
END SELECT
END FUNCTION