home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 04 / heimwerk / eingabe.inc next >
Encoding:
Text File  |  1989-01-17  |  3.8 KB  |  125 lines
  1.  
  2.  
  3. '(* ------------------------------------------------------ *)
  4. '(*                    EINGABE.INC                         *)
  5. '(*           (c) 1988 TOOLBOX Version 2'89                *)
  6. '(* ------------------------------------------------------ *)
  7.  
  8. SUB Eingabe(feldlen%, spos%, zpos%, vartyp$, antwort$)
  9.  
  10.   LOCAL sammel$       'sammelt die geprüften Zeichen
  11.   LOCAL taste$        'für das letzte eingegebene Zeichen
  12.   LOCAL dezimal%      'Schalter für Dezimalpunkt
  13.   LOCAL muell$        'Dummy zum Löschen des Tastaturpuffers
  14.   LOCAL punkte%       'zum Aufbau des Eingabefeldes
  15.   LOCAL punkte$, schleife%
  16.  
  17.   REM In Quick Basic müssen die LOCAL-Deklarationen
  18.   REM wegfallen, weil die Variablen in einer Prozedur
  19.   REM per Default Lokal sind
  20.  
  21.   taste$ = CHR$(1)            'Einstieg in die Hauptschleife
  22.   IF zpos% < 1 OR zpos% > 25 THEN GOSUB Fehler
  23.   IF spos% < 1 OR spos% > 80 THEN GOSUB Fehler
  24.   IF feldlen% < 1 OR feldlen% > (79 - spos%) THEN
  25.     GOSUB Fehler
  26.   END IF
  27.   IF vartyp$ <> "t" AND vartyp$ <> "w" THEN GOSUB Fehler
  28.  
  29.   LOCATE zpos%, spos%
  30.   PRINT CHR$(242);               'Zeichen für den Prompt "≥"
  31.   PRINT STRING$(feldlen%, "_");
  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  leer
  40.     WHILE muell$ <> ""
  41.       muell$ = INKEY$                'Löschen Tastaturpuffer
  42.     WEND
  43.   WEND
  44.   antwort$ = sammel$                 'Ergebnis bereitstellen
  45.   GOTO Feierabend                    'Unterprogramme werden
  46.                                      'übersprungen
  47.  
  48. REM * ---------------------------------------------------- *
  49. Abfrage:
  50.   DO
  51.     IF ASC(taste$)=27 OR ASC(taste$)=13 THEN GOTO ExitLoop
  52.     IF ASC(taste$)<13 AND ASC(taste$)<>8 THEN GOTO ExitLoop
  53.     IF ASC(taste$) = 8 AND sammel$ = "" THEN GOTO ExitLoop
  54.     IF ASC(taste$) = 8 AND RIGHT$(sammel$, 1) = "." THEN
  55.       dezimal% = 0
  56.     END IF
  57.     IF ASC(taste$) = 8 THEN
  58.       GOSUB Backspace
  59.       GOTO Update
  60.     END IF
  61.  
  62.     IF LEN(sammel$) = feldlen% THEN GOTO ExitLoop
  63.  
  64.     schleife% = -1
  65.     WHILE vartyp$ = "w" AND schleife% = -1
  66.  
  67.       IF taste$ = "," THEN taste$ = "."      'Komma -> Punkt
  68.  
  69.       IF dezimal% = 0 AND ASC(taste$) = 46 THEN
  70.         dezimal% = 1               'Dezimalflag setzen
  71.         GOTO EndWhile
  72.       END IF
  73.  
  74.       IF dezimal% = 1 AND ASC(taste$) = 46 THEN
  75.         taste$ = ""
  76.         GOTO EndWhile
  77.       END IF
  78.  
  79.       IF taste$ = "-" AND sammel$ = "" THEN GOTO EndWhile
  80.                                          'erstes zeichen "-"
  81.  
  82.       IF ASC(taste$) > 47 AND ASC(taste$) < 58 THEN
  83.         GOTO EndWhile
  84.       END IF                          'nur Ziffern zulassen
  85.  
  86.       taste$ = ""               'Falsche Eingabe, ignorieren
  87.       EndWhile:
  88.       schleife% = 0
  89.     WEND
  90.  
  91.     sammel$ = sammel$ + taste$
  92.                               'Anfügen des gültigen Zeichens
  93. Update:
  94.     taste$ = ""
  95.     punkte% = feldlen% - LEN(sammel$)  'Update Eingabefeldes
  96.     IF punkte% <= 0 THEN                     '...am Feldende
  97.       punkte$ = ""
  98.     ELSE
  99.       punkte$ = STRING$(punkte% - 1, "_")
  100.     END IF
  101.     LOCATE zpos%, spos%
  102.     PRINT sammel$;                     '...bisherige Eingabe
  103.     PRINT CHR$(242);                   '...Prompt "≥"
  104.     PRINT punkte$; " ";                '...Unterstriche
  105.   LOOP UNTIL 1 = 1             'Bedingung für Endlosschleife
  106.   ExitLoop:
  107. RETURN
  108.  
  109. REM * ---------------------------------------------------- *
  110. Backspace:
  111.   sammel$ = LEFT$(sammel$, LEN(sammel$) - 1)
  112. RETURN
  113.  
  114. Fehler:
  115.   LOCATE 25, 2
  116.   BEEP: BEEP: BEEP
  117.   PRINT "Fehlerhafte Parameterübergabe, Programmabbruch"
  118.   END
  119. RETURN
  120.  
  121. Feierabend:
  122.   END SUB
  123.  
  124. REM * ---------------------------------------------------- *
  125.