home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / BAS_SUB.ZIP / INKEY.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-04-19  |  5.4 KB  |  127 lines
  1. 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2. 2 ''      ULTIMATE INKEY      (C) COPYRIGHT  1983     NELSON FORD         ''
  3. 3 ''                                                                      ''
  4. 4 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  5. 10 DEFINT A-Z:  SCREEN 0,0,0,0:  WIDTH 80:  FG=7:  BF=0:  COLOR FG,BG:  CLS
  6. 20 DEF SEG:  POKE 106,0
  7. 30 YES = NOT NO:    NO = NOT YES
  8. 40 ESC = 27:  ESC$ = CHR$(ESC):  ENTR$ = CHR$(13)
  9. 50 BACKSPACE$ = CHR$(8)
  10. 60 LF.CURSOR=75:  RT.CURSOR=77:  END.KEY=79:  INS.KEY=82:  DEL.KEY=83:  HOME=71:   CTRL.END=117
  11. 70 GOTO 700
  12. 90 '
  13. 91 '''''''''''''''''''''''''''inkey routine''''''''''''''''''''''''''''''''
  14. 92 '
  15. 100 '  FL is the field length, passed to this routine by the main program
  16. 110 '
  17. 120 INS.LENGTH = 0:  CURSOR.POS = 1:  SOUND 80, .03:  MOVE.IT = NO:  KY = 0
  18. 130 CURSOR.START = POS(0)
  19. 140 CHAR.ACCEPT.CODE = FIX( FL / 100 )
  20. 150 FL = FL - CHAR.ACCEPT.CODE*100
  21. 160 IN$ = SPACE$(FL)
  22. 170 IF PROMPT$ <> "" THEN IN$ = LEFT$( PROMPT$ + SPACE$(FL), FL ):                  INS.LENGTH = LEN(PROMPT$):  PROMPT$=""
  23. 180 COLOR BG,FG
  24. 190 LOCATE, CURSOR.START, 1:   PRINT IN$;
  25. 200 LOCATE, CURSOR.START + CURSOR.POS - 1
  26. 210 N$ = INKEY$:   IF N$ = "" THEN 210
  27. 220 IF LEN(N$) = 1 THEN 350
  28. 230 '  Lines 240 thru 330 check for special keys.  You can omit this                   section if you do not need this function.
  29. 240 KY = ASC( RIGHT$(N$,1) )    'check for edit keys:
  30. 250 IF KY = LF.CURSOR THEN  IF CURSOR.POS > 1 THEN CURSOR.POS = CURSOR.POS - 1:     GOTO 200  ELSE 210
  31. 260 IF KY = DEL.KEY THEN IN$= LEFT$( IN$, CURSOR.POS - 1 ) + RIGHT$( IN$,FL    -    CURSOR.POS ) + " ":  INS.LENGTH = INS.LENGTH - 1:  GOTO 190
  32. 270 IF KY = INS.KEY THEN IF INSERT = NO THEN INSERT = YES:  LOCATE,,,4,7:           GOTO 190  ELSE INSERT = NO:  LOCATE,,,7:  GOTO 210
  33. 280 IF KY = HOME THEN CURSOR.POS = 1: GOTO 200
  34. 290 IF KY = CTRL.END THEN IN$ = LEFT$(IN$,CURSOR.POS-1) +SPACE$(FL - CURSOR.POS     + 1):   INS.LENGTH = CURSOR.POS - 1:  GOTO 190
  35. 300 IF KY= RT.CURSOR THEN CURSOR.POS = CURSOR.POS -(CURSOR.POS < INS.LENGTH):       GOTO 200
  36. 310 IF KY = END.KEY THEN CURSOR.POS = INS.LENGTH + 1:  GOTO 200
  37. 320 MOVE.IT = YES
  38. 330   GOTO 600  'not an edit key, but is a special key:  end input.
  39. 340 '
  40. 350 IF N$ = ESC$ THEN KY = ESC:  IN$=N$:  GOTO 320
  41. 360 IF CURSOR.POS > FL THEN 420
  42. 370 '
  43. 380 IF CHAR.ACCEPT.CODE = 0 AND N$ >= " " AND N$ <= "z" THEN 500
  44. 390 IF CHAR.ACCEPT.CODE = 1 AND N$ >= "0" AND N$ <= "9" THEN 500
  45. 400 IF CHAR.ACCEPT.CODE = 2 THEN IF N$ >= " " AND N$ < "a" THEN 500                    ELSE IF N$ >= "a" AND N$ <= "z" THEN N$ = CHR$(ASC(N$)-32):  GOTO 500
  46. 410 IF CHAR.ACCEPT.CODE = 3 AND INSTR(ACCEPT$, N$) > 0  THEN 500
  47. 415 '
  48. 420 IF N$ = ENTR$ THEN 600
  49. 430 IF N$ <> BACKSPACE$ OR CURSOR.POS = 1 THEN 210
  50. 440 '
  51. 450 IN$ = LEFT$(IN$, CURSOR.POS-2) +RIGHT$(IN$, FL -CURSOR.POS+1)+" "
  52. 460 INS.LENGTH = INS.LENGTH -1
  53. 470 CURSOR.POS = CURSOR.POS -1
  54. 480   GOTO 190
  55. 490 '
  56. 500 IF NOT INSERT THEN MID$(IN$, CURSOR.POS, 1) = N$:  GOTO 550               
  57. 510 IF INS.LENGTH >= FL  THEN 210
  58. 520 IN$ = LEFT$(LEFT$(IN$, CURSOR.POS-1) +N$ +RIGHT$(IN$, FL-CURSOR.POS +1),FL)
  59. 530 CURSOR.POS = CURSOR.POS + 1:   INS.LENGTH = INS.LENGTH + 1
  60. 540   GOTO 190
  61. 550 IF CURSOR.POS = 1 THEN IN$ = N$ + SPACE$(FL - 1):  PRINT IN$;:                  LOCATE, CURSOR.START:   INS.LENGTH = 1
  62. 560 PRINT N$;
  63. 570 CURSOR.POS = CURSOR.POS + 1
  64. 580 IF CURSOR.POS > INS.LENGTH THEN INS.LENGTH = CURSOR.POS - 1
  65. 590 GOTO 190
  66. 600 COLOR FG,BG:  LOCATE, CURSOR.START, 0, 7:   PRINT IN$;
  67. 610 IN$ = LEFT$(IN$, INS.LENGTH)
  68. 615 INSERT = NO
  69. 620   RETURN
  70. 670 '
  71. 680 '                 main menu:
  72. 690 '
  73. 700 CLS
  74. 710 LOCATE  4,33:  PRINT "   MAIN MENU "
  75. 720 LOCATE 10,33:  PRINT "1  Enter Data"
  76. 730 LOCATE 11,33:  PRINT "2  Print Reports"
  77. 740 LOCATE 12,33:  PRINT "3  Save Data"
  78. 750 LOCATE 14,33:  PRINT "   SELECT  "
  79. 760 LOCATE 14,33:  FL = 301:  ACCEPT$ = "123":  GOSUB 100
  80. 770 IF IN$ < "1" OR IN$ > "3" THEN 760
  81. 780 ON VAL(IN$) GOTO 1000, 2000, 3000
  82. 990 '
  83. 1000 'enter data:
  84. 1010 '
  85. 1020 CLS: LOCATE 4,35:  PRINT "DATA ENTRY":  I=1
  86. 1030 LOCATE 10,20:  PRINT "NAME:    "  NAM$(I)
  87. 1040 LOCATE 12,20:  PRINT "ADDRESS: "  ADDR$(I)
  88. 1050 LOCATE 14,20:  PRINT "CITY:    "  CITY$(I)
  89. 1060 LOCATE 16,20:  PRINT "STATE:   "  STATE$(I)
  90. 1070 LOCATE 16,40:  PRINT "ZIP:  " ZIP$(I)
  91. 1079 '
  92. 1080 'name:
  93. 1090 LOCATE 10,30:  FL = 25:  PROMPT$ = NAM$(I):  GOSUB 100
  94. 1095 IF IN$ = ESC$ THEN 700
  95. 1100 IF MOVE.IT THEN IF I > 1 THEN I = I - 1:  GOTO 1030
  96. 1110 NAM$(I) = IN$
  97. 1120 'addr:
  98. 1130 LOCATE 12,30:  FL = 20:  PROMPT$ = ADDR$(I):  GOSUB 100
  99. 1140 IF MOVE.IT THEN 1090
  100. 1150 ADDR$(I) = IN$
  101. 1160 'city:
  102. 1170 LOCATE 14,30:  FL = 15:  PROMPT$ = CITY$(I):  GOSUB 100
  103. 1180 IF MOVE.IT THEN 1130
  104. 1190 CITY$(I) = IN$
  105. 1200 'state:
  106. 1210 LOCATE 16,30:  FL = 202:  PROMPT$ = STATE$(I):  GOSUB 100
  107. 1220 IF MOVE.IT THEN 1170
  108. 1230 STATES$="OK TX AL GA FL AZ SC MI"
  109. 1240 LOCATE 18,30
  110. 1250 IF INSTR(STATES$, IN$) = 0 THEN  PRINT "INVALID STATE":  GOTO 1210              ELSE PRINT SPACE$(13)
  111. 1260 STATE$(I) = IN$
  112. 1270 'zip
  113. 1280 LOCATE 16,46:  FL = 105:  PROMPT$ = ZIP$(I):  GOSUB 100
  114. 1290 IF MOVE.IT THEN 1210
  115. 1300 LOCATE 18,46
  116. 1310 IF VAL(IN$) < 30000 OR VAL(IN$) > 89999! THEN PRINT "INVALID ZIP": GOTO 1280:    ELSE PRINT SPACE$(11)
  117. 1320 ZIP$(I) = IN$
  118. 1330 'loop:
  119. 1340 I = I + 1
  120. 1350 GOTO 1030
  121. 2000 '
  122. 2010 GOTO 700
  123. 3000 '
  124. 3010 GOTO 700
  125. INT SPACE$(11)
  126. 1320 ZIP$(I) = IN$
  127. 1330 'loop: