home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / keyboard / fldedit / fldedit2.bas
Encoding:
BASIC Source File  |  1989-02-14  |  7.2 KB  |  279 lines
  1.  
  2. '  FldEdit()
  3. '  by Wayne Robinson, Under the Sun Software
  4. '  Data (201) 666-0519, The Covered Bridge, Phoenix 807/10
  5. '
  6. '  Field Editor for taking keyboard input from a specific
  7. '  screen location of maximum length. Returns one string (FTemp$)
  8. '  and one integer value (FRKey%).
  9. '  Display this code with a TAB stop of 3 spaces for best result.
  10. '  Version 2.0, 3/2/88
  11. '
  12. '  In order to trap function keys the variable FRKey% must be initialized
  13. '  with a non-zero value for the call. This will enable the page, cursor,
  14. '  function keys, and others to be trapped. If FRKey% is 0 coming into
  15. '  FldEdit then only Escape and Carriage Return are trapped. In order to
  16. '  parse for the occurance of one of these keys I suggest a test of FRKey%
  17. '  at the return from FldEdit via a select case such as this one. FldEdit
  18. '  will strip the leading 0's from extended keys and return only the second
  19. '  value in FRKey%
  20. '
  21. '     SELECT CASE FRKey%
  22. '        CASE 13  'CR note FldEdit v1.0 returned 0
  23. '        CASE 27  'ESC
  24. '        CASE 9   'TAB
  25. '        CASE 59  'F1
  26. '        CASE 60  'F2
  27. '        .
  28. '        .
  29. '        .
  30. '        .
  31. '        CASE 71  'HOME
  32. '        CASE 79  'END
  33. '        CASE ELSE
  34. '     END SELECT
  35. '
  36. '  The keys trapped with FRKey% are:
  37. '           F1 - F10             0, 59 to 0, 68
  38. '           Carriage Return      13
  39. '           Escape               27
  40. '           Tab                  9
  41. '           Home                 0, 71
  42. '           End                  0, 79
  43. '           PgUp                 0, 73
  44. '           PgDn                 0, 81
  45. '           Cursor Up            0, 72
  46. '           Cursor Down          0, 80
  47. '
  48. '  Parameters:
  49. '  FRow% = ROW of first character of field
  50. '  FCol% = Column of first character of field
  51. '  FLength% = maximum length of field
  52. '  FFore% = foreground color of text in field
  53. '  FBack% = background color of text in field
  54. '  FRKey% if 0 in then function keys are not parsed
  55. '         if > 0 in then function keys are parsed and value returned
  56. '  FTemp$ = String to edit. If not "" then this string will be placed
  57. '           in the field by FldEdit with the correct attribute.
  58. '           The edited string is returned in this variable.
  59.  
  60.     SUB FldEdit (FRow%, FCol%, FLength%, FFore%, FBack%, FRKey%, FTemp$) STATIC
  61.  
  62. '  Set boolean values
  63.         CONST TRUE = -1
  64.         CONST FALSE = 0
  65.  
  66. '  Set color, ephasize field, insert string, and set cursor
  67.         FSet% = FCol% - 1
  68.         COLOR FFore%, FBack%
  69.         LOCATE FRow%, FCol%, 0
  70.         PRINT FTemp$; SPACE$(FLength% - LEN(FTemp$));
  71.         LOCATE FRow%, FCol%, 1
  72.  
  73. '  Check FRKey% and set page key functions
  74.         IF FRKey% THEN
  75.             PageSet% = TRUE
  76.         ELSE
  77.             PageSet% = FALSE
  78.         END IF
  79.  
  80. '  Initialize return key code, stop, reset insert mode
  81.         FRKey% = FALSE
  82.         FStop% = FALSE
  83.         FInsert% = FALSE
  84.  
  85. '  Set Editor Output string to new Input string
  86.         FOut$ = FTemp$
  87.  
  88. '  Start Parsing
  89.         DO UNTIL FStop%
  90.  
  91. '  Sound alarm if called for
  92.             IF Alarm% THEN
  93.                 SOUND 1000, 1
  94.                 SOUND 1500, 2
  95.                 SOUND 500, 1
  96.                 Alarm% = FALSE
  97.             END IF
  98.  
  99. '  Get a key to parse
  100.             FIn$ = ""
  101.             DO
  102.             FIn$ = INKEY$
  103.             LOOP WHILE FIn$ = ""
  104.  
  105. '  Start by parsing length of key string
  106.             SELECT CASE LEN(FIn$)
  107.  
  108. '  Check for extended key, strip leading zero
  109.                 CASE 2
  110.                 FIn$ = RIGHT$(FIn$, 1)
  111.  
  112. '  Use ASCII value to select
  113.                     SELECT CASE ASC(FIn$)
  114.  
  115. '  Cursor Right
  116.                         CASE 77
  117.                             IF POS(0) < FSet% + (LEN(FOut$) + 1) THEN
  118.                                 LOCATE , POS(0) + 1
  119.                             ELSE
  120.                                 Alarm% = TRUE
  121.                             END IF
  122.  
  123. '  Cursor Left
  124.                         CASE 75
  125.                             IF POS(0) > FSet% + 1 THEN
  126.                                 LOCATE , POS(0) - 1
  127.                             ELSE
  128.                                 Alarm% = TRUE
  129.                             END IF
  130.  
  131. '  Delete
  132.                         CASE 83
  133.                             IF POS(0) - FSet% <= LEN(FOut$) THEN
  134.                                 Shift$ = MID$(FOut$, (POS(0) - FSet%) + 1)
  135.                                 FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 1)) + Shift$
  136.                                 FTempPos% = POS(0)
  137.                                 LOCATE , , 0
  138.                                 PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
  139.                                 LOCATE , FTempPos%, 1
  140.                             ELSE
  141.                                 Alarm% = TRUE
  142.                             END IF
  143.  
  144. '  Insert
  145.                         CASE 82
  146.                             IF FInsert% = FALSE THEN
  147.                                 FInsert% = TRUE
  148.                                 LOCATE , , , 0, 7
  149.                             ELSEIF FInsert% = TRUE THEN
  150.                                 FInsert% = FALSE
  151.                                 LOCATE , , , 7, 7
  152.                             END IF
  153.  
  154. '  Up, Down, PgUp, PgDn, Home, End
  155.                         CASE 59 to 68, 71, 72, 73, 79, 80, 81
  156.                             IF PageSet% THEN
  157.                                 FRKey% = ASC(FIn$)
  158.                                 FStop% = TRUE
  159.                             ELSE
  160.                                 Alarm% = TRUE
  161.                             END IF
  162.  
  163. '  Any other key is illegal so set alarm and loop
  164.                         CASE ELSE
  165.                             Alarm% = TRUE
  166.  
  167.                     END SELECT
  168.  
  169. '  Check for non-extended keys
  170.                 CASE 1
  171.  
  172. '  Use ASCII value to select
  173.                     SELECT CASE ASC(FIn$)
  174.  
  175. '  Backspace
  176.                         CASE 8
  177.                             IF POS(0) - FSet% > 1 THEN
  178.                                 IF POS(0) - FSet% > LEN(FOut$) THEN
  179.                                     FOut$ = LEFT$(FOut$, LEN(FOut$) - 1)
  180.                                     FTempPos% = POS(0)
  181.                                     LOCATE , POS(0) - 1, 0
  182.                                     PRINT CHR$(32);
  183.                                     LOCATE , FTempPos% - 1, 1
  184.                                 ELSEIF POS(0) - FSet% <= LEN(FOut$) THEN
  185.                                     Shift$ = MID$(FOut$, POS(0) - FSet%)
  186.                                     FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 2)) + Shift$
  187.                                     FTempPos% = POS(0)
  188.                                     LOCATE , POS(0) - 1, 0
  189.                                     PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
  190.                                     LOCATE , FTempPos% - 1, 1
  191.                                 END IF
  192.                             ELSE
  193.                                 Alarm% = TRUE
  194.                             END IF
  195.  
  196. '  Tab
  197.                         CASE 9
  198.                             IF PageSet% THEN
  199.                                 FRKey% = ASC(FIn$)
  200.                                 FStop% = TRUE
  201.                             ELSE
  202.                                 Alarm% = TRUE
  203.                             END IF
  204.  
  205. '  Carriage Return
  206.                         CASE 13
  207.                             FRKey% = ASC(FIn$)
  208.                             FStop% = TRUE
  209.  
  210. '  Escape
  211.                         CASE 27
  212.                             FRKey% = ASC(FIn$)
  213.                             FStop% = TRUE
  214.  
  215. '  Check for additional uprintable input
  216.                         CASE IS < 32, IS > 125
  217.                             Alarm% = TRUE
  218.  
  219. '  Found printable key
  220.                         CASE 32 TO 125
  221.  
  222. '  If not past end of maximum length take input.
  223.                             IF POS(0) <= FSet% + FLength% THEN
  224.  
  225. '  If position is less than current string length then check for insert
  226. '  mode on and overwrite character if insert off or insert character if on.
  227.                                 IF POS(0) - FSet% <= LEN(FOut$) THEN
  228.  
  229. '  Insert mode off?
  230.                                     IF FInsert% = FALSE THEN
  231.                                         MID$(FOut$, POS(0) - FSet%, 1) = FIn$
  232.                                         PRINT FIn$;
  233.  
  234. '  Insert mode on?
  235.                                     ELSEIF FInsert% = TRUE THEN
  236.  
  237. '  Check length of string plus input and take input if less than max lenth.
  238.                                         IF LEN(FOut$) < FLength% THEN
  239.                                             Shift$ = MID$(FOut$, POS(0) - FSet%)
  240.                                             FOut$ = LEFT$(FOut$, (POS(0) - FSet%) - 1) + FIn$ + Shift$
  241.                                             FTempPos% = POS(0)
  242.                                             LOCATE , , 0
  243.                                             PRINT MID$(FOut$, POS(0) - FSet%);
  244.                                             LOCATE , FTempPos% + 1, 1
  245.  
  246. '  If string plus input too long sound alarm and return.
  247.                                         ELSE
  248.                                             Alarm% = TRUE
  249.                                         END IF
  250.                                     END IF
  251.  
  252. '  If string position greater than current string length then add character.
  253.                                 ELSEIF POS(0) - FSet% > LEN(FOut$) THEN
  254.                                     FOut$ = FOut$ + FIn$
  255.                                     PRINT FIn$;
  256.                                 END IF
  257.  
  258. '  Cursor past end of field so input is illegal
  259.                             ELSE
  260.                                 Alarm% = TRUE
  261.                             END IF
  262.  
  263. '  Any other key is illegal so set alarm and loop
  264.                         CASE ELSE
  265.                             Alarm% = TRUE
  266.  
  267.                     END SELECT
  268.  
  269.             END SELECT
  270.  
  271.         LOOP
  272.  
  273. '  Exit, reset cursor, assign passed variable
  274.         LOCATE , , 0, 7, 7
  275.         FTemp$ = FOut$
  276.  
  277.     END SUB
  278.  
  279.