home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1988
/
10_11
/
eingabe.inc
< prev
next >
Wrap
Text File
|
1988-06-26
|
5KB
|
121 lines
DEF FNEingabe$ (feldlen%, spos%, zpos%, vartyp$)
' * ---------------------------------------------------------------------- *
' * EINGABE.INC *
' * Erweiterte Input-Routine für den Basic-INPUT *
' * (c) 1988 by K.E.Rauch und TOOLBOX *
' * ---------------------------------------------------------------------- *
LOCAL sammel$ 'sammelt die geprüften Zeichen
LOCAL taste$ 'für das letzte eingegeben Zeichen
LOCAL dezimal% 'Schalter für Dezimalpunkt
LOCAL muell$ 'Dummy zum Löschen des Tastaturpuffers
LOCAL punkte% 'zum Aufbau des Eingabefeldes
LOCAL punkte$
taste$ = CHR$(1) 'Einstieg in die Hauptschleife
' * ---------- Überprüfen der Parameter auf Plausibilität ---------------- *
IF zpos% < 1 OR zpos% > 25 THEN CALL Fehler
IF spos% < 1 OR spos% > 80 THEN CALL Fehler
IF feldlen% < 1 OR feldlen% > (79 - spos%) THEN CALL Fehler
IF vartyp$ <> "t" AND vartyp$ <> "w" THEN CALL Fehler
' * ------------------ Aufbau des Eingabefeldes -------------------------- *
LOCATE zpos%, spos%
PRINT CHR$(242); 'Zeichen für den Prompt "≥"
PRINT STRING$(feldlen%,"_");
' * ---------------------- Hauptschleife --------------------------------- *
WHILE taste$ <> CHR$(13) 'Verlassen mit < RETURN >
taste$ = ""
WHILE taste$ = ""
taste$ = INKEY$ 'Warte und hole erstes Zeichen
WEND
muell$ = INKEY$
IF muell$ = "" THEN GOSUB Abfrage 'Tastaturpuffer ist leer
WHILE muell$ <> ""
muell$ = INKEY$ 'Löschen Tastaturpuffer
WEND
WEND
FNEingabe$ = sammel$ 'Ergebnis bereitstellen
GOTO Feierabend 'Unterprogramme werden
'übersprungen
' * ---------------------------------------------------------------------- *
Abfrage:
DO
IF ASC(taste$) = 27 OR ASC(taste$) = 13 THEN EXIT LOOP
IF ASC(taste$) < 13 AND ASC(taste$) <> 8 THEN EXIT LOOP
IF ASC(taste$) = 8 AND sammel$ = "" THEN EXIT LOOP
IF ASC(taste$) = 8 AND RIGHT$(sammel$,1) = "." THEN dezimal% = 0
IF ASC(taste$) = 8 THEN
GOSUB Backspace
GOTO Update
END IF
IF LEN(sammel$) = feldlen% THEN EXIT LOOP
WHILE vartyp$ = "w" 'nur für Zahlen-Modus
IF taste$ = "," THEN taste$ = "." 'Komma -> Dezimalpunkt
IF dezimal% = 0 AND ASC(taste$) = 46 THEN
dezimal% = 1 'Dezimalflag setzen, wenn
EXIT LOOP 'noch nicht gesetzt
END IF
IF dezimal% = 1 AND ASC(taste$) = 46 THEN
taste$ = ""
EXIT LOOP
END IF
IF taste$ = "-" AND sammel$ = "" THEN EXIT LOOP
'erstes zeichen "-"
IF ASC(taste$) > 47 AND ASC(taste$) < 58 THEN EXIT LOOP
'nur Ziffern zulassen
taste$ = "" 'Falsche Eingabe, ignorieren
EXIT LOOP
WEND
sammel$ = sammel$ + taste$ 'Anfügen des gültigen Zeichens
Update:
taste$ = ""
punkte% = feldlen% - LEN(sammel$) 'Update des Eingabefeldes...
IF punkte% <= 0 THEN '...am Feldende
punkte$ = ""
ELSE
punkte$ = STRING$(punkte%-1,"_")
END IF
LOCATE zpos%, spos%
PRINT sammel$; '...bisherige Eingabe
PRINT CHR$(242); '...Prompt "≥"
PRINT punkte$; " "; '...Unterstriche
LOOP UNTIL 1=1 'Bedingung für Endlosschleife
RETURN
' * ---------------------------------------------------------------------- *
Backspace:
sammel$ = LEFT$(sammel$, LEN(sammel$) - 1)
RETURN
' * ---------------------------------------------------------------------- *
Feierabend:
END DEF
' * ---------------------------------------------------------------------- *
SUB FEHLER
LOCATE 25,2
BEEP:BEEP:BEEP
PRINT "Fehlerhafte Parameterübergabe, Programmabbruch"
END
END SUB
' * ---------------------------------------------------------------------- *
' * Ende von EINGABE.INC *