home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic1 / pro15 / keyboard.bas < prev    next >
Encoding:
BASIC Source File  |  1988-03-07  |  7.2 KB  |  117 lines
  1.  
  2. SUB keyboard (instring$, length%, number%, insert%, outstring$)
  3.     'instring$ is a string passed to the routine
  4.     'length% is the length of the string you want
  5.     'number% sets input for numeric only (1) or alpha (0)
  6.     'insert% sets insert mode (1) or overwrite (0)
  7.     'outstring$ is the string returned to your program
  8.     IF instring$ = "" THEN
  9.         b$ = SPACE$(length%)                               'if no existing string, then new string
  10.     ELSE
  11.         pad% = length% - LEN(instring$)
  12.         b$ = instring$ + SPACE$(pad%)                      'edit existing string
  13.     END IF
  14.     beginline% = POS(s)
  15.     hlocation% = POS(s)                                    'location of cursor on line
  16.     digit$ = "-.0123456789"
  17.     current% = 1                                           'location of character in string
  18. DO
  19.     DO
  20.         LOCATE , hlocation%, 1                             'position cursor and turn it on
  21.         a$ = INKEY$                                        'get a character from keyboard
  22.     LOOP WHILE a$ = ""
  23.     a% = ASC(RIGHT$(a$, 1))                                'extract key code
  24.     SELECT CASE a%                                         'determine what to do
  25.     CASE 13                                                'if ENTER
  26.         outstring$ = RTRIM$(b$)                            'assign outstring its value minus spaces
  27.         EXIT SUB                                           'quit
  28.     CASE 75                                                'left arrow
  29.         hlocation% = hlocation% - 1                        'reset location on line
  30.         current% = current% - 1                            'move back current character
  31.         LOCATE , hlocation%                                'move back on line
  32.     CASE 77                                                'right arrow
  33.         LOCATE , hlocation% + 1                            'move cursor
  34.         current% = current% + 1                            'update position in string
  35.         hlocation% = hlocation% + 1                        'update position on line
  36.     CASE 72                                                'up arrow
  37.         length% = 0                                        'tells calling prog what follows isn't a string
  38.         outstring$ = "UP"                                  'lets calling prog know what happened
  39.         EXIT SUB
  40.     CASE 80
  41.         length% = 0                                        'same as above but down arrow
  42.         outstring$ = "DN"
  43.         EXIT SUB
  44.     CASE 71                                                'home key is pressed
  45.         LOCATE , beginline%                                'go to beginning of field
  46.         hlocation% = beginline%                            'update position on line
  47.         current% = 1                                       'update position in string
  48.     CASE 79                                                'end key is pressed
  49.         LOCATE , beginline% + length%                      'go to end of field
  50.         hlocation% = beginline% + length% - 1              'update position on line
  51.         current% = length% - 1                             'update position in string
  52.     CASE 83                                                'delete key is pressed
  53.         FOR x% = current% TO length% - 1                   'move all the other
  54.             MID$(b$, x%, 1) = MID$(b$, x% + 1, 1)          '   characters left one
  55.             PRINT MID$(b$, x% + 1, 1);                     '   space
  56.         NEXT x%
  57.         MID$(b$, length%, 1) = " "                         'the last character in field is a space
  58.         LOCATE , beginline% + length% - 1                  'move cursor
  59.         PRINT " ";                                         'erase character
  60.         LOCATE , hlocation%                                'reset cursor
  61.     CASE 8                                                 'backspace is pressed
  62.         IF current% = length% THEN                         'cursor at end of field
  63.             LOCATE , hlocation%                            'move cursor
  64.             PRINT " ";                                     'erase character
  65.             hlocation% = hlocation% - 1                    'update position on line
  66.             current% = current% - 1                        'update position in string
  67.             MID$(b$, length%, 1) = " "                     'last character in field is a space
  68.             LOCATE , hlocation%                            'move cursor
  69.         ELSE
  70.             IF current% > 1 THEN                           'cursor is in field
  71.                 FOR x% = current% TO length% - 1           'move all the other
  72.                     MID$(b$, x%, 1) = MID$(b$, x% + 1, 1)  '   characters left one
  73.                     PRINT MID$(b$, x%, 1);                 '   space
  74.                 NEXT x%
  75.                 MID$(b$, length%, 1) = " "                 'last character is a space
  76.                 LOCATE , beginline% + length% - 1          'move cursor
  77.                 PRINT " ";                                 'erase character
  78.                 hlocation% = hlocation% - 1                'update location on line
  79.                 current% = current% - 1                    'update position in string
  80.                 LOCATE , hlocation%                        'move cursor
  81.             END IF
  82.         END IF
  83.     CASE ELSE
  84.         IF number% AND current% <= length% THEN            'if only numeric input
  85.             IF INSTR(digit$, a$) THEN                      'check to see if character is allowed
  86.                 MID$(b$, current%, 1) = a$                 'set proper character
  87.                 PRINT a$;                                  'print the character
  88.                 IF current% < length% THEN
  89.                     current% = current% + 1                'update position in string
  90.                     hlocation% = hlocation% + 1            'update line position
  91.                 END IF
  92.             ELSE
  93.                 BEEP                                       'not a digit, say so
  94.             END IF
  95.         ELSEIF current% <= length% THEN                    'other characters allowed
  96.             IF insert% THEN                                'is insert mode on
  97.                 FOR x% = length% TO current% + 1 STEP -1
  98.                     MID$(b$, x%, 1) = MID$(b$, x% - 1, 1)  'push characters right
  99.                     LOCATE , beginline% + (x% - 1), 0      'move cursor, set cursor off
  100.                     PRINT MID$(b$, x%, 1);                 'print moved characters
  101.                 NEXT x%
  102.             END IF
  103.                 LOCATE , hlocation%, 1                     'update position on line
  104.                 MID$(b$, current%, 1) = a$                 'set proper character
  105.                 PRINT a$;                                  'print the character
  106.                 IF current% < length% THEN                 'check if we're past end of field
  107.                     current% = current% + 1                'update position in string
  108.                     hlocation% = hlocation% + 1            'update position on line
  109.                 END IF
  110.         ELSE
  111.             BEEP                                           'max number of characters, say so
  112.         END IF
  113.     END SELECT
  114. LOOP
  115. END SUB
  116.  
  117.