home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / qbnewsl / qbnws302 / linedit / lineedit.bas < prev    next >
BASIC Source File  |  1992-03-21  |  18KB  |  417 lines

  1. DEFINT A-Z
  2. '+==================================================================+
  3. '|                           LINEEDIT.BAS                           |
  4. '|                                                                  |
  5. '|  A line edit routine developed by Larry Stone and the SWOCC      |
  6. '|  students of Larry Stone, CS133B, Fall Term '91, SWOCC.          |
  7. '|                                                                  |
  8. '|  Purpose:  Line editor that can edit a string in a virtual       |
  9. '|            window, VwindowSize%, bigger than the allowable       |
  10. '|            display length, DisplayLen%                           |
  11. '|                                                                  |
  12. '|  Modules:  LINEEDIT                                              |
  13. '|            KEYBOARD                                              |
  14. '|                                                                  |
  15. '|  Call:     LineEdit Row%, Col%, CurPos%, A$, VwindowSize%, _     |
  16. '|                     DisplayLen%, CuroffSet%, Kee%, Separaters$,_ |
  17. '|                     Terminators()                                |
  18. '+------------------------------------------------------------------+
  19. '
  20. '+==================================================================+
  21. '|                           DECLARATIONS                           |
  22. '+------------------------------------------------------------------+
  23. '
  24. DECLARE FUNCTION InsertState% ()
  25. DECLARE FUNCTION KeyPressed% ()
  26. DECLARE FUNCTION Lower% (Value%)
  27. DECLARE SUB RingSound ()
  28. DECLARE FUNCTION Upper% (Value%)
  29.  
  30. CONST False = 0, True = NOT False
  31.  
  32. '+==================================================================+
  33. '|                            SUBPROGRAMS                           |
  34. '+------------------------------------------------------------------+
  35.  
  36. '+======================================================================+
  37. '|                           LIneEdit Subprogram                        |
  38. '|                                                                      |
  39. '|  Developed by: Larry Stone & his students during Fall & Winter term, |
  40. '|                1991-1992, Southwestern Oregon Community College.     |
  41. '|                                                                      |
  42. '|  Purpose:  Line editor that can scroll/edit a virtual window longer  |
  43. '|            than the displayable line.                                |
  44. '|                                                                      |
  45. '|  Input:  Row%            The Row to display the edit string.         |
  46. '|          Col%            The starting column for the edit string.    |
  47. '|          VwindowSize%    The length of optional virtual window.      |
  48. '|                          If VwindowSize is less than DisplayLen then |
  49. '|                          it is automatically sized to DisplayLen.    |
  50. '|          DisplayLen%     The length allowed for string display.      |
  51. '|          Separaters$     String defining word separaters.            |
  52. '|          AutoTerminate%  Boolean statement - If true, terminates     |
  53. '|                          LineEdit when CurPos is at end of field.    |
  54. '|          Terminators%()  Integer Array defining exit key strokes.    |
  55. '|                          Zeroeth element defines last terminator     |
  56. '|                          used.  MUST BE DIMMED IN CALLING PROGRAM!   |
  57. '|                                                                      |
  58. '|          EditMask$       Optional string of symbols that serve to    |
  59. '|                          mask the corresponding character in the     |
  60. '|                          the edit string (A$).                       |
  61. '|                                                                      |
  62. '|              # chr(35)   digits 0-9 and any uppercase character      |
  63. '|              A chr(65)   uppercase only (converts to upper case)     |
  64. '|              9 chr(57)   digits 0-9 only                             |
  65. '|              ? chr(63)   anything at all                             |
  66. '|              8 chr(56)   digits 0-9, uppercase, "/", or space        |
  67. '|              * chr(42)   any alpha, dash, apostraphe or space        |
  68. '|              a chr(97)   lower case alpha only                       |
  69. '|                                                                      |
  70. '|  Input/Output:                                                       |
  71. '|          A$              The string to edit - the edited string.     |
  72. '|          CurPos%         Cursor location within the displayed string |
  73. '|                          (use value as input to re-edit string).     |
  74. '|          CurOffset%      Adjustment factor for left-most character   |
  75. '|                          of the displayed string (use value as input |
  76. '|                          to re-edit string).                         |
  77. '|                                                                      |
  78. '|  Output: Kee%            The exit key user hit to exit this routine. |
  79. '|                                                                      |
  80. '|  Note:   Extended keys, ie., up/down arrow, are returned as negative |
  81. '|          numbers.                                                    |
  82. '|                                                                      |
  83. '|  Edit Functions:                                                     |
  84. '|          Backspace       Deletes character to left of cursor         |
  85. '|          Delete          Deletes character under cursor              |
  86. '|          Ctrl + Home     Deletes from cursor to beginning of line    |
  87. '|          Ctrl + End      Deletes from cursor to end of line          |
  88. '|          Ctrl + Right    Move to word on right (skips separaters)    |
  89. '|          Ctrl + Left     Move to word on left (skips separaters)     |
  90. '|          Home            Move to beginning of string                 |
  91. '|          End             Move to space after last char of string     |
  92. '|          Right           Move cursor one character to right          |
  93. '|          Left            Move cursor one character to left           |
  94. '|                                                                      |
  95. '+----------------------------------------------------------------------+
  96. '
  97. SUB LineEdit (Row%, Col%, CurPos%, A$, VwindowSize%, DisplayLen%, CurOffset%, Kee%, Separaters$, Terminators(), EditMask$, AutoTerminate%)
  98.  
  99.     IF VwindowSize% < DisplayLen% THEN VwindowSize% = DisplayLen%
  100.     IF CurPos = False THEN CurPos = 1       'Set cursor position
  101.     Escan = 7                               'Set End Scan Line
  102.    
  103.     '---- Insert is either On or Off
  104.     InsIsOn% = InsertState%
  105.     
  106.     GOSUB DisplayLine                       'Display the string to edit
  107.     COLOR 14, False                         'Force color change with edits
  108.  
  109.     IF LEN(EditMask$) THEN                  'If we have an edit mask...
  110.         IF LEN(EditMask$) < VwindowSize% THEN  'and it a wee short...
  111.             '---- Pad the edit mask with "?" (anything) symbols
  112.             EditMask$ = EditMask$ + STRING$(VwindowSize% - LEN(EditMask$), 63)
  113.         END IF
  114.     END IF
  115.     
  116.     DO
  117.         DO
  118.             LastIns = InsIsOn               'Save the state of the Ins key
  119.             Kee% = KeyPressed%              'Get a key from keyboard buffer
  120.  
  121.             '---- If Insert is changed then toggle the state of InsIsOn
  122.             IF Kee = -82 THEN Kee = False: InsIsOn = InsIsOn XOR True
  123.             IF LastIns <> InsIsOn THEN GOSUB SetLocation
  124.  
  125.             '---- Loop to the last terminator used.  Is it our keystroke?
  126.             FOR N = 1 TO Terminators(False)
  127.                 IF Terminators(N) = Kee% THEN Terminated = True
  128.             NEXT
  129.         LOOP UNTIL Kee%
  130.         IF Terminated THEN EXIT DO
  131.  
  132.         StrPos = CurPos + CurOffset           'Pointer into the string
  133.         CharOK = True                         'Initialize this to true
  134.         IF LEN(EditMask$) THEN
  135.             '---- If Kee isn't an extended keystroke, backspace or enter...
  136.             IF NOT (Kee% < False OR Kee = 8 OR Kee = 13) THEN
  137.                 MaskChar = ASC(MID$(EditMask$, StrPos, 1))  'Get mask char
  138.                 CharOK = False                              'Assume false
  139.                 IF MaskChar = 35 THEN GOSUB NumAndUpper     '# symbol
  140.                 IF MaskChar = 65 THEN GOSUB MakeUpper       'A symbol
  141.                 IF MaskChar = 57 THEN GOSUB CheckNum        '9 symbol
  142.                 IF MaskChar = 63 THEN CharOK = True         '? symbol
  143.                 IF MaskChar = 56 THEN GOSUB NumAndUpper     '8 symbol
  144.                 IF MaskChar = 42 THEN GOSUB AnyAlpha        '* symbol
  145.                 IF MaskChar = 97 THEN GOSUB MakeLower       'a symbol
  146.             END IF
  147.             IF NOT CharOK THEN RingSound: Kee = False
  148.         END IF
  149.  
  150.         SELECT CASE Kee
  151.             CASE 8                            'Backspace
  152.                 IF StrPos > 1 THEN
  153.                     A$ = LEFT$(A$, StrPos - 2) + MID$(A$, StrPos)
  154.                     GOSUB CursorLeft
  155.                 ELSE
  156.                     RingSound
  157.                 END IF
  158.                 
  159.             CASE 13                           'Enter key
  160.                 EXIT DO
  161.  
  162.             CASE -83                          'Delete
  163.                 IF LEN(A$) = False THEN
  164.                     RingSound
  165.                 ELSE
  166.                     A$ = LEFT$(A$, StrPos - 1) + MID$(A$, StrPos + 1)
  167.                     GOSUB DisplayLine
  168.                 END IF
  169.                 
  170.             CASE -71                          'Home
  171.                 IF CurPos = 1 THEN
  172.                     RingSound
  173.                 ELSE
  174.                     CurPos = 1
  175.                     CurOffset = False
  176.                     GOSUB DisplayLine
  177.                 END IF
  178.  
  179.             CASE -79                          'End
  180.                 IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN RingSound
  181.                 GOSUB LocateEnd
  182.                 
  183.             CASE -77                          'Right arrow
  184.                 GOSUB CursorRight
  185.  
  186.             CASE -75                          'Left arrow
  187.                 GOSUB CursorLeft
  188.            
  189.             CASE -119                         'Ctrl + Home
  190.                 A$ = MID$(A$, StrPos + 1)
  191.                 CurPos = 1: CurOffset = False
  192.                 GOSUB DisplayLine
  193.  
  194.             CASE -115                         'Ctrl + Left arrow
  195.                 IF StrPos = 1 THEN RingSound
  196.                 StepValue = True
  197.                 GOSUB SkipRepeatingSeparaters
  198.                 
  199.             CASE -116                         'Ctrl + Right arrow
  200.                 IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN
  201.                     RingSound
  202.                 ELSE
  203.                     StepValue = 1
  204.                     GOSUB SkipRepeatingSeparaters
  205.                 END IF
  206.                 
  207.             CASE -117                         'Ctrl + End
  208.                 IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN RingSound
  209.                 A$ = LEFT$(A$, StrPos - 1)
  210.                 GOSUB DisplayLine
  211.                 
  212.             CASE ELSE
  213.                 IF Kee > 31 THEN              'Accept if space char or greater
  214.                     IF InsIsOn% THEN
  215.                         '---- Padding left-side of string prevents the cursor
  216.                         '     from backing up if the cursor is on blank space
  217.                         '     beyond the length of the string.
  218.                         IF StrPos > LEN(A$) AND LEN(A$) < VwindowSize% THEN
  219.                             A$ = LEFT$(A$ + STRING$(StrPos - LEN(A$), 32), StrPos - 1) + CHR$(Kee) + MID$(A$, StrPos)
  220.                         ELSE
  221.                             A$ = LEFT$(A$, StrPos - 1) + CHR$(Kee) + MID$(A$, StrPos)
  222.                         END IF
  223.                         IF LEN(A$) > VwindowSize% THEN A$ = LEFT$(A$, VwindowSize%)
  224.                     ELSE
  225.                         '---- Padding string prevents Illegal function error
  226.                         '     with MID$() function.
  227.                         IF StrPos > LEN(A$) AND LEN(A$) < VwindowSize% THEN
  228.                             A$ = A$ + STRING$(StrPos - LEN(A$), 32)
  229.                         END IF
  230.                         MID$(A$, StrPos, 1) = CHR$(Kee%)
  231.                     END IF
  232.                     GOSUB CursorRight
  233.                 ELSEIF Kee THEN
  234.                     RingSound                   'Invalid keystroke
  235.                 END IF
  236.         END SELECT
  237.     LOOP
  238.     A$ = RTRIM$(A$)                             'Trim trailing spaces
  239.    
  240.     '---- Turn off cursor and set it to a two line cursor
  241.     Column = Col: Visible = False: Sscan = 6
  242.     GOSUB DisplayCursor
  243.    
  244.     EXIT SUB                                    'We done, finished, kaput
  245.  
  246. '+==================================================================+
  247. '|                            SUB-ROUTINES                          |
  248. '+------------------------------------------------------------------+
  249.  
  250. LocateEnd:
  251.     CurOffset = LEN(A$) - DisplayLen + 1
  252.     IF CurPos + CurOffset > VwindowSize% THEN CurOffset = CurOffset - 1
  253.     IF CurOffset < False THEN CurPos = LEN(A$) + 1 ELSE CurPos = DisplayLen
  254.     
  255.     '---- If len(A$) = DisplayLen and <End> was hit then keep cursor in window
  256.     IF CurPos + CurOffset > VwindowSize% THEN CurOffset = CurOffset - 1
  257.  
  258.     '---- If string is deleted then prevent Illegal function with DisplayLine
  259.     IF CurOffset < False THEN CurOffset = False
  260.  
  261.     GOSUB DisplayLine
  262. RETURN
  263.  
  264. CursorRight:
  265.     IF CurPos < DisplayLen THEN
  266.         CurPos = CurPos + 1               'Inc cursor pos by 1
  267.     ELSEIF CurOffset + DisplayLen + 10 <= VwindowSize% THEN
  268.         CurOffset = CurOffset + 10
  269.         CurPos = CurPos - 9
  270.     ELSEIF CurOffset + DisplayLen + 1 <= VwindowSize% THEN
  271.         CurPos = DisplayLen - (VwindowSize% - (CurOffset + CurPos)) + 1
  272.         CurOffset = VwindowSize% - DisplayLen
  273.     ELSE
  274.         '---- We must be at the end of the field so, if AutoTerminate is set
  275.         '     then force an exit by emulating a keystroke for a down arrow.
  276.         IF AutoTerminate THEN Kee = -80: EXIT SUB
  277.         RingSound              'AutoTerminate is false so BEEP 'em up Scotty!
  278.     END IF
  279.  
  280.     '---- Keep us from hanging outside of our DisplayLen
  281.     IF CurPos + CurOffset > VwindowSize% THEN CurPos = CurPos - 1
  282.     GOSUB DisplayLine
  283. RETURN
  284.  
  285. CursorLeft:
  286.     IF CurPos > 1 THEN
  287.         CurPos = CurPos - 1
  288.     ELSEIF CurOffset > 9 THEN
  289.         CurOffset = CurOffset - 10
  290.         CurPos = CurPos + 9
  291.     ELSEIF CurOffset > False THEN
  292.         CurPos = CurOffset + CurPos
  293.         CurOffset = False
  294.     ELSE
  295.         RingSound
  296.     END IF
  297.     
  298. DisplayLine:             'Display the string to be edited
  299.     '---- Turn off cursor for clean display
  300.     Column = Col: Visible = False: GOSUB DisplayCursor
  301.     
  302.     '---- Display the string
  303.     PRINT MID$(A$ + STRING$(80, 176), 1 + CurOffset, DisplayLen);
  304.  
  305.     '---- Trim the string
  306.     A$ = RTRIM$(A$)
  307.  
  308. SetLocation:             'Set cursor location
  309.     IF CurPos + Col - 1 > 80 THEN CurPos = CurPos - 1 'Avoid illegal function
  310.     Column = CurPos + Col - 1: Visible = 1
  311.     
  312.     '---- (adjust start scan)
  313.     '     Three line cursor = Insert, full cursor = Overstrike
  314.     IF InsIsOn THEN Sscan = 5 ELSE Sscan = False
  315.  
  316. DisplayCursor:
  317.     LOCATE Row, Column, Visible, Sscan, Escan
  318. RETURN
  319.  
  320. SkipRepeatingSeparaters:
  321.     IF StrPos = 1 AND StepValue < False THEN RETURN
  322.     
  323.     '---- Look from Cursor position to start/end for a separater character
  324.     IF StepValue < False THEN X = 1 ELSE X = LEN(A$)
  325.     FOR N = StrPos TO X STEP StepValue
  326.  
  327.         '---- Look into A$, one character at a time - is it a seperater?
  328.         J = INSTR(Separaters$, MID$(A$, N, 1))
  329.  
  330.         IF J THEN               'Found a separater character
  331.             FoundSeparater = J  'Save J's value
  332.  
  333.             '---- Move our cursor to this separater position
  334.             FOR i = StrPos TO N STEP StepValue
  335.                 IF StepValue < False THEN GOSUB CursorLeft ELSE GOSUB CursorRight
  336.             NEXT
  337.  
  338.             EXIT FOR            'Cursor is on a separater so exit the loop
  339.         END IF
  340.     NEXT
  341.     
  342.     '---- If no separater found then cursor to start or end of string
  343.     IF StepValue < False THEN
  344.         IF J <= False THEN
  345.             CurPos = 1
  346.             CurOffset = False
  347.             GOSUB DisplayLine
  348.         END IF
  349.     ELSE
  350.         IF J = False THEN GOSUB LocateEnd
  351.     END IF
  352.  
  353.     '---- If a separater was found, skip any repeating sequences of it.
  354.     DO WHILE J                      'Loop while Separater has been found
  355.         N = N + StepValue           'Increment or Decrement N
  356.         IF N = False THEN EXIT DO   'Prevent error with MID$() function
  357.  
  358.         '---- Only looking for repeating sequences of FoundSeparater
  359.         J = INSTR(MID$(Separaters$, FoundSeparater, 1), MID$(A$, N, 1))
  360.  
  361.         IF J THEN                   'If we found another seperater
  362.             IF StepValue < False THEN GOSUB CursorLeft ELSE GOSUB CursorRight
  363.         END IF
  364.  
  365.         IF N >= LEN(A$) THEN EXIT DO
  366.     LOOP
  367.     
  368.     '---- Adjust if in virtual window and cursor is beyond the end of string
  369.     IF CurPos + CurOffset >= LEN(A$) + 2 THEN
  370.         CurPos = 1
  371.         CurOffset = False
  372.         GOSUB LocateEnd
  373.     END IF
  374. RETURN
  375.  
  376. NumAndUpper:
  377.     GOSUB CheckNum
  378. MakeUpper:
  379.     IF Kee > 96 AND Kee < 123 THEN
  380.         Kee = Upper(Kee)
  381.         CharOK = True
  382.     ELSEIF Kee > 64 AND Kee < 91 THEN
  383.         CharOK = True
  384.     END IF
  385.     IF MaskChar = 56 THEN GOSUB SlashAndSpace     '8 symbol
  386. RETURN
  387.  
  388. CheckNum:
  389.     IF Kee > 47 AND Kee < 58 THEN CharOK = True
  390. RETURN
  391.  
  392. SlashAndSpace:
  393.     IF Kee = 47 THEN CharOK = True
  394. Spaces:
  395.     IF Kee = 32 THEN CharOK = True
  396. RETURN
  397.  
  398. AnyAlpha:
  399.     IF ((Kee > 64 AND Kee < 91) OR (Kee > 96 AND Kee < 123)) THEN CharOK = True
  400.  
  401.     '---- Apostrophe, dash, dot
  402.     IF (Kee = 39 OR (Kee > 44 AND Kee < 47)) THEN CharOK = True
  403.     GOSUB Spaces
  404. RETURN
  405.  
  406. MakeLower:
  407.     IF Kee > 64 AND Kee < 91 THEN
  408.         Kee = Lower(Kee)
  409.         CharOK = True
  410.     ELSEIF Kee > 96 AND Kee < 123 THEN
  411.         CharOK = True
  412.     END IF
  413. RETURN
  414.  
  415. END SUB
  416.  
  417.