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