100 REM ********************************************************************** 110 REM 120 REM FILENAME ROUTDEMM.BAS 130 REM WRITTEN BY GARY PEEK 140 REM LAST UPDATE 02/08/93 150 REM 160 REM DESCRIPTION DEMONSTRATES THE FUNCTIONS OF THE SUBROUTINES 170 REM THAT SETUP MENUS. 180 REM ********************************************************************** 190 KEY OFF:FOR A=1 TO 10:KEY A,"":NEXT A 200 COLOR 7,0:CLS 210 DIM ITEM$(21):DIM ITEMSTATUS(21) 220 ITEMSTATUS(2)=1:ITEMSTATUS(3)=1 230 REM ----- 240 MENUBOX=1:REM specify type of outline to draw 260 MSG$="MENU DEMO" 270 F1MSG$="pull-down" 280 F2MSG$="multiple selection" 290 F3MSG$="selection 3" 300 F4MSG$="selection 4" 310 F5MSG$="selection 5" 320 F6MSG$="selection 6" 330 F7MSG$="selection 7" 340 F8MSG$="selection 8" 350 F9MSG$="selection 9" 360 F10MSG$="change colors" 370 GOSUB 38000:REM create a menu with a work area and a prompt area 380 IF ESCAPE THEN LOCATE ,,1:COLOR 7,0:CLS:END 390 IF FUNCT=1 THEN GOSUB 1370:GOTO 480 400 IF FUNCT=2 THEN GOSUB 2000:GOTO 480 410 IF FUNCT=3 THEN 480 420 IF FUNCT=4 THEN 480 430 IF FUNCT=7 THEN 480 440 IF FUNCT=8 THEN 480 450 IF FUNCT=9 THEN 480 460 IF FUNCT=10 THEN BOX=3:GOSUB 8000:GOTO 480 480 GOTO 240 1360 REM -------------------------------- 1370 REM POINT AND SHOOT MENU 1375 GOSUB 38500:REM erase work area 1380 LOCATE 5,8 1390 PRINT "this style of menu can be displayed at a particular row and column" 1400 LOCATE 6,13 1410 PRINT "and can be specified as a pull-down menu like this one" 1430 MSG$="SELECT ITEM:" 1440 ITEM$(1)="ITEM 1" 1450 ITEM$(2)="ITEM 2" 1460 ITEM$(3)="ITEM 3" 1470 ITEM$(4)="ITEM 4" 1480 REM ITEM$(5)="ITEM 5" 1490 REM ITEM$(6)="ITEM 6" 1500 REM ITEM$(7)="ITEM 7" 1510 REM ITEM$(8)="ITEM 8" 1520 REM ITEM$(9)="ITEM 9" 1530 ROW=14:COL=32:BOX=3:SHADOW=1:DISPTYPE=1 1540 GOSUB 30000 1550 LOCATE 15,30 1560 PRINT "hit any key to continue"; 1570 IN$=INKEY$:IF IN$="" THEN 1570 1580 RETURN 1990 REM ---------------------- 2000 REM multiple selection menu 2030 MSG$="SELECT ITEMS WITH SPACE BAR:" 2040 ITEM$(1)="ITEM 1" 2050 ITEM$(2)="ITEM 2" 2060 ITEM$(3)="ITEM 3" 2070 ITEM$(4)="ITEM 4" 2080 ITEM$(5)="ITEM 5" 2090 ITEM$(6)="ITEM 6" 2100 ITEM$(7)="ITEM 7" 2110 ITEM$(8)="ITEM 8" 2120 ITEM$(9)="ITEM 9" 2500 ROW=5:COL=22:BOX=2:STATUSTYPE=2 2600 GOSUB 32000 2610 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 or Enter=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 29780 REM ******************************************************************** 29785 REM ---------------------- POINT AND SHOOT MENU ------------------------ 29790 REM ----------------------- (or display window) ------------------------ 29795 REM 29800 REM Sets up menu and selects from up to 9 items. Moves among the items 29805 REM with the arrow keys and selects with ENTER or ESCAPE keys, numbers 29810 REM 1-9, F1-F9, and optionally PAGE UP, PAGE DOWN, LEFT, RIGHT, F10. 29815 REM Displays message at top and optional box and shadow around the menu. 29820 REM Item names must be in order and none may be skipped. The ROW and COL 29825 REM must allow all of menu to be displayed on the screen. Menu can be 29830 REM optionally displayed as a pull-down menu, meaning that when item is 29835 REM selected, parts of the screen that were written over are restored. 29840 REM 29845 REM With the display window option set, the menu becomes only a display 29850 REM of text and does not wait for any keyboard entry. 29855 REM 29860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc. 29865 REM (array must be DIMinsioned before using this routine) 29870 REM MSG$="menu message or name", (up to 76 characters) 29875 REM ROW, COL=upper left corner of menu 29880 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 29885 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 29890 REM colors optionally specified for COLOR statements 29895 REM BOX=0,1,2,3 - type of outline around menu 29900 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 29905 REM optional- SHADOW=0,1 - type of shadow to include with box 29910 REM 0 = no shadow, 1 = shadow 29915 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 29920 REM 0 = only ENTER or ESCAPE 29925 REM 1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10 29930 REM ITEM = 1 to number of items, default item selected 29935 REM DISPTYPE=0,1,2,3 - type of menu/display desired 29940 REM 0 = normal menu 29945 REM 1 = pull-down menu (screen restored), 29950 REM 2 = display window of text only that looks just like menu 29955 REM 3 = display window with default "ITEM" hi-lighted 29960 REM exit with -ITEM = 1-9, item selected 29965 REM ITEM$ = ITEM$(1)-ITEM$(9), depending on item selected 29970 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 29975 REM (for compatibility with old versions) 29980 REM EXIT$=key hit that exited routine- 29985 REM "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10" 29990 REM BOX, SHADOW, DISPTYPE, EDKEYS=0 (to maintain as optional) 29995 REM 30000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 30000 30005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 30010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 30015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 30020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 30025 NUMITEMS=0:EXIT$="":ESCAPE=0 30030 FOR A%=1 TO 9:IF ITEM$(A%)="" THEN 30040 30035 NUMITEMS=NUMITEMS+1:NEXT A% 30040 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS 30045 REM -------------- FIND MAX LNG AND PAD SHORTER ONES --------------- 30050 MAXLEN=LEN(MSG$) 30055 FOR MLOOP%=1 TO NUMITEMS 30060 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%)) 30065 NEXT MLOOP% 30070 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN 30095 REM --------------- SAVE SCREEN IF PULL DOWN MENU ---------------- 30100 IF DISPTYPE<>1 THEN 30170 30105 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0 30110 DIM PSSSCHR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD) 30115 DIM PSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+4+SHAD,2) 30120 R=1:C=1 30125 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 30130 FOR SC%=COL TO COL+MAXLEN+3+SHAD 30135 PSSSCHR(R,C)=SCREEN(SR%,SC%,0) 30140 A=SCREEN(SR%,SC%,1):PSSSCOLOR(R,C,1)=(A AND 15) 30145 IF (A AND 128)=128 THEN PSSSCOLOR(R,C,1)=PSSSCOLOR(R,C,1)+16 30150 PSSSCOLOR(R,C,2)=(A AND 112)/16 30155 C=C+1:NEXT SC% 30160 R=R+1:C=1:NEXT SR% 30165 REM ---------------------- DISPLAY MENU ----------------------------- 30170 LOCATE ,,0 30175 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0 30180 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 30185 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 30190 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 30195 IROW=ROW:ICOL=COL 30200 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK 30205 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR); 30210 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" "; 30215 COLOR DATAFORE,DATABACK:PRINT MSG$; 30220 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 30225 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK 30230 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS); 30235 FOR PLOOP%=1 TO NUMITEMS 30240 LOCATE IROW+2+PLOOP%,ICOL 30245 PRINT CHR$(MS)+" "+ITEM$(PLOOP%)+" "+CHR$(MS); 30250 NEXT PLOOP% 30255 LOCATE IROW+3+NUMITEMS,ICOL 30260 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR); 30265 REM 30270 IF SHADOW=0 THEN 30375 30275 COLOR SHADOWFORE,SHADOWBACK 30280 IF BOX<>1 AND BOX<>2 THEN 30350 30285 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN); 30290 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL); 30295 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+2,CHR$(BT)); 30300 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+5:PRINT CHR$(LR); 30305 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1 30310 LOCATE DROW%,COL+MAXLEN+5:PRINT CHR$(MS); 30315 NEXT DROW% 30320 LOCATE ROW+1,COL+MAXLEN+3:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 30325 COLOR TEXTFORE,TEXTBACK 30330 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS 30335 LOCATE DROW%,COL+MAXLEN+4:PRINT " "; 30340 NEXT DROW% 30345 GOTO 30375 30350 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+4,CHR$(TP)); 30355 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1 30360 LOCATE DROW%,COL+MAXLEN+4:PRINT CHR$(MS); 30365 NEXT DROW% 30370 LOCATE ROW,COL+MAXLEN+4:PRINT CHR$(BT); 30375 REM 30380 REM ---------- DO NOT WAIT FOR ENTRY IF DISPLAY WINDOW ONLY ---------- 30385 IF DISPTYPE=2 THEN 30545:REM DISPLAY WINDOW 30390 IF DISPTYPE=3 THEN IROW=ITEM:ICOL=ICOL+2:GOTO 30535:REM WIND. WITH HILITE 30395 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT ONE -------------- 30400 IROW=1:IF ITEM>=1 AND ITEM<=NUMITEMS THEN IROW=ITEM 30405 ESCAPE=0:OLDIROW=IROW:ICOL=COL+2 30410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW); 30415 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW); 30420 IN$=INKEY$:IF IN$="" THEN 30420 30425 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 30525 30430 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 30525 30435 IF EDKEYS=0 THEN 30465 30440 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 30525 30445 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 30525 30450 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 30525 30455 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 30525 30460 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 30525 30465 IF LEN(IN$)=1 THEN 30475 30470 V=ASC(RIGHT$(IN$,1))-58:GOTO 30480:REM FUNCTION KEY 30475 V=VAL(IN$) 30480 IF V>=1 AND V<=9 AND V<=NUMITEMS THEN OLDIROW=IROW:IROW=V:GOTO 30525 30485 IF IN$=CHR$(0)+CHR$(72) THEN 30500:REM UP 30490 IF IN$=CHR$(0)+CHR$(80) THEN 30510:REM DOWN 30495 BEEP:GOTO 30420 30500 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 30410 30505 IROW=NUMITEMS:GOTO 30410 30510 OLDIROW=IROW:IF IROW1 THEN 30595 30550 R=1:C=1 30555 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 30560 FOR SC%=COL TO COL+MAXLEN+3+SHAD 30565 COLOR PSSSCOLOR(R,C,1),PSSSCOLOR(R,C,2) 30570 LOCATE SR%,SC%:PRINT CHR$(PSSSCHR(R,C)); 30575 C=C+1:NEXT SC% 30580 R=R+1:C=1:NEXT SR% 30585 ERASE PSSSCHR:ERASE PSSSCOLOR 30590 REM ------------------------------------------------------- 30595 FOR A%=1 TO 9:ITEM$(A%)="":NEXT A% 30600 COLOR TEXTFORE,TEXTBACK 30605 BOX=0:SHADOW=0:DISPTYPE=0:EDKEYS=0 30610 RETURN 30615 REM 31800 REM ******************************************************************** 31805 REM -------------------- MULTIPLE SELECTION MENU ----------------------- 31810 REM 31815 REM Sets up menu and selects from up to 21 items. Moves among the items 31820 REM with the arrow keys and selects item as on or off with SPACE BAR. 31825 REM Exit routine with ENTER or ESCAPE keys, and optionally PAGE UP, 31830 REM PAGE DOWN, LEFT, RIGHT, F10. Optionally draws a box around the menu. 31835 REM Item names must be in order and none may be skipped. The ROW and COL 31840 REM must allow all of menu to be displayed on the screen. Menu can be 31845 REM optionally displayed as a pull-down menu, meaning that when item is 31850 REM selected, parts of the screen that were written over are restored. 31855 REM 31860 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc. 31865 REM (array must be DIMinsioned before using this routine) 31870 REM MSG$="menu message or name", (up to 76 characters) 31875 REM ROW, COL=upper left corner of menu 31880 REM optional - ITEMSTATUS(1)= 0 or 1, ITEMSTATUS(2)=0 or 1, etc. 31885 REM (array must be DIMinsioned before using this routine) 31890 REM optional - TEXTFORE, TEXTBACK, DATAFORE, DATABACK 31895 REM FIELDFORE, FIELDBACK, SHADOWFORE, SHADOWBACK 31900 REM colors optionally specified for COLOR statements 31905 REM optional - BOX=0,1,2,3 - type of outline around menu 31910 REM 0 = no box, 1 = 1 line box, 2 = 2 line box, 3 = solid box 31915 REM optional - SHADOW=0,1 - type of shadow to include with box 31920 REM 0 = no shadow, 1 = shadow 31925 REM optional - EDKEYS=0,1 - what keys allow you to exit the routine 31930 REM 0 = only ENTER or ESCAPE 31935 REM 1 = include PGUP, PGDN, LEFT and RIGHT ARROWS, F10 31940 REM optional - DISPTYPE=0,1 - type of menu/display desired 31945 REM 0 = normal menu 31950 REM 1 = pull-down menu (screen restored), 31955 REM optional - STATUSTYPE = 0,1,2 - type of selection desired 31960 REM 0 = ON or OFF, 1 = YES or NO, 2=dot to indicate selected 31965 REM exit with -ITEMSTATUS(1)-ITEMSTATUS(21)= 1 or 0, selected or not 31970 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 31975 REM (for compatibility with old versions) 31980 REM EXIT$=key hit that exited routine- 31985 REM "ENTER","ESC","PGUP","PGDN","LEFT","RIGHT","F10" 31990 REM BOX, SHADOW, DISPTYPE, STATUSTYPE, EDKEYS=0 (to maintain as optional) 31995 REM 32000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 32000 32005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 32010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 32015 IF SHADOWFORE=0 AND SHADOWBACK=0 THEN SHADOWFORE=8 32020 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 32025 NUMITEMS=0:EXIT$="":ESCAPE=0 32030 ON ERROR GOTO 32050 32035 FOR A%=1 TO 21:IF ITEM$(A%)="" THEN 32055 32040 NUMITEMS=NUMITEMS+1:NEXT A% 32045 GOTO 32060 32050 RESUME 32055 32055 ON ERROR GOTO 0 32060 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS 32065 REM -------------- FIND MAX LNG AND PAD SHORTER ONES --------------- 32070 MAXLEN=LEN(MSG$) 32075 FOR MLOOP%=1 TO NUMITEMS 32080 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%)) 32085 NEXT MLOOP% 32090 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN 32115 REM --------------- SAVE SCREEN IF PULL DOWN MENU ---------------- 32120 IF DISPTYPE<>1 THEN 32190 32125 IF SHADOW<>0 THEN SHAD=2 ELSE SHAD=0 32130 DIM MSSSCHR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD) 32135 DIM MSSSCOLOR(NUMITEMS+4+SHAD,MAXLEN+9+SHAD,2) 32140 R=1:C=1 32145 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 32150 FOR SC%=COL TO COL+MAXLEN+8+SHAD 32155 MSSSCHR(R,C)=SCREEN(SR%,SC%,0) 32160 A=SCREEN(SR%,SC%,1):MSSSCOLOR(R,C,1)=(A AND 15) 32165 IF (A AND 128)=128 THEN MSSSCOLOR(R,C,1)=MSSSCOLOR(R,C,1)+16 32170 MSSSCOLOR(R,C,2)=(A AND 112)/16 32175 C=C+1:NEXT SC% 32180 R=R+1:C=1:NEXT SR% 32185 REM ---------------------- DISPLAY MENU ----------------------------- 32190 LOCATE ,,0 32195 IF BOX=0 THEN TP=0:BT=0:LS=0:RS=0:MS=0:MM=0:UL=0:LL=0:UR=0:LR=0 32200 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 32205 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 32210 IF BOX=3 THEN TP=223:BT=220:LS=219:RS=219:MS=219:MM=220:UL=219:LL=219:UR=219:LR=219 32215 IROW=ROW:ICOL=COL 32220 LOCATE IROW,ICOL:COLOR TEXTFORE,TEXTBACK 32225 PRINT CHR$(UL)+STRING$(MAXLEN+7,TP)+CHR$(UR); 32230 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" "; 32235 COLOR DATAFORE,DATABACK:PRINT MSG$; 32240 COLOR TEXTFORE,TEXTBACK:PRINT " "+CHR$(MS); 32245 LOCATE IROW+2,ICOL:COLOR TEXTFORE,TEXTBACK 32250 PRINT CHR$(LS)+STRING$(MAXLEN+7,MM)+CHR$(RS); 32255 FOR PLOOP=1 TO NUMITEMS 32260 LOCATE IROW+2+PLOOP,ICOL 32265 PRINT CHR$(MS)+" "+ITEM$(PLOOP)+" "; 32270 SROW=PLOOP:GOSUB 32640:REM PRINT SELECT MESSAGE 32275 PRINT " "+CHR$(MS); 32280 NEXT PLOOP 32285 LOCATE IROW+3+NUMITEMS,ICOL 32290 PRINT CHR$(LL)+STRING$(MAXLEN+7,BT)+CHR$(LR); 32295 IF SHADOW=0 THEN 32395 32300 COLOR SHADOWFORE,SHADOWBACK 32305 IF BOX<>1 AND BOX<>2 THEN 32370 32310 LOCATE ROW+3+NUMITEMS,COL+2:PRINT CHR$(DN); 32315 LOCATE ROW+4+NUMITEMS,COL+2:PRINT CHR$(LL); 32320 LOCATE ROW+4+NUMITEMS,COL+3:PRINT STRING$(MAXLEN+8,CHR$(BT)); 32325 LOCATE ROW+4+NUMITEMS,COL+MAXLEN+10:PRINT CHR$(LR); 32330 FOR DROW%=ROW+3+NUMITEMS TO ROW+2 STEP -1 32335 LOCATE DROW%,COL+MAXLEN+10:PRINT CHR$(MS); 32340 NEXT DROW% 32345 LOCATE ROW+1,COL+MAXLEN+8:PRINT CHR$(RT);CHR$(TP);CHR$(UR); 32350 FOR DROW%=ROW+2 TO ROW+3+NUMITEMS 32355 LOCATE DROW%,COL+MAXLEN+9:PRINT " "; 32360 NEXT DROW% 32365 GOTO 32395 32370 LOCATE ROW+4+NUMITEMS,COL+1:PRINT STRING$(MAXLEN+9,CHR$(TP)); 32375 FOR DROW%=ROW+3+NUMITEMS TO ROW+1 STEP -1 32380 LOCATE DROW%,COL+MAXLEN+9:PRINT CHR$(MS); 32385 NEXT DROW% 32390 LOCATE ROW,COL+MAXLEN+9:PRINT CHR$(BT); 32395 REM 32400 REM ------------- MOVE THROUGH MENU ITEMS AND SELECT STATUS ------------ 32405 IROW=1:ESCAPE=0:OLDIROW=IROW:ICOL=COL+2 32410 LOCATE OLDIROW+ROW+2,ICOL:COLOR TEXTFORE,TEXTBACK:PRINT ITEM$(OLDIROW); 32415 LOCATE OLDIROW+ROW+2,ICOL+MAXLEN+2:SROW=OLDIROW:GOSUB 32640:REM SELECT MESSAGE 32420 LOCATE IROW+ROW+2,ICOL:COLOR FIELDFORE,FIELDBACK:PRINT ITEM$(IROW); 32425 LOCATE IROW+ROW+2,ICOL+MAXLEN+2:SROW=IROW:GOSUB 32640:REM SELECT MESSAGE 32430 IN$=INKEY$:IF IN$="" THEN 32430 32435 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 32550 32440 IF IN$=CHR$(13) THEN EXIT$="ENTER":GOTO 32550 32445 IF EDKEYS=0 THEN 32475 32450 IF IN$=CHR$(0)+CHR$(75) THEN EXIT$="LEFT":GOTO 32520 32455 IF IN$=CHR$(0)+CHR$(77) THEN EXIT$="RIGHT":GOTO 32520 32460 IF IN$=CHR$(0)+CHR$(73) THEN EXIT$="PGUP":GOTO 32520 32465 IF IN$=CHR$(0)+CHR$(81) THEN EXIT$="PGDN":GOTO 32520 32470 IF IN$=CHR$(0)+CHR$(68) THEN EXIT$="F10":GOTO 32520 32475 IF IN$=CHR$(0)+CHR$(72) THEN 32495:REM UP 32480 IF IN$=CHR$(0)+CHR$(80) THEN 32505:REM DOWN 32485 IF IN$=" " THEN 32520 32490 BEEP:GOTO 32430 32495 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 32410 32500 IROW=NUMITEMS:GOTO 32410 32505 OLDIROW=IROW:IF IROW1 THEN 32600 32555 R=1:C=1 32560 FOR SR%=ROW TO ROW+NUMITEMS+3+SHAD 32565 FOR SC%=COL TO COL+MAXLEN+8+SHAD 32570 COLOR MSSSCOLOR(R,C,1),MSSSCOLOR(R,C,2) 32575 LOCATE SR%,SC%:PRINT CHR$(MSSSCHR(R,C)); 32580 C=C+1:NEXT SC% 32585 R=R+1:C=1:NEXT SR% 32590 ERASE MSSSCHR:ERASE MSSSCOLOR 32595 REM --------------------------- EXIT --------------------------------- 32600 ON ERROR GOTO 32610 32605 FOR A%=1 TO 21:ITEM$(A%)="":NEXT A%:GOTO 32620 32610 RESUME 32615 32615 ON ERROR GOTO 0 32620 COLOR TEXTFORE,TEXTBACK 32625 BOX=0:SHADOW=0:DISPTYPE=0:STATUSTYPE=0:EDKEYS=0 32630 RETURN 32635 REM -------------------- PRINT SELECT MESSAGE ------------------------ 32640 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=0 THEN PRINT "OFF"; 32645 IF STATUSTYPE=0 AND ITEMSTATUS(SROW)=1 THEN PRINT "ON "; 32650 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=0 THEN PRINT "NO "; 32655 IF STATUSTYPE=1 AND ITEMSTATUS(SROW)=1 THEN PRINT "YES"; 32660 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=0 THEN PRINT "[ ]"; 32665 IF STATUSTYPE=2 AND ITEMSTATUS(SROW)=1 THEN PRINT "["+CHR$(254)+"]"; 32670 RETURN 37880 REM ******************************************************************** 37885 REM ------------------------------ MENU -------------------------------- 37890 REM ------- OUTLINE A WORK AREA AND PROMPT AREA AND DISPLAY A MENU ----- 37895 REM ------------ SELECT FROM ITEMS ON MENU WITH F1-F10 KEYS ------------ 37900 REM 37905 REM This subroutine allows you to set up a menu and select from items on 37910 REM the menu with the function keys. It sets up a "work" area and a 37915 REM "prompt" area, both which can be erased individually with their 37920 REM own respective routines. Any function key that does not have a 37925 REM message specified for it will not be allowed as a possible key to 37930 REM be hit. 37935 REM 37940 REM enter with - F1MSG$="F1 message", TO DISPLAY (UP TO 23 CHARACTERS) 37945 REM F2MSG$,F10MSG$, etc. 37950 REM note: unused messages must be set to null or "" 37955 REM MSG$="program or menu name", (up to 37 characters) 37960 REM MENUBOX = 0,1,2,3 - type of box outline 37965 REM 0=no box, 1=1 line box, 2=2 line box, 3=solid box 37970 REM optional - TEXTFORE,TEXTBACK,DATAFORE,DATABACK,FIELDFORE,FIELDBACK 37975 REM colors optionally specified for COLOR statements 37980 REM exit with - FUNCT = 1-10, depending on key hit 37985 REM MENUBOX still set for erase prompt area routine 37990 REM ESCAPE=-1 (TRUE) if ESCAPE key hit 37995 REM 38000 IF TEXTFORE=0 AND TEXTBACK=0 THEN TEXTFORE=7 :REM 38000 38005 IF DATAFORE=0 AND DATABACK=0 THEN DATAFORE=15 38010 IF FIELDFORE=0 AND FIELDBACK=0 THEN FIELDBACK=7 38015 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A% 38020 COLOR TEXTFORE,TEXTBACK:CLS:LOCATE ,,0 38025 IF MENUBOX=0 THEN 38140 38030 IF MENUBOX=1 THEN TP=196:BT=196:SS=179:UL=218:LL=192:UR=191:LR=217 38035 IF MENUBOX=1 THEN MM=196:ML=195:MR=180:MT=194:MB=193:VT=194:VB=193 38040 IF MENUBOX=2 THEN TP=205:BT=205:SS=186:UL=201:LL=200:UR=187:LR=188 38045 IF MENUBOX=2 THEN MM=205:ML=204:MR=185:MT=203:MB=202:VT=203:VB=202 38050 IF MENUBOX=3 THEN TP=223:BT=220:SS=219:UL=219:LL=219:UR=219:LR=219 38055 IF MENUBOX=3 THEN MM=219:ML=219:MR=219:MT=223:MB=220:VT=219:VB=219 38060 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 38065 ROW=3:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 38070 ROW=19:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP)); 38075 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT)); 38080 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW% 38085 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(SS);:NEXT ROW% 38090 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR); 38095 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR); 38100 LOCATE 1,19:PRINT CHR$(VT);:LOCATE 2,19:PRINT CHR$(SS); 38105 LOCATE 3,19:PRINT CHR$(VB); 38110 LOCATE 1,64:PRINT CHR$(VT);:LOCATE 2,64:PRINT CHR$(SS); 38115 LOCATE 3,64:PRINT CHR$(VB); 38120 LOCATE 3,1:PRINT CHR$(ML);:LOCATE 3,80:PRINT CHR$(MR); 38125 LOCATE 19,1:PRINT CHR$(ML);:LOCATE 19,80:PRINT CHR$(MR); 38130 COL=59:FOR ROW=20 TO 24:LOCATE ROW,COL:PRINT CHR$(SS);:NEXT 38135 LOCATE 19,59:PRINT CHR$(VT);:LOCATE 25,59:PRINT CHR$(VB); 38140 REM 38145 ROW=2:COL=42-INT((LEN(MSG$)/2)):REM display message at top 38150 COLOR DATAFORE,DATABACK:LOCATE ROW,COL 38155 PRINT MSG$;:COLOR TEXTFORE,TEXTBACK 38160 MSG$="SELECT MENU ITEM":ROW=20:COL=62:LOCATE ROW,COL:PRINT MSG$; 38165 MSG$="WITH FUNCTION KEYS ":ROW=21:COL=61:LOCATE ROW,COL:PRINT MSG$; 38170 MSG$="(F1-F10)":ROW=22:COL=66 38175 COLOR DATAFORE,DATABACK:REM set colors for DATA 38180 LOCATE ROW,COL:PRINT MSG$; 38185 COLOR TEXTFORE,TEXTBACK:REM set colors for TEXT 38190 MSG$="(ESC)ape to EXIT":ROW=24:COL=62:LOCATE ROW,COL:PRINT MSG$; 38195 MSG$="F1-"+F1MSG$:ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$; 38200 MSG$="F2-"+F2MSG$:ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$; 38205 MSG$="F3-"+F3MSG$:ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$; 38210 MSG$="F4-"+F4MSG$:ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$; 38215 MSG$="F5-"+F5MSG$:ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$; 38220 MSG$="F6-"+F6MSG$:ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$; 38225 MSG$="F7-"+F7MSG$:ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$; 38230 MSG$="F8-"+F8MSG$:ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$; 38235 MSG$="F9-"+F9MSG$:ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$; 38240 MSG$="F10-"+F10MSG$:ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$; 38245 REM 38250 COLOR DATAFORE,DATABACK:REM set colors for FIELD 38255 IF F1MSG$<>"" THEN MSG$="F1":ROW=20:COL=3:LOCATE ROW,COL:PRINT MSG$; 38260 IF F2MSG$<>"" THEN MSG$="F2":ROW=20:COL=31:LOCATE ROW,COL:PRINT MSG$; 38265 IF F3MSG$<>"" THEN MSG$="F3":ROW=21:COL=3:LOCATE ROW,COL:PRINT MSG$; 38270 IF F4MSG$<>"" THEN MSG$="F4":ROW=21:COL=31:LOCATE ROW,COL:PRINT MSG$; 38275 IF F5MSG$<>"" THEN MSG$="F5":ROW=22:COL=3:LOCATE ROW,COL:PRINT MSG$; 38280 IF F6MSG$<>"" THEN MSG$="F6":ROW=22:COL=31:LOCATE ROW,COL:PRINT MSG$; 38285 IF F7MSG$<>"" THEN MSG$="F7":ROW=23:COL=3:LOCATE ROW,COL:PRINT MSG$; 38290 IF F8MSG$<>"" THEN MSG$="F8":ROW=23:COL=31:LOCATE ROW,COL:PRINT MSG$; 38295 IF F9MSG$<>"" THEN MSG$="F9":ROW=24:COL=3:LOCATE ROW,COL:PRINT MSG$; 38300 IF F10MSG$<>"" THEN MSG$="F10":ROW=24:COL=30:LOCATE ROW,COL:PRINT MSG$; 38305 COLOR TEXTFORE,TEXTBACK:REM restore colors to TEXT 38310 REM 38315 REM ------- get a function key while displaying date and time ----- 38320 REM 38325 ESCAPE=0:LOCATE ,,0 38330 IN$=INKEY$:IF IN$<>"" THEN 38345 38335 LOCATE 2,3:PRINT "DATE "+DATE$; 38340 LOCATE 2,66:PRINT "TIME "+TIME$;:GOTO 38330 38345 IF F1MSG$<>"" AND IN$=CHR$(0)+CHR$(59) THEN FUNCT=1:GOTO 38405 38350 IF F2MSG$<>"" AND IN$=CHR$(0)+CHR$(60) THEN FUNCT=2:GOTO 38405 38355 IF F3MSG$<>"" AND IN$=CHR$(0)+CHR$(61) THEN FUNCT=3:GOTO 38405 38360 IF F4MSG$<>"" AND IN$=CHR$(0)+CHR$(62) THEN FUNCT=4:GOTO 38405 38365 IF F5MSG$<>"" AND IN$=CHR$(0)+CHR$(63) THEN FUNCT=5:GOTO 38405 38370 IF F6MSG$<>"" AND IN$=CHR$(0)+CHR$(64) THEN FUNCT=6:GOTO 38405 38375 IF F7MSG$<>"" AND IN$=CHR$(0)+CHR$(65) THEN FUNCT=7:GOTO 38405 38380 IF F8MSG$<>"" AND IN$=CHR$(0)+CHR$(66) THEN FUNCT=8:GOTO 38405 38385 IF F9MSG$<>"" AND IN$=CHR$(0)+CHR$(67) THEN FUNCT=9:GOTO 38405 38390 IF F10MSG$<>"" AND IN$=CHR$(0)+CHR$(68) THEN FUNCT=10:GOTO 38405 38395 IF IN$=CHR$(27) THEN ESCAPE=-1:GOTO 38405 38400 BEEP:GOTO 38330 38405 LOCATE 2,3:PRINT " "; 38410 LOCATE 2,66:PRINT " "; 38415 RETURN 38420 REM 38425 REM 38465 REM ******************************************************************** 38470 REM ----------------------- ERASE WORK AREA ---------------------------- 38475 REM nothing needed on entry 38480 REM 38485 REM This subroutine allows you to erase only the "work" area 38490 REM set up in the menu subroutine. 38495 REM 38500 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0 :REM 38500 38505 FOR ROW%=4 TO 18:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW% 38510 RETURN 38515 REM 38565 REM ******************************************************************** 38570 REM ---------------------- ERASE PROMPT AREA --------------------------- 38575 REM nothing needed on entry 38580 REM 38585 REM This subroutine allows you to erase only the "prompt" area 38590 REM set up in the menu subroutine. 38595 REM 38600 COLOR TEXTFORE,TEXTBACK:LOCATE ,,0 :REM 38600 38605 FOR ROW%=20 TO 24:LOCATE ROW%,2:PRINT SPACE$(78);:NEXT ROW% 38610 IF MENUBOX=0 THEN 38630 38615 IF MENUBOX=1 THEN MT=196:MB=196 38620 IF MENUBOX=2 THEN MT=205:MB=205 38625 IF MENUBOX=3 THEN MT=223:MB=220 38630 LOCATE 19,59:PRINT CHR$(MT);:LOCATE 25,59:PRINT CHR$(MB); 38635 RETURN 38640 REM 38645 REM