home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 01 / tricks / readstr.bas < prev    next >
Encoding:
BASIC Source File  |  1990-10-18  |  5.2 KB  |  156 lines
  1. '* ---------- Anfang READSTR.BAS ------------------------- *
  2. DECLARE FUNCTION ReadStr$ (ES$, EL%, UpL%, L$, i%, S%, Lin%)
  3. '* ------------------------------------------------------- *
  4. '*                       READSTR.BAS                       *
  5. '*         Komfortable Inputeingabe für Quickbasic         *
  6. '*              (c) 1990 Kay Glahn & TOOLBOX               *
  7. '* ------------------------------------------------------- *
  8. FUNCTION ReadStr$ (ES$, EL%, UpL%, L$, i%, S%, Lin%)
  9. '* ES$  = Vorgabestring
  10. '* EL%  = maximale Länge des Strings
  11. '* UpL% = -1 => alles in Kleinbuchstaben
  12. '*      =  0 => Schreibweise belassen
  13. '*      =  1 => alles in Großbuchstaben
  14. '* L$   =  String mit abzulehnenden Zeichen oder
  15. '*         mit Zeichen die angenommen werden
  16. '* i%   =  0 => Zeichen in L$ werden abgelehnt
  17. '*         1 => Zeichen in L$ werden angenommen
  18. '* S%   =  0 => Sound aus
  19. '*         1 => Sound ein
  20. '* Lin% =  liefert den Wert 27 für <ESC> als letzte Taste
  21. '*         oder 13 für <RET> zurück
  22.   y% = CSRLIN: x% = POS(0)
  23.   Entr$ = LEFT$(ES$, EL%): EL% = EL% - 1
  24.   LOCATE y%, x%, 0: PRINT SPACE$(EL% + 1);
  25.   LOCATE y%, x%, 1, 6, 7: PRINT Entr$;
  26.   Curp% = LEN(Entr$): Insmode% = 1: Ready% = 0
  27.   DO
  28.     DO
  29.       Ch$ = INKEY$
  30.     LOOP UNTIL Ch$ <> ""
  31.     SELECT CASE UpL%
  32.       CASE IS = -1
  33.         Ch$ = LCASE$(Ch$)
  34.       CASE IS = 1
  35.         Ch$ = UCASE$(Ch$)
  36.     END SELECT
  37.     IF LEN(Ch$) = 2 THEN
  38.       Chh$ = RIGHT$(Ch$, 1): Ch$ = CHR$(0)
  39.       Chh$ = UCASE$(Chh$)
  40.     END IF
  41.     SELECT CASE Ch$
  42.       CASE IS = CHR$(13)
  43.         Lin% = 13: Ready% = 1
  44.       CASE IS = CHR$(27)
  45.         Lin% = 27: Ready% = 1
  46.       CASE IS = CHR$(8)
  47.         IF Curp% > 0 THEN
  48.           Inter$ = Entr$
  49.           FOR C% = Curp% TO LEN(Entr$) - 1
  50.             MID$(Inter$, C%, 1) = MID$(Entr$, C% + 1, 1)
  51.           NEXT C%
  52.           Entr$ = LEFT$(Inter$, LEN(Inter$) - 1)
  53.           Curp% = Curp% - 1
  54.           LOCATE y%, x%, 0: PRINT Entr$; " ";
  55.           LOCATE y%, x% + Curp%, 1
  56.         END IF
  57.       CASE IS = CHR$(127)
  58.         Curp% = 0: Entr$ = "": LOCATE y%, x%
  59.         PRINT SPACE$(EL% + 1); : LOCATE y%, x%
  60.       CASE IS = CHR$(0)
  61.         SELECT CASE Chh$
  62.           CASE IS = "R"
  63.             IF Insmode% THEN
  64.               Insmode% = 0: LOCATE , , 1, 0, 17
  65.             ELSE
  66.               Insmode% = 1: LOCATE , , 1, 6, 7
  67.             END IF
  68.           CASE IS = "G"
  69.             Curp% = 0: LOCATE y%, x%, 1
  70.             PRINT Entr$; " "; : LOCATE y%, x%, 1
  71.           CASE IS = "O"
  72.             Curp% = LEN(Entr$): LOCATE y%, x%, 1
  73.             PRINT Entr$; : LOCATE y%, x% + Curp%, 1
  74.           CASE IS = "S"
  75.             IF Curp% >= 0 AND Curp% <> LEN(Entr$) THEN
  76.               FOR C% = Curp% + 1 TO LEN(Entr$) - 1
  77.                 MID$(Entr$, C%, 1) = MID$(Entr$, C% + 1, 1)
  78.               NEXT C%
  79.               Entr$ = LEFT$(Entr$, LEN(Entr$) - 1)
  80.               LOCATE y%, x%, 1: PRINT Entr$; " ";
  81.               LOCATE y%, x% + Curp%
  82.             END IF
  83.           CASE IS = "K"
  84.             IF Curp% <> 0 THEN
  85.               Curp% = Curp% - 1
  86.               LOCATE y%, x% + Curp%
  87.             END IF
  88.           CASE IS = "M"
  89.             IF Curp% <> LEN(Entr$) THEN
  90.               Curp% = Curp% + 1
  91.               LOCATE y%, x% + Curp%
  92.             END IF
  93.           CASE ELSE
  94.             IF S% = 1 THEN SOUND 600, .5
  95.         END SELECT
  96.       CASE ELSE
  97.         IF INSTR(1, L$, Ch$) = 0 THEN
  98.           IF i% = 0 THEN
  99.             Show% = 1
  100.           ELSE
  101.             Show% = 0
  102.           END IF
  103.         ELSE
  104.           IF i% = 0 THEN
  105.             Show% = 0
  106.           ELSE
  107.             Show% = 1
  108.           END IF
  109.         END IF
  110.         IF Show% = 1 THEN
  111.           IF LEN(Entr$) <= EL% THEN
  112.             IF Curp% >= LEN(Entr$) THEN
  113.               Entr$ = Entr$ + Ch$
  114.               Curp% = Curp% + 1: PRINT Ch$;
  115.             ELSE
  116.               IF Insmode% THEN
  117.                 S1$ = LEFT$(Entr$, Curp%)
  118.                 S2$ = RIGHT$(Entr$, LEN(Entr$) - Curp%)
  119.                 Entr$ = S1$ + Ch$ + S2$
  120.                 LOCATE y%, x%, 1, 6, 7: PRINT Entr$; " ";
  121.                 Curp% = Curp% + 1
  122.                 LOCATE y%, Curp% + x%, 1
  123.               ELSE
  124.                 PRINT Ch$;
  125.                 Curp% = Curp% + 1
  126.                 MID$(Entr$, Curp%, 1) = Ch$
  127.               END IF
  128.             END IF
  129.           ELSE
  130.             IF Curp% <= EL% THEN
  131.               IF Insmode% THEN
  132.                 S1$ = LEFT$(Entr$, Curp%)
  133.                 S2$ = RIGHT$(Entr$, LEN(Entr$) - LEN(S1$))
  134.                 Entr$ = S1$ + Ch$ + S2$
  135.                 Entr$ = LEFT$(Entr$, LEN(Entr$) - 1)
  136.                 Curp% = Curp% + 1
  137.                 LOCATE y%, x%, 1, 6, 7
  138.                 PRINT Entr$; " ";
  139.                 LOCATE y%, Curp% + x%, 1
  140.               ELSE
  141.                 PRINT Ch$;
  142.                 Curp% = Curp% + 1
  143.                 MID$(Entr$, Curp%, 1) = Ch$
  144.               END IF
  145.             END IF
  146.           END IF
  147.         ELSE
  148.           IF S% = 1 THEN SOUND 600, .5
  149.         END IF
  150.     END SELECT
  151.   LOOP UNTIL Ready%
  152.   ReadStr$ = Entr$: LOCATE , , 0
  153. END FUNCTION
  154. '* ------------------------------------------------------- *
  155. '*                 Ende von READSTR.BAS                    *
  156.