home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / EDSTR.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  9KB  |  219 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'EDSTR.INC'
  4. ' $INCLUDE: 'PARM.INC'
  5. ' $INCLUDE: 'SETCURS.INC'
  6.  
  7. '(Function declaration is in the include file)
  8.  
  9.  
  10. 'External procedures:
  11.  
  12. DECLARE FUNCTION GetKey$ (parm())
  13. DECLARE FUNCTION PadR$ (o$, n)
  14. DECLARE FUNCTION Stuff$ (o$, p, d, c$)
  15.  
  16. FUNCTION EdStr$ (orig$, parm())
  17. '****************************************************************************
  18. 'Used to edit an existing string or for input of a new string.
  19. '
  20. 'If the user presses ESC during the editing, CHR$(27) will be returned to let
  21. ' the calling procedure know it was aborted.
  22. '
  23. 'If Enter is pressed to terminate the editing, the edited string will be
  24. ' returned.
  25. '
  26. 'The settings of the miscellaneous parameters are as follows:
  27. '
  28. '    parm(1) = row
  29. '    parm(2) = column
  30. '    parm(3) = maximum length of the edited string  1-80
  31. '    parm(4) = insert/overwrite mode (Use SETCURS.INC constants)
  32. '    parm(5) = initial cursor position within string  0=Beginning
  33. '    parm(6) = use delimiters? (0=No  Non-zero=Yes)
  34. '    parm(7) = left delimiter ASCII code.  Default = 62  ( > )
  35. '    parm(8) = right delimiter ASCII code.  Default = 60  ( < )
  36. '    parm(9) = use selected colors?  0=Current colors  Non-zero=Selected
  37. '    parm(10)= used to restrict user input.  See EDSTR.INC for values.
  38. '
  39. 'EdStr$() works just like you're used to, with all the familiar editing keys:
  40. ' Left/right arrows, Backspace, Delete, Insert/overwrite, Home, and End.  It
  41. ' also has a special service, Alt-X, that deletes from the cursor position to
  42. ' the end of the line.
  43. '
  44. 'The maximum length of the edited string depends on whether delimiters are
  45. ' used or not.  Without delimiters, the string may be up to 80 characters
  46. ' long.  With delimiters, it is reduced to 78.
  47. '
  48. 'If you choose to have EdStr$() appear in the highlighted colors, it will
  49. ' reset the colors to normal upon exit.  If not, the current color setting
  50. ' will not be changed at all.
  51. '
  52. 'If parm(10) is greater than zero, user input will be limited to certain
  53. ' characters.  See EDSTR.INC for the constant names.  You may add these
  54. ' constants together to get different combinations of allowed characters.
  55. '
  56. '    Example: parm(10) = EDUPPER + EDALPHA + EDSPACE
  57. '
  58. '              This would allow spaces and uppercase letters only.
  59. '
  60. 'The combinations allowed for parm(10) are not extensive by any means, but
  61. ' for simple input they can be handy.
  62. '
  63. '****************************************************************************
  64.  
  65. 'Preliminary setup:
  66.  
  67. row = parm(1)                                          'Row
  68. col = parm(2)                                          'Column
  69. maxlen = parm(3)                                       'Max length
  70. inov = parm(4)                                         'Insert/Overwrite mode
  71. IF inov <> SCINS AND inov <> SCOVR THEN inov = SCINS   ' (default = Insert)
  72. spos = parm(5)                                         'Initial position
  73. IF spos < 1 OR spos > maxlen THEN spos = 1
  74. s$ = RTRIM$(orig$)
  75. IF spos > LEN(s$) THEN s$ = PadR$(s$, spos)
  76. IF LEN(s$) > maxlen THEN s$ = LEFT$(s$, maxlen)
  77. IF parm(6) <> 0 THEN                                   'Delimiters?
  78.      x = parm(7)
  79.      IF x < 1 OR x > 255 THEN x = 62
  80.      ld$ = CHR$(x)
  81.      x = parm(8)
  82.      IF x < 1 OR x > 255 THEN x = 60
  83.      rd$ = CHR$(x)
  84.      IF parm(9) THEN COLOR parm(FGS), parm(BGS)
  85.      LOCATE row, col
  86.      PRINT ld$; SPACE$(maxlen); rd$
  87.      col = col + 1
  88. END IF
  89. IF (parm(10) AND EDUPPER) THEN s$ = UCASE$(s$)         'Upper case?
  90.  
  91. sp$ = " "                               'For optimization.
  92. oldcursor = SetCursor(inov)             'Retain the previous cursor value.
  93.  
  94. DO                                      'The main loop!
  95.  
  96.      IF spos < LEN(s$) THEN             'Trim trailing spaces beyond spos
  97.           last = spos
  98.           FOR x = (spos + 1) TO LEN(s$)
  99.                IF MID$(s$, x, 1) <> sp$ THEN last = x
  100.           NEXT x
  101.           s$ = LEFT$(s$, last)
  102.      END IF
  103.  
  104.      IF parm(9) THEN COLOR parm(FGS), parm(BGS)   'Use selected color?
  105.      LOCATE row, col                              'Show the string.
  106.      PRINT PadR$(s$, maxlen);
  107.      LOCATE row, col + spos - 1                   'Position the cursor.
  108.      IF parm(9) THEN COLOR parm(FGN), parm(BGN)   'Reset colors if changed.
  109.  
  110.      k$ = GetKey$(parm())               'Get keyboard input:
  111.  
  112.      a = ASC(LEFT$(k$, 1))
  113.      SELECT CASE a
  114.           CASE 13                                      'Enter - finished
  115.                EXIT DO
  116.           CASE 27                                      'ESC - abort
  117.                s$ = k$        'Return CHR$(27)
  118.                EXIT DO
  119.           CASE 8                                       'Backspace
  120.                IF spos > 1 THEN
  121.                     spos = spos - 1
  122.                     s$ = Stuff$(s$, spos, 1, "")
  123.                END IF
  124.           CASE 32 TO 126                               'Normal typing
  125.                IF parm(10) THEN GOSUB CheckInput
  126.                IF LEN(k$) THEN                              'Was it allowed?
  127.                     IF inov = SCOVR THEN
  128.                          s$ = Stuff$(s$, spos, 1, k$)
  129.                          spos = spos + 1
  130.                     ELSEIF LEN(s$) < maxlen THEN
  131.                          s$ = Stuff$(s$, spos, 0, k$)
  132.                          spos = spos + 1
  133.                     ELSEIF LEN(s$) = maxlen AND RIGHT$(s$, 1) = " " THEN
  134.                          MID$(s$, spos, 1) = k$
  135.                     END IF
  136.                END IF
  137.           CASE 0
  138.                SELECT CASE ASC(RIGHT$(k$, 1))
  139.                     CASE 45                            'Alt-X - delete to end
  140.                          IF spos > 1 THEN              '        of line
  141.                               s$ = LEFT$(s$, spos - 1)
  142.                          ELSE
  143.                               s$ = sp$
  144.                          END IF
  145.                     CASE 71                            'Home
  146.                          spos = 1
  147.                     CASE 75                            'Left Arrow
  148.                          spos = spos - 1
  149.                     CASE 77                            'Right Arrow
  150.                          spos = spos + 1
  151.                     CASE 79                            'End
  152.                          spos = LEN(s$)
  153.                          IF spos < maxlen AND RIGHT$(s$, 1) <> sp$ THEN
  154.                               s$ = s$ + sp$
  155.                               spos = spos + 1
  156.                          END IF
  157.                     CASE 82                            'Insert - toggle mode
  158.                          IF inov = SCINS THEN
  159.                               inov = SCOVR
  160.                          ELSE
  161.                               inov = SCINS
  162.                          END IF
  163.                          x = SetCursor(inov)
  164.                     CASE 83                            'Delete
  165.                          IF spos < LEN(s$) THEN
  166.                               s$ = Stuff$(s$, spos, 1, "")
  167.                          ELSE
  168.                               MID$(s$, spos, 1) = sp$
  169.                          END IF
  170.                     CASE ELSE
  171.                          'Ignore it
  172.                END SELECT
  173.           CASE ELSE
  174.                'Ignore it
  175.      END SELECT
  176.  
  177.      IF spos < 1 THEN spos = 1
  178.      x = LEN(s$)
  179.      IF spos = x + 1 AND spos <= maxlen THEN
  180.           IF RIGHT$(s$, 1) <> sp$ OR parm(10) = EDANY OR (parm(10) AND EDSPACE) > 0 THEN
  181.                s$ = s$ + sp$
  182.                x = x + 1           'Allow them to move past the end if there
  183.           END IF                   'is room for it & spaces are allowed.
  184.      END IF                        'Always allow at least one to the right.
  185.      IF spos > x THEN spos = x
  186.      IF spos > maxlen THEN spos = maxlen
  187.  
  188. LOOP
  189.  
  190. x = SetCursor(oldcursor)                'Restore cursor to previous value.
  191. EdStr$ = RTRIM$(s$)                     'Trim any trailing spaces.
  192.  
  193. EXIT FUNCTION                           'Avoid the RETURN WITHOUT GOSUB!!!
  194.  
  195.  
  196. CheckInput:
  197.  
  198.      IF (parm(10) AND EDUPPER) THEN k$ = UCASE$(k$)    'If EDUPPER only, no
  199.      IF parm(10) = EDUPPER THEN RETURN                 'other restrictions.
  200.  
  201.      SELECT CASE a
  202.           CASE 32                                           'space
  203.                IF (parm(10) AND EDSPACE) = 0 THEN k$ = ""
  204.           CASE 45, 46                                       '- or .
  205.                IF (parm(10) AND EDDEC) = 0 THEN k$ = ""
  206.           CASE 48 TO 57                                     '0-9
  207.                IF (parm(10) AND EDNUM) = 0 THEN k$ = ""
  208.           CASE 65 TO 90, 97 TO 122                          'A-Z or a-z
  209.                IF (parm(10) AND EDALPHA) = 0 THEN k$ = ""
  210.           CASE ELSE
  211.                k$ = ""
  212.      END SELECT
  213.  
  214.      RETURN
  215.  
  216.  
  217. END FUNCTION
  218.  
  219.