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