home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / bassub / fldedit.bas < prev    next >
Encoding:
BASIC Source File  |  1987-09-29  |  4.9 KB  |  209 lines

  1.  
  2. '  FldEdit()
  3. '  Field Editor for taking keyboard input from a specific
  4. '  screen location of maximum length. Returns one string (FTemp$)
  5. '  and one integer value (FRKey%).
  6. '  Display this code with a TAB stop of 3 spaces for best result.
  7.  
  8.     SUB FldEdit(FRow%, FCol%, FLength%, FFore%, FBack%, FRKey%, FTemp$) STATIC
  9.  
  10. '  Set boolean values
  11.         CONST True = -1
  12.         CONST False = 0
  13.  
  14. '  Set color, ephasize field, insert string, and set cursor
  15.         FSet% = FCol% - 1
  16.         COLOR FFore%, FBack%
  17.         LOCATE FRow%, FCol%, 0
  18.         PRINT FTemp$; SPACE$(FLength% - LEN(FTemp$));
  19.         LOCATE FRow%, FCol%, 1
  20.  
  21. '  Initialize return key code, stop
  22.         FRKey% = 0
  23.         FStop% = False
  24.  
  25. '  Set Editor Output string to new Input string
  26.         FOut$ = FTemp$
  27.  
  28. '  Start Parsing
  29.         DO UNTIL FStop%
  30.  
  31. '  Sound alarm if called for
  32.             IF Alarm% THEN
  33.                 SOUND 1000, 1
  34.                 SOUND 1500, 2
  35.                 SOUND 500, 1
  36.                 Alarm% = False
  37.             END IF
  38.  
  39. '  Get a key to parse
  40.             FIn$ = ""
  41.             DO
  42.             FIn$ = INKEY$
  43.             LOOP WHILE FIn$ = ""
  44.  
  45. '  Start by parsing length of key string
  46.             SELECT CASE LEN(FIn$)
  47.  
  48. '  Check for extended key, strip leading zero
  49.                 CASE 2
  50.                 FIn$ = RIGHT$(FIn$, 1)
  51.  
  52. '  Use ASCII value to select
  53.                     SELECT CASE ASC(FIn$)
  54.  
  55. '  Cursor Right
  56.                         CASE 77
  57.                             IF POS(0) < FSet% + (LEN(FOut$) + 1) THEN
  58.                                 LOCATE , POS(0) + 1
  59.                             ELSE
  60.                                 Alarm% = True
  61.                             END IF
  62.  
  63. '  Cursor Left
  64.                         CASE 75
  65.                             IF POS(0) > FSet% + 1 THEN
  66.                                 LOCATE , POS(0) - 1
  67.                             ELSE
  68.                                 Alarm% = True
  69.                             END IF
  70.  
  71. '  Delete
  72.                         CASE 83
  73.                             IF POS(0) - FSet% <= LEN(FOut$) THEN
  74.                                 Shift$ = MID$(FOut$, (POS(0) - FSet%) + 1)
  75.                                 FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 1))_
  76.                                           + Shift$
  77.                                 FTempPos% = POS(0)
  78.                                 LOCATE , , 0
  79.                                 PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
  80.                                 LOCATE , FTempPos%, 1
  81.                             ELSE
  82.                                 Alarm% = True
  83.                             END IF
  84.  
  85. '  Insert
  86.                         CASE 82
  87.                             IF FInsert% = False THEN
  88.                                 FInsert% = True
  89.                                 LOCATE , , , 0, 7
  90.                             ELSEIF FInsert% = True THEN
  91.                                 FInsert% = False
  92.                                 LOCATE , , , 7, 7
  93.                             END IF
  94.  
  95. '  Up, Down, PgUp, PgDn, Home, End
  96.                         CASE 71, 72, 73, 79, 80, 81
  97.                             FRKey% = ASC(FIn$)
  98.                             FStop% = True
  99.  
  100. '  Any other key is illegal so set alarm and loop
  101.                         CASE ELSE
  102.                             Alarm% = True
  103.  
  104.                     END SELECT
  105.  
  106. '  Check for non-extended keys
  107.                 CASE 1
  108.  
  109. '  Use ASCII value to select
  110.                     SELECT CASE ASC(FIn$)
  111.  
  112. '  Backspace
  113.                         CASE 8
  114.                             IF POS(0) - FSet% > 1 THEN
  115.                                 IF POS(0) - FSet% > LEN(FOut$) THEN
  116.                                     FOut$ = LEFT$(FOut$, LEN(FOut$) - 1)
  117.                                     FTempPos% = POS(0)
  118.                                     LOCATE , POS(0) - 1, 0
  119.                                     PRINT CHR$(32);
  120.                                     LOCATE , FTempPos% - 1, 1
  121.                                 ELSEIF POS(0) - FSet% <= LEN(FOut$) THEN
  122.                                     Shift$ = MID$(FOut$, POS(0) - FSet%)
  123.                                     FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 2))_
  124.                                               + Shift$
  125.                                     FTempPos% = POS(0)
  126.                                     LOCATE , POS(0) - 1, 0
  127.                                     PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
  128.                                     LOCATE , FTempPos% - 1, 1
  129.                                 END IF
  130.                             ELSE
  131.                                 Alarm% = True
  132.                             END IF
  133.  
  134. '  Carriage Return
  135.                         CASE 13
  136.                             FStop% = True
  137.  
  138. '  Tab, Escape
  139.                         CASE 9, 27
  140.                             FRKey% = ASC(FIn$)
  141.                             FStop% = True
  142.  
  143. '  Check for additional uprintable input
  144.                         CASE IS < 32, IS > 125
  145.                             Alarm% = True
  146.  
  147. '  Found printable key
  148.                         CASE 32 TO 125
  149.  
  150. '  If not past end of maximum length take input.
  151.                             IF POS(0) <= FSet% + FLength% THEN
  152.  
  153. '  If position is less than current string length then check for insert
  154. '  mode on and overwrite character if insert off or insert character if on.
  155.                                 IF POS(0) - FSet% <= LEN(FOut$) THEN
  156.  
  157. '  Insert mode off?
  158.                                     IF FInsert% = False THEN
  159.                                         MID$(FOut$, POS(0) - FSet%, 1) = FIn$
  160.                                         PRINT FIn$;
  161.  
  162. '  Insert mode on?
  163.                                     ELSEIF FInsert% = True THEN
  164.  
  165. '  Check length of string plus input and take input if less than max lenth.
  166.                                         IF LEN(FOut$) < FLength% THEN
  167.                                             Shift$ = MID$(FOut$, POS(0) - FSet%)
  168.                                             FOut$ = LEFT$(FOut$, (POS(0) - FSet%) - 1)_
  169.                                                       + FIn$ + Shift$
  170.                                             FTempPos% = POS(0)
  171.                                             LOCATE , , 0
  172.                                             PRINT MID$(FOut$, POS(0) - FSet%);
  173.                                             LOCATE , FTempPos% + 1, 1
  174.  
  175. '  If string plus input too long sound alarm and return.
  176.                                         ELSE
  177.                                             Alarm% = True
  178.                                         END IF
  179.                                     END IF
  180.  
  181. '  If string position greater than current string length then add character.
  182.                                 ELSEIF POS(0) - FSet% > LEN(FOut$) THEN
  183.                                     FOut$ = FOut$ + FIn$
  184.                                     PRINT FIn$;
  185.                                 END IF
  186.  
  187. '  Cursor past end of field so input is illegal
  188.                             ELSE
  189.                                 Alarm% = True
  190.                             END IF
  191.  
  192. '  Any other key is illegal so set alarm and loop
  193.                         CASE ELSE
  194.                             Alarm% = True
  195.  
  196.                     END SELECT
  197.  
  198.             END SELECT
  199.  
  200.         LOOP
  201.  
  202. '  Exit, reset cursor, reset insert mode, assign passed variable
  203.         LOCATE , , 0, 7, 7
  204.         FInsert% = False
  205.         FTemp$ = FOut$
  206.  
  207.     END SUB
  208.  
  209.