home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / ARQS_ZIP / CADEDIT2.ZIP / CANEDIT.BAS next >
Encoding:
BASIC Source File  |  1992-01-04  |  14.4 KB  |  289 lines
  1. 'CANEDIT is an input editor for QuickBASIC
  2. 'It is loosely based on a program from the magazine PC RESOURCES, October 1987, pg. 61
  3. 'This version was written by:   Bert Christensen
  4. '                               Rosewood Software
  5. '                               135-10 Livonia Place
  6. '                               Scarborough, Ontario, Canada M1E 4W6
  7. '                               (416) 284-6119, CompuServe 70461,2507
  8. '                               USENET: bert.christensen@canrem.uucp
  9. '                               I also monitor the RIME QuickBasic conference
  10. '
  11. '                               Copyright 1991
  12. '
  13. 'Anyone is granted full permission to use all or part of this program without charge.
  14. '
  15. 'Some parts of this program may look ancient with its IF..ENDs and GOTOs.
  16. 'However, I like to have the ability to cascade through the editor. See
  17. 'how scan% = 8 becomes scan% = 83 in the backspace command area. The program
  18. 'could be written using only DO..LOOP, SELECT CASE etc. but I doubt that it
  19. 'would make the program work better. It would be prettier though.
  20. '
  21. 'Any comments would be appreciated.
  22. '
  23. DECLARE SUB fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  24. COMMON SHARED /colours/ sfg%, sbg%, rfg%, rbg%
  25. sfg% = 0        'standard foreground
  26. sbg% = 7        'standard background
  27. rfg% = 7        'reverse foreground
  28. rbg% = 1
  29. LOCATE 1, 1     'goto top left so whole screen will be "coloured"
  30. COLOR sfg%, sbg%
  31. CLS
  32. COLOR rfg%, rbg%
  33. ' place prompts on the screen
  34. LOCATE 1, 20: PRINT "`CANEDIT' Input Editor for QuickBASIC"
  35. COLOR sfg%, sbg%
  36. LOCATE 3, 5: PRINT "This field accepts 0 to 9 & space only"; : LOCATE 5, 5: PRINT "This field accepts all alphanumeric entries";
  37. LOCATE 7, 5: PRINT "This field accepts `0' to `9',`-', `.' and `space' only"; : LOCATE 9, 5: PRINT "The Esc key is disabled in this field";
  38. LOCATE 11, 5: PRINT "Edit pre-existing data"; : LOCATE 13, 5: PRINT "Field length of 1"; :   LOCATE 15, 5: PRINT "Field length of 55";
  39. LOCATE 17, 27: PRINT "Fields can be placed anywhere on screen"
  40. LOCATE 19, 1: PRINT STRING$(80, "*");
  41. LOCATE 20, 5: PRINT "Use arrow keys, home, end, PgUp, PgDn, Del, Bksp, Ins to edit";
  42. LOCATE 22, 5: PRINT "Ctrl F3 to delete line; Ctrl F4 to copy text; Ctrl F5 to paste";
  43. LOCATE 24, 5: PRINT "Ctrl End & Ctrl Home to move to ends of field; Ctrl F10 to quit editing";
  44. entryload$ = "Bert Christensen, Rosewood Software"      'see item$(5) below
  45. numentry% = 8   'number of input items. can be 1 to ?? 
  46. REDIM item$(numentry%), itemlen%(numentry%), inperr%(numentry%), row%(numentry%), column%(numentry%), itemflag%(numentry%)
  47. 'item$() = the input item. if there is data to be edited, see below at item$(5).
  48. 'if there is no data to be edited then item$() = " ".
  49. 'itemlen%() = the length of the item$().
  50. 'inperr%() is a flag to manipulate data in the sub, Fulledit
  51. 'column%() is the horizontal column position to start the editing of the particular item$()
  52. 'row%() is the vertical row to start editing the item$()
  53. 'itemflag%() is like inperr%() above (in case you should need 2)
  54. 'below is the filling of the arrray
  55.         item$(1) = " ": itemlen%(1) = 5: inperr%(1) = 0: column%(1) = 44: row%(1) = 3: itemflag%(1) = 1
  56.         item$(2) = " ": itemlen%(2) = 25: inperr%(2) = 0: column%(2) = 50: row%(2) = 5: itemflag%(2) = 0
  57.         item$(3) = " ": itemlen%(3) = 10: inperr%(3) = 0: column%(3) = 64: row%(3) = 7: itemflag%(3) = 2
  58.         item$(4) = " ": itemlen%(4) = 6: inperr%(4) = 1: column%(4) = 45: row%(4) = 9: itemflag%(4) = 0      'inperr% = 1
  59.         item$(5) = entryload$: itemlen%(5) = 40: inperr%(5) = 0: column%(5) = 30: row%(5) = 11: itemflag%(5) = 0
  60.         item$(6) = " ": itemlen%(6) = 1: inperr%(6) = 0: column%(6) = 25: row%(6) = 13: itemflag%(6) = 0
  61.         item$(7) = " ": itemlen%(7) = 55: inperr%(7) = 0: column%(7) = 24: row%(7) = 15: itemflag%(7) = 0
  62.         item$(8) = " ": itemlen%(8) = 20: inperr%(8) = 0: column%(8) = 5: row%(8) = 17: itemflag%(8) = 0
  63. CALL fulledit(row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  64. CLS
  65. ' print out the results of the inputs
  66. LOCATE 5, 2: PRINT "item$(1) = "; item$(1);
  67. LOCATE 6, 2: PRINT "item$(2) = "; item$(2);
  68. LOCATE 7, 2: PRINT "item$(3) = "; item$(3);
  69. LOCATE 8, 2: PRINT "item$(4) = "; item$(4);
  70. LOCATE 9, 2: PRINT "item$(5) = "; item$(5);
  71. LOCATE 10, 2: PRINT "item$(6) = "; item$(6);
  72. LOCATE 11, 2: PRINT "item$(7) = "; item$(7);
  73. LOCATE 12, 2: PRINT "item$(8) = "; item$(8);
  74. LOCATE 25, 3: PRINT "Press any key to continue....";
  75. pause$ = INPUT$(1)
  76. COLOR sfg%, sbg%
  77. END
  78.  
  79. SUB fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%()) STATIC
  80. 'there are some Wordstar type commands "scan% = 19 is Ctrl S". I hate Wordstar so I never completed all the commands.
  81. LOCATE , , 0
  82. insertkey% = 0     'make typeover the default
  83. sc1% = 6           'cursor size for default typeover
  84. sc2% = 7
  85.         FOR menuitem% = 1 TO numentry%                  'make sure that existing entries have proper length
  86.                 IF LEN(item$(menuitem%)) < itemlen%(menuitem%) THEN
  87.                         item$(menuitem%) = item$(menuitem%) + STRING$((itemlen%(menuitem%) - LEN(item$(menuitem))), " ") 'pad with spaces
  88.                 ELSEIF LEN(item$(menuitem%)) > itemlen%(menuitem%) THEN
  89.                         item$(menuitem%) = LEFT$(item$(menuitem%), itemlen%(menuitem%))  'truncate if necessary
  90.                 END IF
  91.         NEXT menuitem%
  92.         itemnum% = 1    'start a first input entry
  93.         FOR entry% = 1 TO numentry%                         'enter default data and/or spaces in proper places
  94.                 colm% = column%(entry%)
  95.                 FOR leng% = 1 TO itemlen%(entry%)
  96.                         COLOR rfg%, rbg%
  97.                         LOCATE row%(entry%), colm%
  98.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  99.                         PRINT defaultstr$;
  100.                         colm% = colm% + 1
  101.                 NEXT leng%
  102.         NEXT entry%
  103.         printcolumn% = column%(itemnum%)     'start at leftmost column
  104. ed1:    COLOR rfg%, rbg%: LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%                   'Place the cursor
  105.  
  106. ed2:    keypress$ = "": keypress$ = INKEY$: IF keypress$ = "" THEN GOTO ed2     'wait for keypress
  107.         scan% = ASC(keypress$)     'change keypress to integer
  108. ed4:
  109.         IF scan% = 27 THEN                'Esc
  110.                 IF inperr%(itemnum%) = 1 THEN  ' to prevent user from escaping from sub
  111.                         BEEP
  112.                 ELSE
  113.                         EXIT SUB
  114.                 END IF
  115.         END IF
  116.  
  117.         IF scan% > 31 AND scan% < 127 THEN           'Alphanum chars only
  118.                 DO
  119.                         SELECT CASE itemflag%(itemnum%)       'determine which set of characters are acceptable
  120.                                 CASE 0          'any alpha numeric
  121.                                 CASE 1          ' 0 to 9 and space
  122.                                         SELECT CASE scan%
  123.                                                 CASE 32, 48 TO 57   ' nothing to do. Let if "fall through" the SELECT CASE
  124.                                                 CASE ELSE
  125.                                                         BEEP
  126.                                                         GOTO ed2
  127.                                         END SELECT
  128.                                 CASE 2         '0 to 9, -,., space
  129.                                         SELECT CASE scan%
  130.                                                 CASE 32, 45, 46, 48 TO 57
  131.                                                 CASE ELSE
  132.                                                         BEEP
  133.                                                         GOTO ed2
  134.                                         END SELECT
  135.                         END SELECT
  136.  
  137.                 IF insertkey% = 0 THEN                     'typeover
  138.                         MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, 1) = keypress$
  139.                         PRINT keypress$;
  140.  
  141.                 ELSE
  142.                         item$(itemnum%) = LEFT$(LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + CHR$(scan%) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, column%(itemnum%)), itemlen%(itemnum%))           'insert
  143.                         'PLEASE!!! someone simplify the above line because I as the programmer cannot understand it, but it works!
  144.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  145.                         item$(itemnum%) = LEFT$(item$(itemnum%), itemlen%(itemnum%))
  146.                         PRINT item$(itemnum%);
  147.                 END IF
  148.                 scan% = 77                                   'move right 1 space
  149.                 EXIT DO
  150.                 LOOP
  151.         END IF
  152.  
  153.         IF scan% = 0 THEN scan% = ASC(RIGHT$(keypress$, 1))             'Extended character
  154.  
  155.         IF scan% = 8 AND printcolumn% > column%(itemnum%) THEN          'Back Space
  156.                 printcolumn% = printcolumn% - 1
  157.                 LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%
  158.                 scan% = 83
  159.         END IF
  160.                                 ' scan% = 4 is the Wordstar Ctrl D
  161.         IF (scan% = 77 OR scan% = 4) AND printcolumn% < column%(itemnum%) - 1 + itemlen%(itemnum%) THEN     'Right arrow
  162.                 printcolumn% = printcolumn% + 1
  163.                 GOTO ed1
  164.         END IF
  165.                                  '19 = Ctrl S
  166.         IF (scan% = 75 OR scan% = 19) AND printcolumn% > column%(itemnum%) THEN          'Left arrow
  167.                 printcolumn% = printcolumn% - 1
  168.                 GOTO ed1
  169.         END IF
  170.  
  171.         IF scan% = 79 THEN                                  'end for    End of text
  172.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  173.                         printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  174.                 ELSE
  175.                         printcolumn% = column%(itemnum%) + LEN(RTRIM$(item$(itemnum%)))
  176.                         IF printcolumn% > column%(itemnum%) + itemlen%(itemnum%) - 1 THEN printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  177.                 END IF
  178.         GOTO ed1
  179.         END IF
  180.  
  181.         IF scan% = 117 THEN                                   'ctrl +  end to go to end of line
  182.                 printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  183.                 GOTO ed1
  184.         END IF
  185.  
  186.         IF scan% = 71 THEN                                  ' Home to beginning of text
  187.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  188.                         printcolumn% = column%(itemnum%)
  189.                 ELSE
  190.                         printcolumn% = column%(itemnum%) + ((itemlen%(itemnum%)) - (LEN(LTRIM$(item$(itemnum%)))))
  191.                         IF printcolumn% < column%(itemnum%) THEN printcolumn% = column%(itemnum%)
  192.                 END IF
  193.                 GOTO ed1
  194.         END IF
  195.  
  196.         IF scan% = 119 THEN                             'ctrl + home to start of line
  197.                 printcolumn% = column%(itemnum%)
  198.                 GOTO ed1
  199.         END IF
  200.  
  201.         IF (scan% = 80 OR scan% = 24) OR (scan% = 13 AND itemnum% <> numentry%) THEN  'Down Arrow  or Enter for next field
  202.  
  203.                 itemnum% = itemnum% + 1
  204.                         IF itemnum% > numentry% THEN itemnum% = numentry%
  205.                                 printcolumn% = column%(itemnum%)
  206.                                 GOTO ed1
  207.                         END IF
  208.       
  209.  
  210.         IF scan% = 81 THEN                             ' pgdn to last line
  211.                 itemnum% = numentry%
  212.                 printcolumn% = column%(itemnum%)
  213.                 GOTO ed1
  214.         END IF
  215.  
  216.         IF scan% = 72 OR scan% = 5 THEN                      'Up Arrow
  217.                 itemnum% = itemnum% - 1
  218.                 IF itemnum% < 1 THEN itemnum% = 1
  219.                 printcolumn% = column%(itemnum%)
  220.                 GOTO ed1
  221.         END IF
  222.  
  223.         IF scan% = 73 THEN                                 'pgup to top line
  224.                 itemnum% = 1
  225.                 printcolumn% = column%(itemnum%)
  226.                 GOTO ed1
  227.         END IF
  228.  
  229.         IF scan% = 83 THEN                                  'Delete
  230.                 item$(itemnum%) = LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 2, itemlen%(itemnum%) - printcolumn% + column%(itemnum%) - 1) + " "
  231.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  232.                 PRINT item$(itemnum%);
  233.                 GOTO ed1
  234.         END IF
  235.  
  236.  
  237.         IF scan% = 96 THEN                                  ' control f3 to delete line
  238.                 item$(itemnum%) = SPACE$(itemlen%(itemnum%))
  239.                 printcolumn% = column%(itemnum%)
  240.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  241.                 PRINT item$(itemnum%);
  242.                 GOTO ed1
  243.         END IF
  244.  
  245.         IF scan% = 97 THEN                           'Ctrl F4 to copy
  246.                 cutline$ = item$(itemnum%)
  247.                 GOTO ed1
  248.         END IF
  249.  
  250.         IF scan% = 98 THEN                                   'Ctrl F5 to paste
  251.                 item$(itemnum%) = cutline$
  252.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  253.                 PRINT LEFT$(item$(itemnum%), itemlen%(itemnum%));
  254.                 GOTO ed1
  255.         END IF
  256.  
  257.         IF scan% = 82 THEN                                     'insert toggle
  258.                 IF insertkey% = 0 THEN
  259.                         insertkey% = 1
  260.                         sc1% = 4       'change to 1/2 block cursor
  261.                         sc2% = 7
  262.                 ELSE
  263.                         insertkey% = 0
  264.                         sc1% = 6
  265.                         sc2% = 7
  266.                 END IF
  267.                 GOTO ed1
  268.          END IF
  269.  
  270.          IF scan% = 103 THEN         'ctrl f10 to exit
  271.                 scan% = 13
  272.          END IF
  273.       
  274. ed3:
  275.         IF scan% <> 13 THEN GOTO ed1
  276.  
  277.         FOR entry% = 1 TO numentry%                   'get rid of any ascii 0's
  278.         tempstring$ = ""
  279.                 FOR leng% = 1 TO LEN(item$(entry%))
  280.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  281.                         IF ASC(defaultstr$) = 0 THEN defaultstr$ = " "
  282.                         tempstring$ = tempstring$ + defaultstr$
  283.                 NEXT leng%
  284.         item$(entry%) = RTRIM$(tempstring$)
  285.         NEXT entry%
  286. LOCATE , , 0       'turn off cursor
  287. END SUB
  288.  
  289.