100 REM ********************************************************************** 110 REM 120 REM FILENAME ROUTDEMD.BAS 130 REM WRITTEN BY GARY PEEK 140 REM LAST UPDATE 10/26/93 150 REM 160 REM DESCRIPTION DEMONSTRATES THE FUNCTIONS OF THE SUBROUTINES 170 REM THAT DISPLAY AND EDIT. 180 REM ********************************************************************** 190 KEY OFF:FOR A=1 TO 10:KEY A,"":NEXT A 200 COLOR 7,0:CLS 210 REM ----- 500 FOR DBOX=1 TO 3 510 IF DBOX=3 THEN DT=1 ELSE DT=0 520 GOSUB 1000 530 FOR Z=1 TO 1000:NEXT Z 540 NEXT DBOX 550 LOCATE ,,1:COLOR 7,0:END 560 REM ------------------------------------------- 1000 BOX=DBOX:GOSUB 8000:REM display and select colors 1010 REM ----- 1020 BOX=DBOX:GOSUB 9000:REM outline screen 1030 REM ----- 1040 IF DBOX<>3 THEN 2000 1050 FOR ROW=2 TO 24 1060 LOCATE ROW,3 1070 PRINT STRING$(76,CHR$(249)); 1080 NEXT ROW 1090 REM ----- 2000 MSG$="display a message at row and column" 2010 ROW=3:COL=5:GOSUB 9500 2020 MSG$="message with box" 2030 ROW=6:COL=5:BOX=DBOX:GOSUB 9500 2040 MSG$="message with box and shadow" 2050 ROW=10:COL=5:BOX=DBOX:SHADOW=1:GOSUB 9500 2060 MSG$="message centered in row" 2070 ROW=6:COL=0:GOSUB 9500 2080 REM ----- 3000 TEMP$="field to edit" 3010 ROW=3:COL=60:LNG=15:GOSUB 10000 3020 MSG$="prompt and":TEMP$="field to edit" 3030 ROW=10:COL=50:LNG=15:ORTYPE=1:DISPTYPE=DT:GOSUB 11000 3040 MSG$="prompt and field":TEMP$="centered side by side" 3050 ROW=14:COL=50:LNG=25:BOX=DBOX:SHADOW=1:DISPTYPE=DT:GOSUB 11000 3060 MSG$="prompt and field":TEMP$="top and bottom" 3070 ROW=18:COL=50:LNG=15:ORTYPE=2:BOX=DBOX:SHADOW=1:DISPTYPE=DT:GOSUB 11000 3080 REM ----- 4000 MSG$="date:":ROW=18:COL=5:ORTYPE=1:BOX=DBOX 4005 TEMP$="01/01/90":MODE=0:FLDTYPE=1:DISPTYPE=DT:GOSUB 11000 4010 MSG$="time:":ROW=18:COL=63:ORTYPE=1:BOX=DBOX 4015 TEMP$="12:59:59":MODE=0:FLDTYPE=2:DISPTYPE=DT:GOSUB 11000 4020 MSG$="enter dollar amount" 4030 ROW=24:LNG=8:FLDTYPE=3:DISPTYPE=DT:GOSUB 11000 4100 RETURN 7830 REM ********************************************************************* 7835 REM ------------------- DISPLAY AND SELECT COLORS ----------------------- 7840 REM 7845 REM This routine will let you select 4 sets of colors to be used in some 7850 REM of the other routines for text, data, field, and shadow areas. If 7855 REM these color variables are not specified with this routine or are 7860 REM not specified elsewhere, the routines that use color will default 7865 REM to WHITE on BLACK for text, HIGH-INTENSITY WHITE on BLACK for data, 7870 REM BLACK on WHITE for fields, and GREY on BLACK for shadows. This will 7875 REM insure that the screen will display something that can be seen. 7880 REM 7885 REM TEXTFORE and TEXTBACK are text foreground and background colors 7890 REM These are the normal display colors 7895 REM DATAFORE and DATABACK are data foreground and background colors 7900 REM These are for data or other special things to highlight 7905 REM FIELDFORE and FIELDBACK are field foreground and background colors 7910 REM These are for fields used in editing or selecting data 7915 REM SHADOWFORE and SHADOWBACK are shadow foreground and background colors 7920 REM These are for the optional box and shadow colors 7925 REM 7930 REM enter with - 7935 REM TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 7940 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK - 7945 REM colors optionally specified for COLOR statements 7950 REM optional- 7955 REM BOX=0,1,2,3 - type of outline around screen and example menu/box 7960 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 7965 REM (BOX should be set the same as the other routines that use BOX 7970 REM in order to best see what the colors will look like.) 7975 REM exit with - 7980 REM TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 7985 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK - 7990 REM BOX=0 (to maintain BOX as optional) 7995 REM 8000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 8000 8005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 8010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 8015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 8020 DIM COLOUR$(15):RESTORE 8585:REM POINT TO COLOR STRINGS 8025 FOR A%=0 TO 15:READ A$:COLOUR$(A%)=A$:NEXT A% 8030 COLORSET=0:DIM COLOURSET(30,8):RESTORE 8600:REM POINT TO COLOR SETS 8035 FOR A%=0 TO 24:FOR B%=1 TO 8:READ C%:COLOURSET(A%,B%)=C%:NEXT B%:NEXT A% 8040 REM ----- 8045 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 8050 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 8055 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0:DN=0:RT=0 8060 IF BOX=1 THEN TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 8065 IF BOX=2 THEN TP=205:BT=205:LS=204:RS=185:MS=186:MM=205:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 8070 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 8075 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 8080 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 8085 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 8090 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 8095 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 8100 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 8105 REM ----- 8110 MSG$=" CHANGE DISPLAY COLORS " 8115 ROW=4:COL=41-INT((LEN(MSG$)/2)):LOCATE ROW,COL:PRINT MSG$; 8120 LOCATE 22,3 8125 PRINT "F1=Text Color, F2=Text Background, F3=Highlite Color, F4=Highlite Background"; 8130 LOCATE 23,3 8135 PRINT " F5=Field Color, F6=Field Background, F7=Shadow Color, F8=Shadow Background "; 8140 LOCATE 24,3 8145 PRINT " F9=Preset Color Combinations, F10=Exit "; 8150 REM ----- 8155 MAXITEM=4:MAXLEN=20 8160 ROW=11-INT((MAXITEM/2)) 8165 COL=39-INT((MAXLEN/2)) 8170 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK 8175 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR); 8180 LOCATE ROW+1,COL:PRINT CHR$(MS)+" "; 8185 COLOR DATAFORE,DATABACK:PRINT "HIGHLITE/DATA colors"; 8190 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 8195 LOCATE ROW+2,COL:COLOR TEXTFORE,TEXTBACK 8200 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS); 8205 LOCATE ROW+3,COL 8210 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8215 LOCATE ROW+4,COL 8220 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8225 LOCATE ROW+5,COL 8230 PRINT CHR$(MS)+" NORMAL TEXT colors "+CHR$(MS); 8235 LOCATE ROW+6,COL:PRINT CHR$(MS)+" "; 8240 COLOR FIELDFORE,FIELDBACK:PRINT "FIELD/EDITING colors"; 8245 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 8250 LOCATE ROW+7,COL 8255 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR); 8260 IF BOX=0 THEN 8350 8265 COLOR SHADOWFORE,SHADOWBACK 8270 LOCATE ROW+9,COL+8:PRINT " SHADOW colors ";: 8275 IF BOX=1 OR BOX=2 THEN 8310 8280 LOCATE ROW+8,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP)); 8285 FOR DROW%=ROW+7 TO ROW+1 STEP -1 8290 LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS); 8295 NEXT DROW% 8300 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT); 8305 GOTO 8350 8310 LOCATE ROW+7,COL+2:PRINT CHR$(DN);:LOCATE ROW+8,COL+2:PRINT CHR$(LL); 8315 LOCATE ROW+8,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT)); 8320 LOCATE ROW+8,COL+MAXLEN+5:PRINT CHR$(LR); 8325 FOR DROW%=ROW+6 TO ROW+1 STEP -1 8330 LOCATE DROW%+1,COL+MAXLEN+5:PRINT CHR$(MS); 8335 NEXT DROW% 8340 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 8345 REM ----- 8350 IN$=INKEY$:IF IN$="" THEN 8350 8355 IF IN$=CHR$(0)+CHR$(59) THEN 8460 8360 IF IN$=CHR$(0)+CHR$(60) THEN 8475 8365 IF IN$=CHR$(0)+CHR$(61) THEN 8490 8370 IF IN$=CHR$(0)+CHR$(62) THEN 8505 8375 IF IN$=CHR$(0)+CHR$(63) THEN 8520 8380 IF IN$=CHR$(0)+CHR$(64) THEN 8535 8385 IF IN$=CHR$(0)+CHR$(65) THEN 8550 8390 IF IN$=CHR$(0)+CHR$(66) THEN 8565 8395 IF IN$=CHR$(0)+CHR$(67) THEN 8425 8400 IF IN$=CHR$(0)+CHR$(68) OR IN$=CHR$(13) THEN 8410 8405 BEEP:GOTO 8350 8410 COLOR TEXTFORE,TEXTBACK:BOX=0 8415 ERASE COLOUR$:ERASE COLOURSET:RETURN 8420 REM ----- 8425 CSET=CSET+1:IF CSET>24 THEN CSET=0 8430 TEXTFORE=COLOURSET(CSET,1):TEXTBACK=COLOURSET(CSET,2) 8435 DATAFORE=COLOURSET(CSET,3):DATABACK=COLOURSET(CSET,4) 8440 FIELDFORE=COLOURSET(CSET,5):FIELDBACK=COLOURSET(CSET,6) 8445 SHADOWFORE=COLOURSET(CSET,7):SHADOWBACK=COLOURSET(CSET,8) 8450 IF BOX=1 OR BOX=2 THEN SHADOWFORE=TEXTFORE:SHADOWBACK=TEXTBACK 8455 GOTO 8050 8460 TEXTFORE=TEXTFORE+1:IF TEXTFORE>15 THEN TEXTFORE=0 8465 IF TEXTFORE=TEXTBACK THEN 8460 8470 GOTO 8050 8475 TEXTBACK=TEXTBACK+1:IF TEXTBACK>7 THEN TEXTBACK=0 8480 IF TEXTFORE=TEXTBACK THEN 8475 8485 GOTO 8050 8490 DATAFORE=DATAFORE+1:IF DATAFORE>15 THEN DATAFORE=0 8495 IF DATAFORE=DATABACK THEN 8490 8500 GOTO 8155 8505 DATABACK=DATABACK+1:IF DATABACK>7 THEN DATABACK=0 8510 IF DATAFORE=DATABACK THEN 8505 8515 GOTO 8155 8520 FIELDFORE=FIELDFORE+1:IF FIELDFORE>15 THEN FIELDFORE=0 8525 IF FIELDFORE=FIELDBACK THEN 8520 8530 GOTO 8155 8535 FIELDBACK=FIELDBACK+1:IF FIELDBACK>7 THEN FIELDBACK=0 8540 IF FIELDFORE=FIELDBACK THEN 8535 8545 GOTO 8155 8550 SHADOWFORE=SHADOWFORE+1:IF SHADOWFORE>15 THEN SHADOWFORE=0 8555 IF SHADOWFORE=SHADOWBACK THEN 8550 8560 GOTO 8155 8565 SHADOWBACK=SHADOWBACK+1:IF SHADOWBACK>7 THEN SHADOWBACK=0 8570 IF SHADOWFORE=SHADOWBACK THEN 8565 8575 GOTO 8155 8580 REM ------ 8585 DATA "BLACK","BLUE","GREEN","CYAN","RED","MAGENTA","BROWN","WHITE" 8590 DATA "GREY","LIGHT BLUE","LIGHT GREEN","LIGHT CYAN","LIGHT RED" 8595 DATA "LIGHT MAGENTA","YELLOW","HIGH-INTENSITY WHITE" 8600 DATA 7,0,15,0,0,7,8,0 8605 DATA 7,1,15,1,15,4,0,1 8610 DATA 10,1,11,1,15,2,0,1 8615 DATA 11,1,14,1,15,4,0,1 8620 DATA 12,1,11,1,15,0,0,1 8625 DATA 15,1,12,1,15,5,5,1 8630 DATA 0,3,15,3,15,0,8,3 8635 DATA 1,3,15,3,15,0,0,3 8640 DATA 1,3,15,4,15,1,0,3 8645 DATA 10,3,14,5,14,5,5,3 8650 DATA 14,3,1,3,14,0,0,3 8655 DATA 15,3,0,3,14,0,0,3 8660 DATA 0,4,14,4,15,4,14,4 8665 DATA 15,4,14,4,14,0,14,4 8670 DATA 15,5,15,0,11,1,1,5 8675 DATA 15,5,15,1,14,0,13,5 8680 DATA 0,2,11,2,15,4,4,2 8685 DATA 0,2,11,2,15,0,15,2 8690 DATA 0,6,14,6,15,0,14,6 8695 DATA 7,0,8,0,0,3,8,0 8700 DATA 8,0,12,0,7,4,4,0 8705 DATA 10,0,11,0,1,3,2,0 8710 DATA 11,0,12,0,1,3,1,0 8715 DATA 14,0,14,6,15,6,6,0 8720 DATA 14,0,5,0,1,3,5,0 8725 REM 8935 REM ********************************************************************* 8940 REM --------------------- OUTLINE THE SCREEN ---------------------------- 8945 REM 8950 REM This subroutines allows you to outline the screen with your 8955 REM choice of 4 types of boxes. Boxes 1, 2, and 3 are the same 8960 REM types of boxes used in other subroutines. 8965 REM 8970 REM enter with - BOX = 0,1,2,3 - type of box to outline the screen with 8975 REM 0=squares, 1=1 line box, 2=2 line box, 3=solid box 8980 REM optional - TEXTFORE,TEXTBACK 8985 REM colors optionally specified for COLOR statements 8990 REM exit with - BOX=0 (to maintain BOX as optional for other routines) 8995 REM 9000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9000 9005 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 9010 LOCATE ,,0:COLOR TEXTFORE,TEXTBACK:CLS 9015 IF BOX=0 THEN TP=254:BT=254:MS=254:UL=254:LL=254:UR=254:LR=254 9020 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217 9025 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188 9030 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9035 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 9040 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 9045 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 9050 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW% 9055 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 9060 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 9065 BOX=0:RETURN 9070 REM 9075 REM 9145 REM ********************************************************************* 9150 REM ------------------------- ERASE LINE -------------------------------- 9155 REM 9160 REM This subroutine will erase the line of your choice from col. 2 to 79 9165 REM 9170 REM 9175 REM enter with - ROW=line to erase 9180 REM optional - TEXTFORE,TEXTBACK 9185 REM colors optionally specified for COLOR statements 9190 REM 9195 REM 9200 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9200 9205 COLOR TEXTFORE,TEXTBACK 9210 LOCATE ROW,2,0:PRINT SPACE$(78); 9215 RETURN 9220 REM 9405 REM ********************************************************************* 9410 REM ------------------------- DISPLAY MESSAGE --------------------------- 9415 REM 9420 REM This subroutine allows you to display a message at a specified 9425 REM row and column or at the center of a specified row, and optionally 9430 REM draw a box with a shadow around it. 9435 REM 9440 REM enter with - MSG$="message", to display 9445 REM ROW and COL=row and column on which to display "message" 9450 REM (if COL=0 then message is centered) 9455 REM optional- BOX=0,1,2,3 - type of box to draw around MSG$ 9460 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9465 REM optional- SHADOW=0,1 - type of shadow to include with box 9470 REM 0 = no shadow, 1 = shadow 9475 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK, 9480 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 9485 REM colors optionally specified for COLOR statements 9490 REM exit with - BOX=0, SHADOW=0 (to maintain them as optional for later) 9495 REM 9500 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 9500 9505 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 9510 IF COL=0 THEN COL=41-INT((LEN(MSG$)/2)) :REM 9300 9515 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL,0:PRINT MSG$;:L=LEN(MSG$) 9520 IF BOX=0 THEN 9630 9525 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LEN(MSG$):PRINT " "; 9530 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 9535 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 9540 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 9545 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 9550 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+L+1:PRINT CHR$(UR); 9555 LOCATE ROW,COL+L+1:PRINT CHR$(MS);:LOCATE ROW+1,COL+L+1:PRINT CHR$(LR); 9560 LOCATE ROW-1,COL-1:PRINT STRING$(L+2,CHR$(TP)); 9565 LOCATE ROW+1,COL-1:PRINT STRING$(L+2,CHR$(BT)); 9570 IF SHADOW=0 THEN 9630 9575 COLOR SHADOWFORE,SHADOWBACK 9580 IF BOX<>1 AND BOX<>2 THEN 9615 9585 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 9590 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 9595 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 9600 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 9605 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+L+2:PRINT " "; 9610 GOTO 9630 9615 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 9620 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 9625 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 9630 BOX=0:SHADOW=0:COLOR TEXTFORE,TEXTBACK 9635 RETURN 9640 REM 9820 REM ********************************************************************* 9825 REM ---------------- EDIT A FIELD AT ROW AND COLUMN --------------------- 9830 REM 9835 REM This subroutine allows you to edit or enter a string. The editing 9840 REM keys perform the same functions as BASIC in the screen editing mode. 9845 REM 9850 REM enter with - ROW and COL=row and column at which to edit the string 9855 REM LNG=maximum length of string allowed (up to 74) 9860 REM (if LNG=0 then this routine just waits for any key hit) 9865 REM TEMP$="string" to edit 9870 REM optional - EDCOL=0, place cursor at beginning of string 9875 REM 1, place cursor at end of string 9880 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 9885 REM 0 = only ENTER or ESCAPE 9890 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT ARROWS 9895 REM 2 = include F1-F10 9900 REM optional - INPTYPE=0,1,2,3 - type of input desired 9905 REM 0 = normal ALPHANUMERIC 9910 REM 1 = ALPHANUMERIC with lower case changed to upper case 9915 REM 2 = NUMERIC only allowed 9920 REM 3 = Y or N only (or y or n changed to upper case) 9925 REM optional - BOX=0,1,2,3 - type of box to draw around TEMP$ 9930 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 9935 REM optional- SHADOW=0,1 - type of shadow to include with box 9940 REM 0 = no shadow, 1 = shadow 9945 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 9950 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 9955 REM colors optionally specified for color statements 9960 REM exit with - TEMP$="string" edited or entered 9965 REM BOX=0,INPTYPE=0,EDKEYS=0,EDCOL=0 (to maintain as optional) 9970 REM EXIT$=key hit that exited routine- 9975 REM (EXIT$="ENTER" if field was completely filled) 9980 REM "LEFT" if LEFT ARROW when at left side of field 9985 REM "RIGHT" if RIGHT ARROW when at right side of field 9990 REM "UP","DOWN","PGUP","PGDN","F1"-"F10","ENTER","ESC" 9995 REM 10000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 10000 10005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 10010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 10015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 10020 IF LNG=0 THEN LOCATE ,,0:GOTO 10215:REM WAIT FOR KEY ONLY 10025 LOCATE ,,0:INS=0:EXIT$="":TEMP$=LEFT$(TEMP$,LNG) 10030 IF EDCOL=0 THEN EDCOL=COL:GOTO 10040 10035 IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1 ELSE EDCOL=COL+LEN(TEMP$) 10040 IF BOX=0 THEN 10170 10045 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 10050 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 10055 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 10060 COLOR TEXTFORE,TEXTBACK 10065 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 10070 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR); 10075 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS); 10080 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR); 10085 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP)); 10090 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT)); 10095 IF SHADOW=0 THEN 10165 10100 COLOR SHADOWFORE,SHADOWBACK 10105 IF BOX<>1 AND BOX<>2 THEN 10145 10110 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 10115 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT)); 10120 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR); 10125 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS); 10130 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 10135 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " "; 10140 GOTO 10165 10145 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP)); 10150 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS); 10155 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS); 10160 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT); 10165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " "; 10170 BOX=0:SHADOW=0 10175 LOCATE ROW,COL,0:COLOR FIELDFORE,FIELDBACK:PRINT TEMP$; 10180 LOCATE ROW,COL+LEN(TEMP$):PRINT SPACE$(LNG-LEN(TEMP$)); 10185 L=LEN(TEMP$) 10190 AAAA$=MID$(TEMP$,EDCOL-COL+1,1) :REM -------------- 10195 IF INS THEN LOCATE ROW,EDCOL:COLOR DATAFORE,DATABACK :REM editing | 10200 IF INS THEN PRINT AAAA$;:COLOR FIELDFORE,FIELDBACK :REM keys | 10205 LOCATE ROW,EDCOL :REM available | 10210 LOCATE,,1 :REM | 10215 IN$=INKEY$:IF IN$="" THEN 10215 :REM WAIT FOR KEY | 10220 IF LNG=0 THEN 10745 :REM ------------ | 10225 IF INPTYPE=3 THEN 10235 :REM | 10230 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 10710 :REM ENTER | 10235 IF IN$=CHR$(27) THEN EXIT$="ESC":GOTO 10710 :REM ESCAPE | 10240 IF IN$=CHR$(8) THEN 10520 :REM BACKSPACE | 10245 IF IN$=CHR$(0)+CHR$(71) THEN 10565 :REM HOME | 10250 IF IN$=CHR$(0)+CHR$(119) THEN 10575 :REM CONTROL HOME | 10255 IF IN$=CHR$(0)+CHR$(75) THEN 10585 :REM LEFT ARROW | 10260 IF IN$=CHR$(0)+CHR$(77) THEN 10605 :REM RIGHT ARROW | 10265 IF IN$=CHR$(0)+CHR$(79) THEN 10645 :REM END | 10270 IF IN$=CHR$(0)+CHR$(117) THEN 10665 :REM CONTROL END | 10275 IF IN$=CHR$(0)+CHR$(82) THEN 10675 :REM INSERT | 10280 IF IN$=CHR$(0)+CHR$(83) THEN 10685 :REM DELETE | 10285 IF EDKEYS=0 THEN 10375 :REM skip these - | 10290 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 10710 :REM UP ARROW | 10295 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 10710 :REM DOWN ARROW | 10300 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 10710 :REM PAGE UP | 10305 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 10710 :REM PAGE DOWN | 10310 REM :REM HOME | 10315 REM :REM END | 10320 IF EDKEYS=1 THEN 10375 :REM skip these - | 10325 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 10710 :REM F1 | 10330 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 10710 :REM F2 | 10335 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 10710 :REM F3 | 10340 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 10710 :REM F4 | 10345 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 10710 :REM F5 | 10350 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 10710 :REM F6 | 10355 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 10710 :REM F7 | 10360 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 10710 :REM F8 | 10365 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 10710 :REM F9 | 10370 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 10710 :REM F10 | 10375 IF INPTYPE=0 OR INPTYPE=1 OR INPTYPE=3 THEN 10395 :REM -------------- 10380 REM ----- allow only numbers or decimal point 10385 IF ASC(IN$)<46 OR ASC(IN$)>57 OR ASC(IN$)=47 THEN GOSUB 10760:GOTO 10210 10390 REM ----- allow only legitimate alphanumeric 10395 IF ASC(IN$)<32 OR ASC(IN$)>126 THEN GOSUB 10760:GOTO 10210 10400 REM ----- change to all upper case 10405 IF INPTYPE=0 OR INPTYPE=2 THEN 10435 10410 IF ASC(IN$)>=97 AND ASC(IN$)<=122 THEN IN$=CHR$(ASC(IN$)-32) 10415 REM ----- Yes or No only ----- 10420 IF INPTYPE<>3 THEN 10435 10425 IF IN$<>"Y" AND IN$<>"N" THEN GOSUB 10760:GOTO 10210 10430 REM ----- good character 10435 L=EDCOL-COL:IF INS THEN 10480 10440 REM ----- add char. if at end of string 10445 IF EDCOL=COL+LEN(TEMP$) THEN TEMP$=TEMP$+IN$:GOTO 10495 10450 REM ----- add char. in middle if not in insert mode 10455 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-1-L) 10460 REM ----- exit if overwriting last character 10465 IF EDCOL=COL+LNG-1 AND LEN(TEMP$)=LNG THEN EXIT$="ENTER":GOTO 10710 10470 GOTO 10495 10475 REM ----- in insert mode, check for full field 10480 IF LEN(TEMP$)=LNG THEN GOSUB 10760:GOTO 10175 :REM full field 10485 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-L) :REM not full 10490 REM ----- move cursor right if applicable 10495 IF EDCOLCOL THEN EDCOL=EDCOL-1:GOTO 10175 10590 IF EDKEYS=0 THEN GOSUB 10760:GOTO 10175 :REM error if left col 10595 EXIT$="LEFT":GOTO 10710 :REM or exit 10600 REM ----- RIGHT ARROW ----- 10605 INS=0:IF EDCOLCOL+LNG THEN EDCOL=COL+LNG:GOTO 10025 10660 REM ----- CONTROL END ----- 10665 INS=0:TEMP$=LEFT$(TEMP$,EDCOL-COL):GOTO 10175 10670 REM ----- INSERT ----- 10675 IF INS THEN INS=0:GOTO 10175 ELSE INS=-1:GOTO 10175 10680 REM ----- DELETE ----- 10685 INS=0:L=EDCOL-COL 10690 REM:IF EDCOL=COL+LNG-1 THEN GOSUB 10515:GOTO 10025:REM needed? 10695 IF EDCOL>=COL+LEN(TEMP$) THEN GOSUB 10760:GOTO 10175 10700 TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-L-1):GOTO 10175 10705 REM ----- COMMON EXIT ----- 10710 BLANK$=CHR$(255):REM remove blanks at end 10715 IF RIGHT$(TEMP$,1)=BLANK$ THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10715 10720 FOR A%=1 TO LEN(TEMP$):REM change blanks in middle to spaces 10725 IF MID$(TEMP$,A%,1)=CHR$(255) THEN MID$(TEMP$,A%,1)=" " 10730 NEXT A% 10735 LOCATE ROW,COL,0:COLOR TEXTFORE,TEXTBACK 10740 PRINT TEMP$+SPACE$(LNG-LEN(TEMP$)); 10745 BOX=0:INPTYPE=0:EDKEYS=0:EDCOL=0:RETURN 10750 REM 10755 REM ----- BEEP IF ERROR ----- 10760 BEEP:RETURN 10765 REM 10770 REM 10810 REM ********************************************************************* 10815 REM ------------- MESSAGE AND FIELD/DATE/TIME/DOLLAR AMOUNT ------------- 10820 REM 10825 REM This subroutine allows you to combine a message along with a field 10830 REM entry or edit, date or time entry, or dollar amount entry, while 10835 REM making adjustments for optional centering and boxes. 10840 REM 10845 REM enter with - MSG$="message" to display and, 10850 REM everything required or optionally required with the 10855 REM EDIT A FIELD AT ROW AND COLUMN routine, or 10860 REM ENTER DATE routine, or ENTER TIME routine, or 10865 REM ENTER DOLLAR AMOUNT routine 10870 REM (except COL when centering is selected.) 10875 REM optional- BOX=0,1,2,3 - type of box to draw around MSG$ 10880 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 10885 REM optional- SHADOW=0,1 - type of shadow to include with box 10890 REM 0 = no shadow, 1 = shadow 10895 REM optional - FLDTYPE = 0, 1, 2 or 3 - type of field/entry 10900 REM 0 = enter or edit field 10905 REM 1 = date 10910 REM 2 = time 10915 REM 3 = dollar amount 10920 REM optional - ORTYPE = 0, 1, 2 or 3 - type of message/field orientation 10925 REM 0 = side by side and centered in ROW (COL not required) 10930 REM 1 = side by side at ROW and COL 10935 REM 2 = field below message and centered in ROW (COL not required) 10940 REM 3 = field below message at ROW and COL 10945 REM (if a box is specified the field will be 2 rows below 10950 REM the message, otherwise it will be 1 row below) 10955 REM optional - DISPTYPE=0 or 1 - type of display desired 10960 REM 0 = normal message 10965 REM 1 = message with screen restored 10970 REM exit with - everything returned with 10975 REM FIELD, DATE, TIME, or DOLLAR AMOUNT routine, 10980 REM BOX=0, SHADOW=0, ORTYPE=0, FLDTYPE=0, DISPTYPE=0 10985 REM (to maintain as optional) 10990 REM 10995 REM :REM 11000 11000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 11005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 11010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 11015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 11020 REM 11025 IF FLDTYPE=1 OR FLDTYPE=2 THEN LNG=8 :REM DATE OR TIME 11030 IF ORTYPE=0 OR ORTYPE=1 THEN MAXLEN=LEN(MSG$)+1+LNG:GOTO 11040 :REM SxS 11035 IF LEN(MSG$)>LNG THEN MAXLEN=LEN(MSG$) ELSE MAXLEN=LNG :REM TxB 11040 IF ORTYPE=0 OR ORTYPE=2 THEN COL=41-(INT(MAXLEN/2)) :REM CENTERED 11045 REM 11050 IF BOX<>0 THEN 11075 11055 STARTCOL=COL-1:ENDCOL=COL+MAXLEN :REM BOX=0 11060 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW:ENDROW=ROW :REM SxS 11065 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW:ENDROW=ROW+1 :REM TxB 11070 GOTO 11100 11075 STARTCOL=COL-2:ENDCOL=COL+MAXLEN+2 :REM BOX<>0 11080 IF ORTYPE=0 OR ORTYPE=1 THEN STARTROW=ROW-1:ENDROW=ROW+1 :REM SxS 11085 IF ORTYPE=2 OR ORTYPE=3 THEN STARTROW=ROW-1:ENDROW=ROW+3 :REM TxB 11090 REM 11095 REM ----- SAVE SCREEN IF REQUIRED 11100 IF DISPTYPE<>1 THEN 11180 11105 SHADOFF=0 11110 IF SHADOW<>0 AND BOX=3 THEN SHADOFF=1 11115 IF SHADOW<>0 AND (BOX=1 OR BOX=2) THEN SHADOFF=2 11120 DIM MSGSSCHR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF) 11125 DIM MSGSSCOLOR(ENDROW-STARTROW+1+SHADOFF,ENDCOL-STARTCOL+1+SHADOFF,2) 11130 R=1:C=1 11135 FOR SR%=STARTROW TO ENDROW+SHADOFF 11140 FOR SC%=STARTCOL TO ENDCOL+SHADOFF 11145 MSGSSCHR(R,C)=SCREEN(SR%,SC%,0) 11150 A=SCREEN(SR%,SC%,1):MSGSSCOLOR(R,C,1)=(A AND 15) 11155 IF (A AND 128)=128 THEN MSGSSCOLOR(R,C,1)=MSGSSCOLOR(R,C,1)+16 11160 MSGSSCOLOR(R,C,2)=(A AND 112)/16 11165 C=C+1:NEXT SC% 11170 R=R+1:C=1:NEXT SR% 11175 REM ----- 11180 IF BOX=0 THEN 11360 11185 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:LF=195:RT=180 11190 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:LF=204:RT=185 11195 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219:DN=219:LF=219:RT=219 11200 COLOR TEXTFORE,TEXTBACK :REM BOX 11205 LOCATE ROW-1,COL-2:PRINT CHR$(UL)+STRING$(MAXLEN+2,CHR$(TP))+CHR$(UR); 11210 LOCATE ROW,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS); 11215 LOCATE ROW+1,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR); 11220 IF ORTYPE=0 OR ORTYPE=1 THEN 11245 11225 LOCATE ROW+1,COL-2:PRINT CHR$(LF); :REM LOWER BOX 11230 LOCATE ROW+1,COL+MAXLEN+1:PRINT CHR$(RT); 11235 LOCATE ROW+2,COL-2:PRINT CHR$(MS)+SPACE$(MAXLEN+2)+CHR$(MS); 11240 LOCATE ROW+3,COL-2:PRINT CHR$(LL)+STRING$(MAXLEN+2,CHR$(BT))+CHR$(LR); 11245 IF SHADOW=0 THEN 11360 11250 COLOR SHADOWFORE,SHADOWBACK :REM SHADOW 11255 IF ORTYPE=0 OR ORTYPE=1 THEN ROWOFF=0 ELSE ROWOFF=2 11260 IF BOX<>1 AND BOX<>2 THEN 11330 11265 LOCATE ROW+1+ROWOFF,COL:PRINT CHR$(DN); :REM BOX 1,2 SHADOW 11270 LOCATE ROW+2+ROWOFF,COL:PRINT CHR$(LL); 11275 LOCATE ROW+2+ROWOFF,COL+1:PRINT STRING$(MAXLEN+2,CHR$(BT)); 11280 LOCATE ROW+2+ROWOFF,COL+MAXLEN+3:PRINT CHR$(LR); 11285 FOR DROW=ROW+1 TO ROW+1+ROWOFF 11290 LOCATE DROW,COL+MAXLEN+3:PRINT CHR$(MS); 11295 NEXT DROW 11300 LOCATE ROW,COL+MAXLEN+1:PRINT CHR$(LF);CHR$(TP);CHR$(UR); 11305 COLOR TEXTFORE,TEXTBACK 11310 FOR DROW=ROW+1 TO ROW+1+ROWOFF 11315 LOCATE DROW,COL+MAXLEN+2:PRINT " "; 11320 NEXT DROW 11325 GOTO 11360 11330 LOCATE ROW+2+ROWOFF,COL-1:PRINT STRING$(MAXLEN+4,CHR$(TP));:REM BOX3SHAD 11335 FOR DROW=ROW+1+ROWOFF TO ROW STEP-1 11340 LOCATE DROW,COL+MAXLEN+2:PRINT CHR$(MS); 11345 NEXT DROW 11350 LOCATE ROW-1,COL+MAXLEN+2:PRINT CHR$(BT); 11355 REM ----- 11360 COLOR TEXTFORE,TEXTBACK :REM MESSAGE 11365 IF ORTYPE=2 OR ORTYPE=3 THEN 11385 11370 LOCATE ROW,COL-1:PRINT " "+MSG$+" "+SPACE$(LNG+1); :REM SxS 11375 COL=COL+1+LEN(MSG$):GOTO 11405 11380 REM 11385 LOCATE ROW,COL-1:PRINT " "+MSG$+" "; :REM TxB 11390 IF BOX=0 THEN ROW=ROW+1 ELSE ROW=ROW+2 11395 LOCATE ROW,COL-1:PRINT SPACE$(LNG+2) 11400 REM 11405 BOX=0:SHADOW=0 :REM FIELD 11410 IF FLDTYPE=0 THEN GOSUB 10000:REM edit field SUBROUTINE USED HERE 11415 IF FLDTYPE=1 THEN GOSUB 12000:REM enter date SUBROUTINE USED HERE 11420 IF FLDTYPE=2 THEN GOSUB 13000:REM enter time SUBROUTINE USED HERE 11425 IF FLDTYPE=3 THEN GOSUB 15000:REM enter $ amount SUBROUTINE USED HERE 11430 REM 11435 REM ----- RESTORE SCREEN IF REQUIRED 11440 IF DISPTYPE<>1 THEN 11490 11445 R=1:C=1 11450 FOR SR%=STARTROW TO ENDROW+SHADOFF 11455 FOR SC%=STARTCOL TO ENDCOL+SHADOFF 11460 COLOR MSGSSCOLOR(R,C,1),MSGSSCOLOR(R,C,2) 11465 LOCATE SR%,SC%:PRINT CHR$(MSGSSCHR(R,C)); 11470 C=C+1:NEXT SC% 11475 R=R+1:C=1:NEXT SR% 11480 ERASE MSGSSCHR:ERASE MSGSSCOLOR 11485 REM ----- 11490 BOX=0:SHADOW=0:ORTYPE=0:FLDTYPE=0:DISPTYPE=0 11495 RETURN 11860 REM ******************************************************************** 11865 REM ------------------------- ENTER DATE ------------------------------- 11870 REM 11875 REM This routine lets you to enter the date in the format DD/MM/YY or 11880 REM optionally set the DOS date. 11885 REM 11890 REM enter with - ROW and COL=row and column at which to begin the prompt 11895 REM (COL=35 for centered prompt) 11900 REM MODE=0,1,2 - type of entry 11905 REM 0 = TEMP$ is initial date and entered date 11910 REM 1 = start with current date, TEMP$ = entered date 11915 REM 2 = start with current date, TEMP$ = entered date 11920 REM and DOS date is set 11925 REM optional - TEMP$="MM/DD/YY" - initial date 11930 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 11935 REM 0 = only ENTER or ESCAPE 11940 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 11945 REM 2 = include F1-F10 11950 REM optional - BOX=0,1,2,3 - type of box to draw around prompt 11955 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 11960 REM optional- SHADOW=0,1 - type of shadow to include with box 11965 REM 0 = no shadow, 1 = shadow 11970 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 11975 REM FIELDFORE,FIELDBACK, SHADOWFORE, SHADOWBACK 11980 REM colors optionally specified for COLOR statements 11985 REM exit with - TEMP$="DD/MM/YY" (and DOS date set if MODE=2) 11990 REM BOX=0, SHADOW=0, EDKEYS=0, MODE=0 (to maintain as opt.) 11995 REM 12000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 12000 12005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 12010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 12015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 12020 IF BOX=0 THEN 12135 12025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 12030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 12035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 12040 COLOR TEXTFORE,TEXTBACK 12045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 12050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR); 12055 LOCATE ROW,COL+14:PRINT CHR$(MS); 12060 LOCATE ROW+1,COL+14:PRINT CHR$(LR); 12065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP)); 12070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT)); 12075 IF SHADOW=0 THEN 12135 12080 L=8:COLOR SHADOWFORE,SHADOWBACK 12085 IF BOX<>1 AND BOX<>2 THEN 12120 12090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 12095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 12100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 12105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 12110 LOCATE ROW+1,COL+L+2:PRINT " "; 12115 GOTO 12135 12120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 12125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 12130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 12135 BOX=0:SHADOW=0 12140 D1COL=COL:IF MODE=0 THEN D1$=LEFT$(TEMP$,2) ELSE D1$=LEFT$(DATE$,2) 12145 D2COL=COL+3:IF MODE=0 THEN D2$=MID$(TEMP$,4,2) ELSE D2$=MID$(DATE$,4,2) 12150 D3COL=COL+6:IF MODE=0 THEN D3$=MID$(TEMP$,7,2) ELSE D3$=MID$(DATE$,9,2) 12155 TEMPDATE$=D1$+"/"+D2$+"/"+D3$:TEMPCOL=COL:DEDKEYS=EDKEYS 12160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPDATE$; 12165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " "; 12170 REM ----- 12175 TEMP$=D1$:OLDD1$=D1$:COL=D1COL:LNG=2:INPTYPE=2:EDKEYS=2 12180 GOSUB 10000 :REM SUBROUTINE USED 12185 D1$=TEMP$ 12190 IF EXIT$="ESC" THEN 12485 12195 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12205 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12210 IF VAL(D1$)=0 OR VAL(D1$)>12 THEN GOSUB 12500:GOTO 12175 12215 IF EXIT$="ENTER" AND D1$=OLDD1$ THEN 12455 12220 IF EXIT$="ENTER" AND D1$<>OLDD1$ THEN 12240 12225 IF EXIT$="LEFT" AND DEDKEYS>0 THEN 12455 12230 IF EXIT$="RIGHT" THEN 12240 12235 GOSUB 12500:GOTO 12175 12240 IF RIGHT$(D1$,1)=" " THEN D1$=LEFT$(D1$,1) 12245 IF LEFT$(D1$,1)=" " THEN D1$=RIGHT$(D1$,1) 12250 IF LEN(D1$)<2 THEN D1$="0"+D1$ 12255 LOCATE ROW,D1COL:PRINT D1$; 12260 REM ----- 12265 TEMP$=D2$:OLDD2$=D2$:COL=D2COL:LNG=2:INPTYPE=2:EDKEYS=2 12270 GOSUB 10000 :REM SUBROUTINE USED 12275 D2$=TEMP$ 12280 IF EXIT$="ESC" THEN 12485 12285 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12295 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12300 IF VAL(D2$)=0 THEN GOSUB 12495:GOTO 12265 12305 IF D1$="04" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12310 IF D1$="06" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12315 IF D1$="09" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12320 IF D1$="11" AND VAL(D2$)>30 THEN GOSUB 12500:GOTO 12265 12325 IF EXIT$="RIGHT" THEN 12355 12330 IF VAL(D2$)>31 THEN GOSUB 12500:GOTO 12265 12335 IF EXIT$="ENTER" AND D2$=OLDD2$ THEN 12455 12340 IF EXIT$="ENTER" AND D2$<>OLDD2$ THEN 12355 12345 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12175 12350 GOSUB 12500:GOTO 12265 12355 IF RIGHT$(D2$,1)=" " THEN D2$=LEFT$(D2$,1) 12360 IF LEFT$(D2$,1)=" " THEN D2$=RIGHT$(D2$,1) 12365 IF LEN(D2$)<2 THEN D2$="0"+D2$ 12370 LOCATE ROW,D2COL:PRINT D2$; 12375 REM ----- 12380 TEMP$=D3$:COL=D3COL:LNG=2:INPTYPE=2:EDKEYS=2 12385 GOSUB 10000 :REM SUBROUTINE USED 12390 D3$=TEMP$ 12395 IF EXIT$="ESC" THEN 12485 12400 IF LEFT$(EXIT$,1)="F" AND DEDKEYS>1 THEN 12485 12405 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND DEDKEYS>0 THEN 12485 12410 IF (EXIT$="UP" OR EXIT$="DOWN") AND DEDKEYS>0 THEN 12485 12415 IF VAL(D3$)<80 OR VAL(D3$)>99 THEN GOSUB 12500:GOTO 12380 12420 IF D1$="02" AND D2$="29" AND VAL(D3$) MOD 4<>0 THEN GOSUB 12500:GOTO 12265 12425 IF EXIT$="ENTER" THEN 12455 12430 IF EXIT$="RIGHT" AND DEDKEYS>0 THEN 12445 12435 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 12265 12440 GOSUB 12500:GOTO 12380 12445 LOCATE ROW,D3COL:PRINT D3$; 12450 REM ----- 12455 IF MODE=2 THEN DATE$=D1$+"-"+D2$+"-"+"19"+D3$ 12460 REM ----- NORMAL EXIT 12465 TEMP$=D1$+"/"+D2$+"/"+D3$ 12470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 12475 PRINT TEMP$;:GOTO 12510 12480 REM ----- ESCAPE EXIT 12485 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 12490 PRINT TEMPDATE$;:GOTO 12510 12495 REM ----- BEEP IF ERROR ----- 12500 BEEP:RETURN 12505 REM ----- COMMON EXIT 12510 BOX=0:SHADOW=0:EDKEYS=0:MODE=0:RETURN 12515 REM 12860 REM ******************************************************************** 12865 REM ------------------------- ENTER TIME ------------------------------- 12870 REM 12875 REM This routine lets you enter the time in the format HH:MM:SS or 12880 REM optionally set the DOS time. 12885 REM 12890 REM enter with - ROW and COL=row and column at which to begin the prompt 12895 REM (COL=35 for centered prompt) 12900 REM MODE=0,1,2 - type of entry 12905 REM 0 = TEMP$ is initial time and entered time 12910 REM 1 = start with current time, TEMP$ = entered time 12915 REM 2 = start with current time, TEMP$ = entered time 12920 REM and DOS time is set 12925 REM optional - TEMP$="HH:MM:SS" - initial time 12930 REM optional - EDKEYS=0,1,2 - what keys allow you to exit the routine 12935 REM 0 = only ENTER or ESCAPE 12940 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 12945 REM 2 = include F1-F10 12950 REM optional - BOX=0,1,2,3 - type of box to draw around prompt 12955 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 12960 REM optional- SHADOW=0,1 - type of shadow to include with box 12965 REM 0 = no shadow, 1 = shadow 12970 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 12975 REM FIELDFORE, FIELDBACK, SHADOEFORE, SHADOWBACK 12980 REM colors optionally specified for COLOR statements 12985 REM exit with - TEMP$="HH:MM:SS" and DOS time set if MODE=1 12990 REM BOX=0, SHADOW=0, EDKEYS=0 (to maintain as optional) 12995 REM 13000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 13000 13005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 13010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 13015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 13020 IF BOX=0 THEN 13135 13025 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 13030 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 13035 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 13040 COLOR TEXTFORE,TEXTBACK 13045 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 13050 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+14:PRINT CHR$(UR); 13055 LOCATE ROW,COL+14:PRINT CHR$(MS); 13060 LOCATE ROW+1,COL+14:PRINT CHR$(LR); 13065 LOCATE ROW-1,COL-1:PRINT STRING$(15,CHR$(TP)); 13070 LOCATE ROW+1,COL-1:PRINT STRING$(15,CHR$(BT)); 13075 IF SHADOW=0 THEN 13135 13080 L=8:COLOR SHADOWFORE,SHADOWBACK 13085 IF BOX<>1 AND BOX<>2 THEN 13120 13090 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 13095 LOCATE ROW+2,COL+1:PRINT STRING$(L+2,CHR$(BT)); 13100 LOCATE ROW+2,COL+L+3:PRINT CHR$(LR);:LOCATE ROW+1,COL+L+3:PRINT CHR$(MS); 13105 LOCATE ROW,COL+L+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 13110 LOCATE ROW+1,COL+L+2:PRINT " "; 13115 GOTO 13135 13120 LOCATE ROW+2,COL-1:PRINT STRING$(L+4,CHR$(TP)); 13125 LOCATE ROW+1,COL+L+2:PRINT CHR$(MS);:LOCATE ROW,COL+L+2:PRINT CHR$(MS); 13130 LOCATE ROW-1,COL+L+2:PRINT CHR$(BT); 13135 BOX=0:SHADOW=0 13140 T1COL=COL:IF MODE=0 THEN T1$=LEFT$(TEMP$,2) ELSE T1$=LEFT$(TIME$,2) 13145 T2COL=COL+3:IF MODE=0 THEN T2$=MID$(TEMP$,4,2) ELSE T2$=MID$(TIME$,4,2) 13150 T3COL=COL+6:IF MODE=0 THEN T3$=MID$(TEMP$,7,2) ELSE T3$=MID$(TIME$,7,2) 13155 TEMPTIME$=T1$+":"+T2$+":"+T3$:TEMPCOL=COL:TEDKEYS=EDKEYS 13160 LOCATE ROW,COL:COLOR TEXTFORE,TEXTBACK:PRINT TEMPTIME$; 13165 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+8:PRINT " "; 13170 REM ----- 13175 TEMP$=T1$:OLDT1$=T1$:COL=T1COL:LNG=2:INPTYPE=2:EDKEYS=2 13180 GOSUB 10000 :REM SUBROUTINE USED 13185 T1$=TEMP$ 13190 IF EXIT$="ESC" THEN 13470 13195 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13200 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13205 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13210 IF T1$="" OR T1$=" " OR T1$=" " OR VAL(T1$)>23 THEN GOSUB 13485:GOTO 13175 13215 IF EXIT$="ENTER" AND T1$=OLDT1$ THEN 13440 13220 IF EXIT$="ENTER" AND T1$<>OLDT1$ THEN 13240 13225 IF EXIT$="LEFT" AND TEDKEYS>0 THEN 13440 13230 IF EXIT$="RIGHT" THEN 13240 13235 GOSUB 13485:GOTO 13175 13240 IF RIGHT$(T1$,1)=" " THEN T1$=LEFT$(T1$,1) 13245 IF LEFT$(T1$,1)=" " THEN T1$=RIGHT$(T1$,1) 13250 IF LEN(T1$)<2 THEN T1$="0"+T1$ 13255 LOCATE ROW,T1COL:PRINT T1$; 13260 REM ----- 13265 TEMP$=T2$:OLDT2$=T2$:COL=T2COL:LNG=2:INPTYPE=2:EDKEYS=2 13270 GOSUB 10000 :REM SUBROUTINE USED 13275 T2$=TEMP$ 13280 IF EXIT$="ESC" THEN 13470 13285 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13290 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13295 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13300 IF T2$="" OR T2$=" " OR T2$=" " OR VAL(T2$)>59 THEN GOSUB 13485:GOTO 13265 13305 IF EXIT$="ENTER" AND T2$=OLDT2$ THEN 13440 13310 IF EXIT$="ENTER" AND T2$<>OLDT2$ THEN 13330 13315 IF EXIT$="RIGHT" THEN 13330 13320 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13175 13325 GOSUB 13485:GOTO 13265 13330 IF RIGHT$(T2$,1)=" " THEN T2$=LEFT$(T2$,1) 13335 IF LEFT$(T2$,1)=" " THEN T2$=RIGHT$(T2$,1) 13340 IF LEN(T2$)<2 THEN T2$="0"+T2$ 13345 LOCATE ROW,T2COL:PRINT T2$; 13350 REM ----- 13355 TEMP$=T3$:COL=T3COL:LNG=2:INPTYPE=2:EDKEYS=2 13360 GOSUB 10000 :REM SUBROUTINE USED 13365 T3$=TEMP$ 13370 IF EXIT$="ESC" THEN 13470 13375 IF LEFT$(EXIT$,1)="F" AND TEDKEYS>1 THEN 13470 13380 IF (EXIT$="PGUP" OR EXIT$="PGDN") AND TEDKEYS>0 THEN 13470 13385 IF (EXIT$="UP" OR EXIT$="DOWN") AND TEDKEYS>0 THEN 13470 13390 IF T3$="" OR T3$=" " OR T3$=" " OR VAL(T3$)>59 THEN GOSUB 13485:GOTO 13355 13395 IF EXIT$="ENTER" THEN 13440 13400 IF EXIT$="RIGHT" AND TEDKEYS>0 THEN 13415 13405 IF EXIT$="LEFT" THEN EDCOL=1:GOTO 13265 13410 GOSUB 13485:GOTO 13355 13415 IF RIGHT$(T3$,1)=" " THEN T3$=LEFT$(T3$,1) 13420 IF LEFT$(T3$,1)=" " THEN T3$=RIGHT$(T3$,1) 13425 IF LEN(T3$)<2 THEN T3$="0"+T3$ 13430 LOCATE ROW,T3COL:PRINT T3$; 13435 REM ----- 13440 IF MODE=2 THEN TIME$=T1$+":"+T2$+":"+T3$ 13445 REM ----- NORMAL EXIT 13450 TEMP$=T1$+":"+T2$+":"+T3$ 13455 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 13460 PRINT TEMP$;:GOTO 13495 13465 REM ----- ESCAPE EXIT 13470 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,TEMPCOL 13475 PRINT TEMPTIME$;:GOTO 13495 13480 REM ----- BEEP IF ERROR ----- 13485 BEEP:RETURN 13490 REM ----- COMMON EXIT 13495 BOX=0:SHADOW=0:EDKEYS=0:RETURN 13500 REM 14850 REM ********************************************************************* 14855 REM ------------- ENTER A DOLLAR AMOUNT AT ROW AND COLUMN --------------- 14860 REM 14865 REM This subroutine allows you to enter a dollar amount field at a 14870 REM specified row and column. It allows you to specify the maximum 14875 REM amount you may enter and allows you to optionally draw a box 14880 REM around the entering area. The numbers shift into the field from 14885 REM right to left and can be shifted back out with the BACKSPACE key. 14890 REM Hitting ESCAPE once clears the field and hitting ESCAPE again 14895 REM exits the routine. Hitting ENTER completes the entry. 14900 REM 14905 REM enter with - ROW and COL=row and column at which to enter the field 14910 REM LNG=maximum length of the amount (8=99999.99) 14915 REM optional - BOX=0,1,2,3 - type of box to draw around the area 14920 REM 0 = no box, 1 = 1 line, 2 = 2 line, 3 = solid 14925 REM optional- SHADOW=0,1 - type of shadow to include with box 14930 REM 0 = no shadow, 1 = shadow 14935 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 14940 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 14945 REM colors optionally specified for COLOR statements 14950 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 14955 REM 0 = only ENTER or ESCAPE 14960 REM 1 = include PGUP, PGDN, UP, DOWN, LEFT, RIGHT 14965 REM 2 = include F1-F10 14970 REM exit with - TEMP$="dollars" entered 14975 REM BOX=0,SHADOW=0,EDKEYS=0 (to maintain these as optional) 14980 REM EXIT$=key hit that exited routine (ENTER or ESC) 14985 REM 14990 REM 14995 REM 15000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 15000 15005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 15010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 15015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 15020 TTTT$="":EXIT$="" 15025 IF BOX=0 THEN 15155 15030 IF BOX=1 THEN TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195 15035 IF BOX=2 THEN TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188:DN=203:RT=204 15040 IF BOX=3 THEN TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219 15045 COLOR TEXTFORE,TEXTBACK 15050 LOCATE ROW+1,COL-2:PRINT CHR$(LL);:LOCATE ROW,COL-2:PRINT CHR$(MS); 15055 LOCATE ROW-1,COL-2:PRINT CHR$(UL);:LOCATE ROW-1,COL+LNG+1:PRINT CHR$(UR); 15060 LOCATE ROW,COL+LNG+1:PRINT CHR$(MS); 15065 LOCATE ROW+1,COL+LNG+1:PRINT CHR$(LR); 15070 LOCATE ROW-1,COL-1:PRINT STRING$(LNG+2,CHR$(TP)); 15075 LOCATE ROW+1,COL-1:PRINT STRING$(LNG+2,CHR$(BT)); 15080 IF SHADOW=0 THEN 15155 15085 COLOR SHADOWFORE,SHADOWBACK 15090 IF BOX<>1 AND BOX<>2 THEN 15130 15095 LOCATE ROW+1,COL:PRINT CHR$(DN);:LOCATE ROW+2,COL:PRINT CHR$(LL); 15100 LOCATE ROW+2,COL+1:PRINT STRING$(LNG+2,CHR$(BT)); 15105 LOCATE ROW+2,COL+LNG+3:PRINT CHR$(LR); 15110 LOCATE ROW+1,COL+LNG+3:PRINT CHR$(MS); 15115 LOCATE ROW,COL+LNG+1:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 15120 COLOR TEXTFORE,TEXTBACK:LOCATE ROW+1,COL+LNG+2:PRINT " "; 15125 GOTO 15155 15130 LOCATE ROW+2,COL-1:PRINT STRING$(LNG+4,CHR$(TP)); 15135 LOCATE ROW+1,COL+LNG+2:PRINT CHR$(MS); 15140 LOCATE ROW,COL+LNG+2:PRINT CHR$(MS); 15145 LOCATE ROW-1,COL+LNG+2:PRINT CHR$(BT); 15150 REM ----- 15155 IF LEN(TTTT$)=0 THEN TEMP$="0.00":GOTO 15175 15160 IF LEN(TTTT$)=1 THEN TEMP$="0.0"+TTTT$:GOTO 15175 15165 IF LEN(TTTT$)=2 THEN TEMP$="0."+TTTT$:GOTO 15175 15170 TEMP$=LEFT$(TTTT$,LEN(TTTT$)-2)+"."+RIGHT$(TTTT$,2) 15175 COLOR FIELDFORE,FIELDBACK:LOCATE ROW,COL 15180 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$;:COLOR TEXTFORE,TEXTBACK 15185 LOCATE ROW,COL-1:PRINT " ";:LOCATE ROW,COL+LNG:PRINT " "; 15190 IN$=INKEY$:IF IN$="" THEN 15190 :REM -------------- 15195 IF IN$=CHR$(27) THEN 15360 :REM ESCAPE | 15200 ESCFLAG=0 :REM clear flag | 15205 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 15375 :REM ENTER | 15210 IF IN$=CHR$(8) THEN 15340 :REM BACKSPACE | 15215 IF EDKEYS=0 THEN 15305 :REM skip these - | 15220 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 15375 :REM LEFT ARROW | 15225 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 15375:REM RIGHT ARROW | 15230 IF IN$=CHR$(0)+CHR$(72) THEN EXIT$="UP":GOTO 15375 :REM UP ARROW | 15235 IF IN$=CHR$(0)+CHR$(80) THEN EXIT$="DOWN":GOTO 15375 :REM DOWN ARROW | 15240 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 15375 :REM PAGE UP | 15245 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 15375 :REM PAGE DOWN | 15250 IF EDKEYS=1 THEN 15305 :REM skip these - | 15255 IF IN$=CHR$(0)+CHR$(59) THEN EXIT$="F1":GOTO 15375 :REM F1 | 15260 IF IN$=CHR$(0)+CHR$(60) THEN EXIT$="F2":GOTO 15375 :REM F2 | 15265 IF IN$=CHR$(0)+CHR$(61) THEN EXIT$="F3":GOTO 15375 :REM F3 | 15270 IF IN$=CHR$(0)+CHR$(62) THEN EXIT$="F4":GOTO 15375 :REM F4 | 15275 IF IN$=CHR$(0)+CHR$(63) THEN EXIT$="F5":GOTO 15375 :REM F5 | 15280 IF IN$=CHR$(0)+CHR$(64) THEN EXIT$="F6":GOTO 15375 :REM F6 | 15285 IF IN$=CHR$(0)+CHR$(65) THEN EXIT$="F7":GOTO 15375 :REM F7 | 15290 IF IN$=CHR$(0)+CHR$(66) THEN EXIT$="F8":GOTO 15375 :REM F8 | 15295 IF IN$=CHR$(0)+CHR$(67) THEN EXIT$="F9":GOTO 15375 :REM F9 | 15300 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 15375 :REM F10 | 15305 :REM -------------- 15310 REM ----- allow only numbers 15315 IF ASC(IN$)<48 OR ASC(IN$)>57 THEN GOSUB 15400:GOTO 15190 15320 IF LEN(TTTT$)>=LNG-1 THEN GOSUB 15400:GOTO 15190 15325 TTTT$=TTTT$+IN$:GOTO 15155 15330 REM ----- BACKSPACE ----- 15335 REM ----- error if blank 15340 IF LEN(TTTT$)=0 THEN GOSUB 15400:GOTO 15190 15345 REM ----- good backspace 15350 TTTT$=LEFT$(TTTT$,LEN(TTTT$)-1):GOTO 15155 15355 REM ----- ESCAPE ----- 15360 IF ESCFLAG THEN EXIT$="ESC":GOTO 15375 15365 ESCFLAG=-1:TTTT$="":GOTO 15155 15370 REM ----- COMMON EXIT ----- 15375 COLOR TEXTFORE,TEXTBACK:LOCATE ROW,COL 15380 PRINT STRING$(LNG-LEN(TEMP$)," ")+TEMP$; 15385 BOX=0:EDKEYS=0:ESCFLAG=0:RETURN 15390 REM 15395 REM ----- BEEP IF ERROR ----- 15400 BEEP:RETURN 15405 REM 15410 REM 15415 REM 18980 REM ******************************************************************** 18985 REM --------------------- wait for any key ----------------------------- 18990 REM nothing needed on entry 18995 REM 19000 LOCATE ,,0 :REM 19000 19005 IN$=INKEY$:IF IN$="" THEN 19005 19010 RETURN 19015 REM 19020 REM 19025 REM 19080 REM ******************************************************************** 19085 REM -------------------------- DELAY ----------------------------------- 19090 REM enter with DELAY=seconds to delay 19095 REM 19100 LOCATE ,,0:T=TIMER :REM 19100 19105 IF TIMER"" THEN ESCAPE=-1:GOTO 19215 19210 IF TIMER