home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / keyboard / canedit / canedit.bas next >
Encoding:
BASIC Source File  |  1991-12-29  |  12.5 KB  |  267 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. DECLARE SUB fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  23. COMMON SHARED /colours/ sfg%, sbg%, rfg%, rbg%
  24. sfg% = 0
  25. sbg% = 7
  26. rfg% = 7
  27. rbg% = 0
  28. LOCATE 1, 1
  29. COLOR sfg%, sbg%
  30. CLS
  31. COLOR rfg%, rbg%
  32. LOCATE 1, 20: PRINT "`CANEDIT' Input Editor for QuickBASIC"
  33. COLOR sfg%, sbg%
  34. LOCATE 3, 5: PRINT "This field accepts 0 to 9 only"; : LOCATE 5, 5: PRINT "This field accepts all alphanumeric entries";
  35. 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";
  36. LOCATE 11, 5: PRINT "Edit pre-existing data"; : LOCATE 13, 5: PRINT "Field length of 1"; :   LOCATE 15, 5: PRINT "Field length of 55";
  37. LOCATE 17, 27: PRINT "Fields can be placed anywhere on screen"
  38. LOCATE 19, 1: PRINT STRING$(80, "*");
  39. LOCATE 20, 5: PRINT "Use arrow keys, home, end, PgUp, PgDn, Del, Bksp, Ins to edit";
  40. LOCATE 22, 5: PRINT "Ctrl F3 to delete line; Ctrl F4 to copy text; Ctrl F5 to paste";
  41. LOCATE 24, 5: PRINT "Ctrl End & Ctrl Home to move to ends of field; Ctrl F10 to quit editing";
  42. entryload$ = "Bert Christensen, Rosewood Software"
  43. numentry% = 8
  44. REDIM item$(numentry%), itemlen%(numentry%), inperr%(numentry%), row%(numentry%), column%(numentry%), itemflag%(numentry%)
  45.         item$(1) = " ": itemlen%(1) = 5: inperr%(1) = 0: column%(1) = 38: row%(1) = 3: itemflag%(1) = 1
  46.         item$(2) = " ": itemlen%(2) = 25: inperr%(2) = 0: column%(2) = 50: row%(2) = 5: itemflag%(2) = 0
  47.         item$(3) = " ": itemlen%(3) = 10: inperr%(3) = 0: column%(3) = 64: row%(3) = 7: itemflag%(3) = 2
  48.         item$(4) = " ": itemlen%(4) = 6: inperr%(4) = 1: column%(4) = 45: row%(4) = 9: itemflag%(4) = 0      'inperr% = 1
  49.         item$(5) = entryload$: itemlen%(5) = 40: inperr%(5) = 0: column%(5) = 30: row%(5) = 11: itemflag%(5) = 0
  50.         item$(6) = " ": itemlen%(6) = 1: inperr%(6) = 0: column%(6) = 25: row%(6) = 13: itemflag%(6) = 0
  51.         item$(7) = " ": itemlen%(7) = 55: inperr%(7) = 0: column%(7) = 24: row%(7) = 15: itemflag%(7) = 0
  52.         item$(8) = " ": itemlen%(8) = 20: inperr%(8) = 0: column%(8) = 5: row%(8) = 17: itemflag%(8) = 0
  53. CALL fulledit(row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  54. LOCATE 25, 3: PRINT "Press any key to continue....";
  55. pause$ = INPUT$(1)
  56. COLOR sfg%, sbg%
  57. END
  58.  
  59. SUB fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%()) STATIC
  60. LOCATE , , 0
  61. insertkey% = 0
  62. sc1% = 6           'cursor size for default typeover
  63. sc2% = 7
  64.         FOR menuitem% = 1 TO numentry%                  'make sure that existing entries have proper length
  65.                 IF LEN(item$(menuitem%)) < itemlen%(menuitem%) THEN
  66.                         item$(menuitem%) = item$(menuitem%) + STRING$((itemlen%(menuitem%) - LEN(item$(menuitem))), " ")
  67.                 ELSEIF LEN(item$(menuitem%)) > itemlen%(menuitem%) THEN
  68.                         item$(menuitem%) = LEFT$(item$(menuitem%), itemlen%(menuitem%))
  69.                 END IF
  70.         NEXT menuitem%
  71.         itemnum% = 1
  72.         FOR entry% = 1 TO numentry%                         'enter default data and/or spaces in proper places
  73.                 colm% = column%(entry%)
  74.                 FOR leng% = 1 TO itemlen%(entry%)
  75.                         COLOR rfg%, rbg%
  76.                         LOCATE row%(entry%), colm%
  77.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  78.                         PRINT defaultstr$;
  79.                         colm% = colm% + 1
  80.                 NEXT leng%
  81.         NEXT entry%
  82.         printcolumn% = column%(itemnum%)
  83. ed1:    COLOR rfg%, rbg%: LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%                   'Place the cursor
  84.  
  85. ed2:    keypress$ = "": keypress$ = INKEY$: IF keypress$ = "" THEN GOTO ed2
  86.         scan% = ASC(keypress$)
  87. ed4:
  88.         IF scan% = 27 THEN
  89.                 IF inperr%(itemnum%) = 1 THEN  ' to prevent user from escaping from sub
  90.                         BEEP
  91.                 ELSE
  92.                         EXIT SUB
  93.                 END IF
  94.         END IF
  95.  
  96.         IF scan% > 31 AND scan% < 127 THEN           'Alphanum chars only
  97.                 DO
  98.                         SELECT CASE itemflag%(itemnum%)
  99.                                 CASE 0          'any alpha numeric
  100.                                 CASE 1          '0 to 9 only
  101.                                         SELECT CASE scan%
  102.                                                 CASE 32, 48 TO 57
  103.                                                 CASE ELSE
  104.                                                         BEEP
  105.                                                         EXIT DO
  106.                                         END SELECT
  107.                                 CASE 2         '0 to 9, -,., space
  108.                                         SELECT CASE scan%
  109.                                                 CASE 32, 45, 46, 48 TO 57
  110.                                                 CASE ELSE
  111.                                                         BEEP
  112.                                                         EXIT DO
  113.                                         END SELECT
  114.                         END SELECT
  115.  
  116.                 IF insertkey% = 0 THEN                     'typeover
  117.                         MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, 1) = keypress$
  118.                         PRINT keypress$;
  119.  
  120.                 ELSE
  121.                         item$(itemnum%) = LEFT$(LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + CHR$(scan%) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, column%(itemnum%)), itemlen%(itemnum%))           'insert
  122.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  123.                         item$(itemnum%) = LEFT$(item$(itemnum%), itemlen%(itemnum%))
  124.                         PRINT item$(itemnum%);
  125.                 END IF
  126.                 scan% = 77                                   'move right 1 space
  127.                 EXIT DO
  128.                 LOOP
  129.         END IF
  130.  
  131.         IF scan% = 0 THEN scan% = ASC(RIGHT$(keypress$, 1))             'Extended character
  132.  
  133.         IF scan% = 8 AND printcolumn% > column%(itemnum%) THEN          'Back Space
  134.                 printcolumn% = printcolumn% - 1
  135.                 LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%
  136.                 scan% = 83
  137.         END IF
  138.  
  139.         IF (scan% = 77 OR scan% = 4) AND printcolumn% < column%(itemnum%) - 1 + itemlen%(itemnum%) THEN     'Right arrow
  140.                 printcolumn% = printcolumn% + 1
  141.                 GOTO ed1
  142.         END IF
  143.  
  144.         IF (scan% = 75 OR scan% = 19) AND printcolumn% > column%(itemnum%) THEN          'Left arrow
  145.                 printcolumn% = printcolumn% - 1
  146.                 GOTO ed1
  147.         END IF
  148.  
  149.         IF scan% = 79 THEN                                  'end for    End of text
  150.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  151.                         printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  152.                 ELSE
  153.                         printcolumn% = column%(itemnum%) + LEN(RTRIM$(item$(itemnum%)))
  154.                         IF printcolumn% > column%(itemnum%) + itemlen%(itemnum%) - 1 THEN printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  155.                 END IF
  156.         GOTO ed1
  157.         END IF
  158.  
  159.         IF scan% = 117 THEN                                   'ctrl +  end to go to end of line
  160.                 printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  161.                 GOTO ed1
  162.         END IF
  163.  
  164.         IF scan% = 71 THEN                                  ' Home to beginning of text
  165.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  166.                         printcolumn% = column%(itemnum%)
  167.                 ELSE
  168.                         printcolumn% = column%(itemnum%) + ((itemlen%(itemnum%)) - (LEN(LTRIM$(item$(itemnum%)))))
  169.                         IF printcolumn% < column%(itemnum%) THEN printcolumn% = column%(itemnum%)
  170.                 END IF
  171.                 GOTO ed1
  172.         END IF
  173.  
  174.         IF scan% = 119 THEN                             'ctrl + home to start of line
  175.                 printcolumn% = column%(itemnum%)
  176.                 GOTO ed1
  177.         END IF
  178.  
  179.         IF (scan% = 80 OR scan% = 24) OR (scan% = 13 AND itemnum% <> numentry%) THEN  'Down Arrow  or Enter for next field
  180.  
  181.                 itemnum% = itemnum% + 1
  182.                         IF itemnum% > numentry% THEN itemnum% = numentry%
  183.                                 printcolumn% = column%(itemnum%)
  184.                                 GOTO ed1
  185.                         END IF
  186.       
  187.  
  188.         IF scan% = 81 THEN                             ' pgdn to last line
  189.                 itemnum% = numentry%
  190.                 printcolumn% = column%(itemnum%)
  191.                 GOTO ed1
  192.         END IF
  193.  
  194.         IF scan% = 72 OR scan% = 5 THEN                      'Up Arrow
  195.                 itemnum% = itemnum% - 1
  196.                 IF itemnum% < 1 THEN itemnum% = 1
  197.                 printcolumn% = column%(itemnum%)
  198.                 GOTO ed1
  199.         END IF
  200.  
  201.         IF scan% = 73 THEN                                 'pgup to top line
  202.                 itemnum% = 1
  203.                 printcolumn% = column%(itemnum%)
  204.                 GOTO ed1
  205.         END IF
  206.  
  207.         IF scan% = 83 THEN                                  'Delete
  208.                 item$(itemnum%) = LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 2, itemlen%(itemnum%) - printcolumn% + column%(itemnum%) - 1) + " "
  209.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  210.                 PRINT item$(itemnum%);
  211.                 GOTO ed1
  212.         END IF
  213.  
  214.  
  215.         IF scan% = 96 THEN                                  ' control f3 to delete line
  216.                 item$(itemnum%) = SPACE$(itemlen%(itemnum%))
  217.                 printcolumn% = column%(itemnum%)
  218.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  219.                 PRINT item$(itemnum%);
  220.                 GOTO ed1
  221.         END IF
  222.  
  223.         IF scan% = 97 THEN                           'Ctrl F4 to cut
  224.                 cutline$ = item$(itemnum%)
  225.                 GOTO ed1
  226.         END IF
  227.  
  228.         IF scan% = 98 THEN                                   'Ctrl F5 to paste
  229.                 item$(itemnum%) = cutline$
  230.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  231.                 PRINT LEFT$(item$(itemnum%), itemlen%(itemnum%));
  232.                 GOTO ed1
  233.         END IF
  234.  
  235.         IF scan% = 82 THEN                                     'insert toggle
  236.                 IF insertkey% = 0 THEN
  237.                         insertkey% = 1
  238.                         sc1% = 0       'change to block cursor
  239.                         sc2% = 7
  240.                 ELSE
  241.                         insertkey% = 0
  242.                         sc1% = 6
  243.                         sc2% = 7
  244.                 END IF
  245.                 GOTO ed1
  246.          END IF
  247.  
  248.          IF scan% = 103 THEN         'ctrl f10 to exit
  249.                 scan% = 13
  250.          END IF
  251.       
  252. ed3:
  253.         IF scan% <> 13 THEN GOTO ed1
  254.  
  255.         FOR entry% = 1 TO numentry%                   'get rid of any ascii 0's
  256.         tempstring$ = ""
  257.                 FOR leng% = 1 TO LEN(item$(entry%))
  258.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  259.                         IF ASC(defaultstr$) = 0 THEN defaultstr$ = " "
  260.                         tempstring$ = tempstring$ + defaultstr$
  261.                 NEXT leng%
  262.         item$(entry%) = RTRIM$(tempstring$)
  263.         NEXT entry%
  264. LOCATE , , 0
  265. END SUB
  266.  
  267.