home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / BAS_SUB.ZIP / INKEY2.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-04-19  |  8.0 KB  |  159 lines
  1. 1 '                           INKEY DEMO
  2. 2 '                     (C) 1984   NELSON FORD
  3. 3 '        by Nelson Ford, P.O.Box 61565,  Houston, TX 77035
  4. 4 '
  5. 5 ' (A simplified version of this program with explanations appeared in the       '  June 1984 issue of PC TECH JOURNAL.  The added code allows input to be       '  controlled on a character-by-character basis.)
  6. 6 '
  7. 7 ' This code is taken from DISKCAT, (C) 1983,1984  N. FORD, a disk file          ' catalog program.  The compiled versions of the DISKCAT programs are           ' available in user group libraries and bulletin boards.  The latest
  8. 8 ' version of DISKCAT with the complete BASIC source code may be ordered         ' for $35 from the above address.  Placing this portion of the code in          ' the public domain does not abrogate the DISKCAT copyrights.
  9. 9 '
  10. 10 DEFINT A-Z:  SCREEN 0,1:  COLOR 7,0,0:  WIDTH 80:  CLS:  KEY OFF
  11. 20 FG=7:  HL=1:  BG=0  'FG=foreground color, HL=highlight, BG=background
  12. 30 DEF SEG=0:  IF (PEEK(&H410) AND &H30)<>&H30 THEN HL=15
  13. 40 COLOR FG, BG, BG
  14. 50 YES=NOT NO:  NO=NOT YES
  15. 60 DIM LOCKS$(3)  'used in inkey routine to display -lock status.
  16. 70 LOCKS$(0)=STRING$(7,219): LOCKS$(1)=STRING$(4,219)+"NUM"
  17. 80 LOCKS$(2)="CAP"+STRING$(4,219):  LOCKS$(3)="CAP"+CHR$(219)+"NUM"
  18. 90 NTR$=CHR$(13):  BKSP$=CHR$(8):  ESC$=CHR$(27):  UP$=CHR$(24): DN$=CHR$(25):     RT$=CHR$(26):  LF$=CHR$(27):  BREAK$=CHR$(3)
  19. 100 ENTR$=" "+CHR$(17)+STRING$(2,196)+CHR$(217)+" "
  20. 110 NUMS=1:  CAPS=2
  21. 120 LF.CURSOR=75:  RT.CURSOR=77:  END.KEY=79:  INS.KEY=82:  DEL.KEY=83:  HOME=71:   DN.CURSOR=80:  UP.CURSOR=72:  CTRL.END=117: ESC=27: CTRL.RT=116: CTRL.LF=115:   PG.UP=73:      PG.DN=81
  22. 130 GOTO 890
  23. 140 '
  24. 150 '''''''''''''''''''''inkey routine''''''''''''''''''
  25. 160 '
  26. 170 WD=0: WS=0: WL=0: WI=1: SOUND 80,.03: MOVE.IT=NO:  KY=0:  IN$=INKEY$
  27. 180 QX= POS(0):  QY=CSRLIN
  28. 190 QC$=CONTROL$: CONTROL$="": IF QC$="" THEN QC=NO: GOTO 210 ELSE QC=YES
  29. 200 IF INSTR("U#_",MID$(QC$,WI,1))=0 THEN WI=WI+1: GOTO 200
  30. 210 CHAR.CODE= FIX(FL/100):  IF CHAR.CODE>0 THEN FL= FL - CHAR.CODE*100
  31. 220 IN$= SPACE$(FL):  IF PROMPT$="" THEN IN$= SPACE$(FL): GOTO 250
  32. 230 IN$= LEFT$(PROMPT$+SPACE$(FL),FL):  WL=LEN(PROMPT$):  PROMPT$=""
  33. 240 IF MID$(IN$,WL,1)=" " THEN WL=WL-1:  IF WL>0 THEN 240
  34. 250 COLOR BG,FG
  35. 260 LOCATE QY,QX,1: PRINT IN$;
  36. 270 LOCATE QY,QX+WI-1
  37. 280 W$=INKEY$:  DEF SEG=&H40: QK=PEEK(&H17) AND 96:
  38. 290 IF QK1<>QK THEN LOCATE 25,73: PRINT LOCKS$(QK/32);: QK1=QK: SOUND 400+QK,.3:    GOTO 270
  39. 300 IF W$="" THEN 280
  40. 310 IF W$=BREAK$ THEN STOP
  41. 320 IF LEN(W$)=1 THEN 480  ELSE  KY= ASC(RIGHT$(W$,1))
  42. 330 IF QC THEN 350
  43. 340 IF KY= INS.KEY THEN IF INSERT=NO THEN INSERT=YES: LOCATE,,,4,13: GOTO 260                                        ELSE INSERT=NO:  LOCATE,,,13: GOTO 280
  44. 350 IF KY= RT.CURSOR THEN WI=WI-(WI<WL): GOTO 270
  45. 360 IF KY= LF.CURSOR THEN WI=WI+(WI> 1): GOTO 270
  46. 370 IF KY=DEL.KEY THEN IF NOT QC THEN IN$= LEFT$(IN$,WI-1)+RIGHT$(IN$,FL-WI)+" ":     WL=WL-1: GOTO 260  ELSE MID$(IN$,WI,1)=" ": GOTO 260
  47. 380 IF INSERT THEN INSERT=NO: LOCATE,,,13
  48. 390 IF KY= HOME THEN WI=1: GOTO 270
  49. 400 IF KY= END.KEY THEN WI= WL+1:  GOTO 270
  50. 410 IF KY= CTRL.END THEN IN$=LEFT$(IN$,WI-1)+SPACE$(FL-WI+1): WL=WI-1: GOTO 260
  51. 420 IF KY<>CTRL.RT OR WI=WL+1 THEN 440
  52. 430 WI=WI+1: IF WI=WL+1 THEN 270 ELSE IF MID$(IN$,WI-1,1)=" " THEN 270 ELSE 430
  53. 440 IF KY<>CTRL.LF OR WI=1 THEN 470
  54. 450 QC$=CONTROL$: CONTROL$="": IF QC$="" THEN QC=NO ELSE QC=YES
  55. 460 WI=WI-1: IF WI=1 THEN 270 ELSE IF MID$(IN$,WI-1,1)=" " THEN 270 ELSE 460
  56. 470 MOVE.IT= YES: GOTO 790
  57. 480 IF W$= NTR$ THEN 790
  58. 490 IF W$= ESC$ THEN  KY=ESC:  MOVE.IT=YES:  GOTO 790
  59. 500 IF NOT QC THEN 600
  60. 510 IF W$ <> BKSP$ THEN 540
  61. 520 IF WI>1 THEN WI=WI-1: Q$=MID$(QC$,WI,1)  ELSE 260
  62. 530 IF INSTR("#U_",Q$) =0 THEN 500 ELSE MID$(IN$,WI,1)=" ": GOTO 260
  63. 540 IF WI>FL THEN 600
  64. 550 Q$= MID$(QC$,WI,1)
  65. 560 IF Q$="#" THEN CHAR.CODE=NUMS: GOTO 600
  66. 570 IF Q$="U" THEN CHAR.CODE=CAPS: GOTO 610
  67. 580 IF Q$="_" THEN CHAR.CODE=0: GOTO 610
  68. 590 W$=Q$:  GOTO 680
  69. 600 IF CHAR.CODE=NUMS THEN IF (W$="-" AND WI>1) OR W$="+" THEN IN$=W$+IN$:          GOTO 790
  70. 610 IF WI>FL THEN 650
  71. 620 IF CHAR.CODE=0  THEN IF W$>=" " AND W$<="~" THEN 680
  72. 630 IF CHAR.CODE=NUMS THEN IF W$>="0" AND W$<="9" THEN 680
  73. 640 IF CHAR.CODE=CAPS THEN IF W$>="a" AND W$<="z" THEN W$=CHR$(ASC(W$)-32):         GOTO 680  ELSE IF W$>=" " AND W$<"a" THEN 680
  74. 650 IF W$=BKSP$ THEN IF WI>1 THEN IN$=LEFT$(IN$,WI-2)+RIGHT$(IN$,FL-WI+1)+" ":      WL=WL-1: WI=WI-1:  GOTO 260
  75. 660 GOTO 280
  76. 670 '
  77. 680 IF NOT INSERT THEN MID$(IN$,WI,1)=W$  ELSE  IF WL < FL THEN WL=WL+1:            IN$= LEFT$( LEFT$(IN$,WI-1) +W$ +RIGHT$(IN$,FL-WI+1), FL): WI=WI+1: GOTO 260    ELSE 280
  78. 690 IF WI>1 THEN 740
  79. 700 IF NOT QC THEN IN$=W$+SPACE$(FL-1): GOTO 730
  80. 710 FOR QQ=2 TO FL: IF INSTR("#u=UI_",MID$(QC$,QQ,1))>0 THEN MID$(IN$,QQ,1)=" "
  81. 720 NEXT
  82. 730 LOCATE,QX: PRINT IN$;: LOCATE,QX: WL=1
  83. 740 PRINT W$;
  84. 750 WI=WI+1: IF WI>WL THEN WL=WI-1
  85. 760 IF WI=>FL THEN 780
  86. 770 IF QC THEN Q$=MID$(QC$,WI,1): IF INSTR("#Ul_",Q$)=0 THEN W$=Q$: GOTO 680
  87. 780 IF FL>2 OR WL<FL THEN 260
  88. 790 COLOR FG,BG:  LOCATE QY,QX,,13:  PRINT IN$;:  IN$=LEFT$(IN$,WL): INSERT=NO:     RETURN
  89. 800 '
  90. 810 LOCATE 25,29
  91. 820 U$= "press|"+ENTR$+"|to continue": GOSUB 850:  FL=0: GOSUB 170
  92. 830 RETURN
  93. 840 '
  94. 850 U=1:  ULEN=LEN(U$):  U1=FG:  U2=HL
  95. 860 UU=INSTR(U,U$,"|"): UU=UU-(UU=0)*(ULEN+1):  PRINT MID$(U$,U,UU-U);:  U=UU+1:    SWAP U1,U2:  COLOR U1:  IF ULEN >U OR U=1 THEN 860  ELSE COLOR FG,BG
  96. 870 RETURN
  97. 880 '''''''''''''''''''''main menu''''''''''''''''''''''
  98. 890 '
  99. 900 COLOR FG,BG,BG:  CLS:  QK1=0:  LOCATE 22,18
  100. 910 U$= "Press  |Esc|  at prompts to return to this menu.": GOSUB 850
  101. 920 LOCATE 3,35: COLOR HL: PRINT"MAIN MENU": COLOR FG: LOCATE 6,1:  X=31
  102. 930 LOCATE,X: PRINT"1  Enter Data"
  103. 940 LOCATE,X: PRINT"2  Print Reports"
  104. 950 LOCATE,X: PRINT"3  Etc."
  105. 960 LOCATE,X: PRINT"4  Etc."
  106. 970 LOCATE,X: PRINT"5
  107. 980 LOCATE,X: PRINT"6
  108. 990 LOCATE,X: PRINT"7
  109. 1000 LOCATE,X: PRINT"8
  110. 1010 LOCATE,X: PRINT"9  End"
  111. 1020 '
  112. 1030 LOCATE 17,X: PRINT "   Select an option."
  113. 1040 LOCATE 17,X:  FL=201:  GOSUB 170
  114. 1050 IF IN$<"1" OR IN$>"9" THEN 1040
  115. 1060 JOB=VAL(IN$)
  116. 1070 ON JOB GOTO 1100,1040,1040,1040,1040,1040,1040,1040,1080: GOTO 1040
  117. 1080 CLS:END
  118. 1090 '
  119. 1100 '                 Enter Data
  120. 1110 '
  121. 1120 CLS: QK1=0: LOCATE 23,9: U$=UP$+"-|prior field.|  "+DN$+"-|next field.|  PgUp-|prior entry.|  PgDn-|next entry.|":  GOSUB 850
  122. 1130 COLOR HL:  LOCATE 21,10:  PRINT "Cursor control keys";:  COLOR FG
  123. 1140 PRINT ":   "LF$"  "RT$"  CTRL"LF$"  CTRL"RT$"  Home  End  Ins  Del"
  124. 1150 LOCATE 8,35: PRINT "Names & Addresses" TAB(62) "Input control:"
  125. 1160 LOCATE 10,1:  X=30:  Y=62:  Z=41
  126. 1170 LOCATE,X:  PRINT "Entry #  "
  127. 1180 LOCATE,X:  PRINT "Name     "  TAB(Y) "upper case forced"
  128. 1190 LOCATE,X:  PRINT "Address  "  TAB(Y) "any input allowed"
  129. 1200 LOCATE,X:  PRINT "City, St."  TAB(Y) "any & upper case
  130. 1210 LOCATE,X:  PRINT "Zip Code "  TAB(Y) "numbers forced"
  131. 1220 LOCATE,X:  PRINT "Telephone"  TAB(Y) "# format forced"
  132. 1230 COLOR FG:  LAST=0
  133. 1240 '
  134. 1250 I=1
  135. 1260 J=1:  LOCATE 10,Z: PRINT I
  136. 1270 ON J GOSUB 1420,1430,1440,1450,1460
  137. 1280 IF PROMPT$="" THEN PROMPT$=DTA$(I,J)
  138. 1290 LOCATE 10+J,Z:  GOSUB 170
  139. 1300 IF NOT MOVE.IT THEN 1360
  140. 1310   IF KY=UP.CURSOR THEN J=J+(J>1):  GOTO 1270
  141. 1320   IF KY=DN.CURSOR THEN J=J-(J<5):  GOTO 1270
  142. 1330   IF KY=PG.UP THEN IF I>1 THEN I=I-1: GOSUB 1490: GOTO 1260  ELSE BEEP:           GOTO 1270
  143. 1340   IF KY=PG.DN THEN I=I+1: IF I<=LAST THEN GOSUB 1490: GOTO 1260 ELSE 1390
  144. 1350   IF KY=ESC THEN GOTO 890
  145. 1360 IF IN$<>"" THEN DTA$(I,J)=IN$
  146. 1370 IF J<5 THEN J=J+1:  GOTO 1270
  147. 1380 IF I>LAST THEN LAST=I: I=I+1 ELSE I=LAST+1
  148. 1390 FOR K=1 TO 5: LOCATE 10+K,Z: PRINT SPACE$(20):  NEXT
  149. 1400 GOTO 1260
  150. 1410 '
  151. 1420 FL=215:  RETURN
  152. 1430 FL= 20:  RETURN
  153. 1440 FL= 15:  CONTROL$="___________, UU":  PROMPT$="           ,":  RETURN
  154. 1450 FL=105:  RETURN
  155. 1460 FL= 14:  CONTROL$="(###) ###-####"
  156. 1470 IF DTA$(I,J)="" THEN DTA$(I,J)=CONTROL$
  157. 1480 RETURN
  158. 1490 LOCATE 10,Z: PRINT I: FOR J=1 TO 5: LOCATE 10+J,Z: PRINT DTA$(I,J): NEXT:       RETURN
  159.