DECLARE FUNCTION UpCase$ (Char$)
DECLARE FUNCTION XINPUT$ (Format$, Y%, X%, l%, C1%, C2%, Capi%, Vorgabe$)
' ##################################################################
' # XINPUT 1.1                                                     #
' # Erweiterer INPUT-Ersatz                                        #
' # Public-Domain, (c) 1994 by performance                         #
' # ŽNDERUNGEN AN DEN ROUTINEN UpCase$ UND XINPUT$ SIND VERBOTEN!  #
' # WEITERGABE NUR VOLLSTŽNDIG, INKL. DER FOLGENDEN BESCHREIBUNG,  #
' # GESTATTET! DIE BENUTZUNG DIESER ROUTINEN IN EIGENEN PROGRAMMEN #
' # IST ERLAUBT, BITTE WEISEN SIE JEDOCH AUF DEREN VERWENDUNG IN   #
' # DER DOKUMENTATION IHRER SOFTWARE HIN!                          #
' # PERFORMANCE šBERNIMMT KEINERLEI GARANTIE ODER HAFTUNG!         #
' # Und nun viel Spaá mit XINPUT wnscht performance               #
' # (Contact: performance, Fax: 49-6074-29749, BBS: 49-6074-41307) #
' ##################################################################

' Syntax: Function XINPUT$(Format$, Y%, X%, L%, C1%, C2%, Capi%, Vorgabe$)
'         Format$:  Zeichenkette mit allen erlaubten Zeichen,
'                   speziell bei Buchstaben brauchen nur die Groá-
'                   buchstaben angegeben werden. Beispiele in den
'                   Variablen Alpha$ und Numerisch$
'         Y%:       Zeile
'         X%:       Spalte
'         L%:       Max. L„nge der Eingabe
'         C1%:      Vordergrundfarbe
'         C2%:      Hintergrundfarbe
'         Capi%:    Wenn <> 0 wird jeder Anfangsbuchstabe automatisch
'                   groá geschrieben
'         Vorgabe$: Der zu editierende Text
'
' Tastaturbelegung: Cursor links, Cursor recht, Pos1/Home, Ende/End,
'                   Backspace, Tab, Einfgen/Insert, Entfernen/Delete,
'                   Return, Escape, ASCII-255
'
'         Viel Spaá mit XINPUT,
'          Christian Wendler, 130:130/0@BasNet
'                             2:244/1490@Fido
'                             BBS 49-6074-41307
'                             FAX 49-6074-29749

DEFINT A-Z



'======== Beispiel-Programm: ===============================================

Alpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZŽ™šá01234567890.,:;-_+'`!?/()%$&* "
Numerisch$ = "0123456789,.-+"

DO
    COLOR 14, 0
    CLS

    LOCATE 10, 9
    PRINT "Dein Name: ";
    DO
        Benutzer$ = XINPUT$(Alpha$, 10, 20, 30, 15, 1, 1, "Roland Rolle")
    LOOP UNTIL Benutzer$ <> CHR$(27)

    COLOR 14, 0
    LOCATE 12, 8
    PRINT "Dein Alter: ";
    Alter = VAL(XINPUT$(Numerisch$, 12, 20, 2, 14, 5, 0, ""))

    COLOR 9, 0
    LOCATE 14, 20
    PRINT Benutzer$; " ist"; Alter; "Jahre alt!"

    COLOR 14, 0
    LOCATE 16, 5
    PRINT "Nochmal? (J/N) ";
    JN$ = XINPUT$("JN", 16, 20, 1, 0, 7, 1, "J")
LOOP WHILE LCASE$(JN$) = "j"

COLOR 7, 0
CLS
END

FUNCTION UpCase$ (Char$)
    Char$ = UCASE$(Char$)
    IF Char$ = "„" THEN Char$ = "Ž"
    IF Char$ = "”" THEN Char$ = "™"
    IF Char$ = "" THEN Char$ = "š"
    UpCase$ = Char$
END FUNCTION

FUNCTION XINPUT$ (Format$, Y, X, l, C1, C2, Capi, Vorgabe$)
   
    Trenn$ = " -,/\:;_"
   
    COLOR C1, C2
    Vorgabe$ = LEFT$(Vorgabe$, l)
    Vorgabe$ = Vorgabe$ + SPACE$(l - LEN(Vorgabe$))
    LOCATE Y, X, 1, 12, 14
    PRINT Vorgabe$;
   
    Cursor = 1
    LOCATE Y, X + Cursor - 1
   
    DO
        T$ = ""
        WHILE T$ = ""
            T$ = INKEY$
        WEND

        SELECT CASE T$
            CASE CHR$(13)
                XINPUT$ = RTRIM$(Vorgabe$)
                LOCATE , , 0, 13, 14
                EXIT FUNCTION
            CASE CHR$(8)
                IF Cursor > 1 THEN
                    Cursor = Cursor - 1
                END IF
                MID$(Vorgabe$, Cursor, 1) = " "
            CASE CHR$(0) + CHR$(75)
                IF Cursor > 1 THEN Cursor = Cursor - 1
            CASE CHR$(0) + CHR$(77)
                IF Cursor < l THEN Cursor = Cursor + 1
            CASE CHR$(0) + CHR$(71)
                Cursor = 1
            CASE CHR$(0) + CHR$(79)
                Cursor = l
            CASE CHR$(0) + CHR$(83)
                Neu$ = ""
                IF Cursor > 1 THEN Neu$ = LEFT$(Vorgabe$, Cursor - 1)
                Neu$ = Neu$ + MID$(Vorgabe$, Cursor + 1) + SPACE$(1)
                Vorgabe$ = LEFT$(Neu$, l)
            CASE CHR$(0) + CHR$(82)
                Neu$ = ""
                IF Cursor > 1 THEN Neu$ = LEFT$(Vorgabe$, Cursor - 1)
                Neu$ = Neu$ + SPACE$(1) + MID$(Vorgabe$, Cursor)
                Vorgabe$ = LEFT$(Neu$, l)
            CASE CHR$(9)
                Cursor = Cursor + 8
                IF Cursor > l THEN Cursor = l
            CASE CHR$(255)
                CopyR$ = SPACE$(l) + "XINPUT 1.1 (c) 1994 by performance "
                COLOR 1, 7
                FOR i = 1 TO LEN(CopyR$)
                    LOCATE Y, X
                    PRINT MID$(CopyR$, i, l);
                    LOCATE Y, X
                    St! = TIMER + .1
                    WHILE TIMER <= St!: WEND
                NEXT
                COLOR C1, C2
            CASE CHR$(27)
                XINPUT$ = CHR$(27)
                LOCATE , , 0, 13, 14
                EXIT FUNCTION
            CASE ELSE
                Char$ = T$
                IF INSTR(Format$, UpCase$(T$)) THEN
                    IF Cursor = 1 AND Capi THEN Char$ = UpCase$(Char$)
                    IF Cursor > 1 AND Capi THEN
                        IF INSTR(Trenn$, MID$(Vorgabe$, Cursor - 1, 1)) THEN Char$ = UpCase$(Char$)
                    END IF
                    MID$(Vorgabe$, Cursor, 1) = Char$
                    IF Cursor < l THEN Cursor = Cursor + 1
                END IF
        END SELECT
       
        LOCATE Y, X, 0
        PRINT Vorgabe$
        LOCATE Y, X + Cursor - 1, 1
    LOOP WHILE 1

END FUNCTION