home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 10_11 / eingabe.inc < prev    next >
Encoding:
Text File  |  1988-06-26  |  4.5 KB  |  121 lines
  1. DEF FNEingabe$ (feldlen%, spos%, zpos%, vartyp$)
  2.  
  3. ' * ---------------------------------------------------------------------- *
  4. ' *                           EINGABE.INC                                  *
  5. ' *            Erweiterte Input-Routine für den Basic-INPUT                *
  6. ' *                 (c) 1988 by K.E.Rauch und TOOLBOX                      *
  7. ' * ---------------------------------------------------------------------- *
  8.  
  9. LOCAL sammel$                        'sammelt die geprüften Zeichen
  10. LOCAL taste$                         'für das letzte eingegeben Zeichen
  11. LOCAL dezimal%                       'Schalter für Dezimalpunkt
  12. LOCAL muell$                         'Dummy zum Löschen des Tastaturpuffers
  13. LOCAL punkte%                        'zum Aufbau des Eingabefeldes
  14. LOCAL punkte$
  15.  
  16. taste$ = CHR$(1)                     'Einstieg in die Hauptschleife
  17.  
  18. ' * ---------- Überprüfen der Parameter auf Plausibilität ---------------- *
  19.  
  20. IF zpos%    <   1  OR  zpos%    > 25           THEN CALL Fehler
  21. IF spos%    <   1  OR  spos%    > 80           THEN CALL Fehler
  22. IF feldlen% <   1  OR  feldlen% > (79 - spos%) THEN CALL Fehler
  23. IF vartyp$  <> "t" AND vartyp$  <> "w"         THEN CALL Fehler
  24.  
  25. ' * ------------------ Aufbau des Eingabefeldes -------------------------- *
  26.  
  27. LOCATE zpos%, spos%
  28. PRINT CHR$(242);                             'Zeichen für den Prompt "≥"
  29. PRINT STRING$(feldlen%,"_");
  30.  
  31. ' * ---------------------- Hauptschleife --------------------------------- *
  32.  
  33. WHILE taste$ <> CHR$(13)                     'Verlassen mit < RETURN >
  34.   taste$ = ""
  35.   WHILE taste$ = ""
  36.     taste$ = INKEY$                          'Warte und hole erstes Zeichen
  37.   WEND
  38.   muell$ = INKEY$
  39.   IF muell$ = "" THEN  GOSUB Abfrage         'Tastaturpuffer ist leer
  40.  
  41.   WHILE muell$ <> ""
  42.     muell$ = INKEY$                          'Löschen Tastaturpuffer
  43.   WEND
  44. WEND
  45. FNEingabe$ = sammel$                         'Ergebnis bereitstellen
  46. GOTO Feierabend                              'Unterprogramme werden
  47.                                              'übersprungen
  48. ' * ---------------------------------------------------------------------- *
  49. Abfrage:
  50.   DO
  51.     IF ASC(taste$) = 27 OR  ASC(taste$) = 13 THEN EXIT LOOP
  52.     IF ASC(taste$) < 13 AND ASC(taste$) <> 8 THEN EXIT LOOP
  53.     IF ASC(taste$) =  8 AND sammel$ = ""     THEN EXIT LOOP
  54.     IF ASC(taste$) =  8 AND RIGHT$(sammel$,1) = "." THEN  dezimal% = 0
  55.  
  56.     IF ASC(taste$) = 8 THEN
  57.       GOSUB Backspace
  58.       GOTO Update
  59.     END IF
  60.  
  61.     IF LEN(sammel$) = feldlen% THEN EXIT LOOP
  62.  
  63.     WHILE vartyp$ = "w"                      'nur für Zahlen-Modus
  64.  
  65.       IF taste$ = "," THEN taste$ = "."      'Komma -> Dezimalpunkt
  66.  
  67.       IF dezimal% = 0 AND ASC(taste$) = 46 THEN
  68.         dezimal% = 1                         'Dezimalflag setzen, wenn
  69.         EXIT LOOP                            'noch nicht gesetzt
  70.       END IF
  71.  
  72.       IF dezimal% = 1 AND ASC(taste$) = 46 THEN
  73.         taste$ = ""
  74.         EXIT LOOP
  75.       END IF
  76.  
  77.       IF taste$ = "-" AND sammel$ = "" THEN EXIT LOOP
  78.                                              'erstes zeichen "-"
  79.  
  80.       IF ASC(taste$) > 47 AND ASC(taste$) < 58 THEN EXIT LOOP
  81.                                              'nur Ziffern zulassen
  82.  
  83.       taste$ = ""                            'Falsche Eingabe, ignorieren
  84.       EXIT LOOP
  85.     WEND
  86.  
  87.     sammel$ = sammel$ + taste$               'Anfügen des gültigen Zeichens
  88. Update:
  89.     taste$ = ""
  90.     punkte% = feldlen% - LEN(sammel$)        'Update des Eingabefeldes...
  91.     IF punkte% <= 0 THEN                     '...am Feldende
  92.       punkte$ = ""
  93.     ELSE
  94.       punkte$ = STRING$(punkte%-1,"_")
  95.     END IF
  96.     LOCATE zpos%, spos%
  97.     PRINT sammel$;                           '...bisherige Eingabe
  98.     PRINT CHR$(242);                         '...Prompt "≥"
  99.     PRINT punkte$; " ";                      '...Unterstriche
  100.   LOOP UNTIL 1=1                             'Bedingung für Endlosschleife
  101. RETURN
  102.  
  103. ' * ---------------------------------------------------------------------- *
  104. Backspace:
  105.   sammel$ = LEFT$(sammel$, LEN(sammel$) - 1)
  106. RETURN
  107.  
  108. ' * ---------------------------------------------------------------------- *
  109. Feierabend:
  110.   END DEF
  111.  
  112. ' * ---------------------------------------------------------------------- *
  113. SUB FEHLER
  114.   LOCATE 25,2
  115.   BEEP:BEEP:BEEP
  116.   PRINT "Fehlerhafte Parameterübergabe, Programmabbruch"
  117.   END
  118. END SUB
  119.  
  120. ' * ---------------------------------------------------------------------- *
  121. ' *                       Ende von EINGABE.INC                             *