Koodit: QB: Kehittyneempi Input-funktio

DECLARE FUNCTION GetText% (Txt$, MaxLen%, VisLen%, Acc$)
DECLARE FUNCTION GetShiftStatus% ()
DECLARE SUB Delete (st$, p%, l%)
DECLARE SUB Insert (st$, i%, c$)

WIDTH 80, 50

Txt$ = "Hei äiti, olen intter Netissä"
PRINT "Kerro jotain? ";
IF (GetText%(Txt$, 80, 30, "")) THEN
    PRINT
    PRINT "Kiitos. Kirjoitit '" + Txt$ + "'"
ELSE
    PRINT
    PRINT "Ei vaengaellae"
END IF

SUB Delete (st$, p%, l%)
    st$ = LEFT$(st$, p% - 1) + MID$(st$, p% + l%)
END SUB

FUNCTION GetShiftStatus%
    DEF SEG = &H40
    GetShiftStatus% = PEEK(&H17)
    DEF SEG
END FUNCTION

'   GetText - (LINE) INPUT:in korvike
'
'   Parametrit:
'       Txt$        muokattava teksti
'       MaxLen%     tekstin maksimipituus
'       VisLen%     näytöllä näkyvien merkkien määrä ts. kentän pituus
'       Acc$        merkkijono, jossa on kaikki ne merkit, jotka kelpaa-
'                   vat syötteeksi. esim. jos Acc$ = "0123456789" niin
'                   muokattavaan merkkijonoon kelpuutetaan vain numerot.
'
'   Toimintonäppäimet:
'       <-, ->,
'       Home, End   navigointi
'       Del         merkin poisto
'       Ins         korvaus/lisäys (oletuksena lisäys)
'       Backspace   edellisen merkin poisto
'       Ctrl+U      puskurin tyhjennys
'
'   Paluuarvo:
'       0           ESC painettu, Txt$:n arvoa EI MUUTETTU
'       1           ENTER painettu, Txt$:n arvo päivitetty
'
FUNCTION GetText% (Txt$, MaxLen%, VisLen%, Acc$)
    X% = POS(0)
    Y% = CSRLIN

    CurPos% = LEN(Txt$) + 1
    DispStart% = 1
    Done% = 0
    Ins% = 1

    Accept$ = Acc$
    IF (Acc$ = "") THEN
        FOR i% = 0 TO 255: Accept$ = Accept$ + CHR$(i%): NEXT i%
    END IF

    IF (MaxLen%) THEN Buf$ = LEFT$(Txt$, MaxLen%) ELSE Buf$ = Txt$

    WHILE Done% = 0

        IF (VisLen%) THEN   ' rullausta tarvittaessa
            IF (CurPos% < DispStart%) THEN DispStart% = CurPos%
            IF (CurPos% > DispStart% + VisLen% - 1) THEN
                DispStart% = CurPos% - VisLen% + 1
            END IF
        END IF

        ' teksti ruudulle
        LOCATE Y%, X%, 0
        IF (VisLen%) THEN
            LOCATE Y%, X%, 0: PRINT SPACE$(VisLen%);
            LOCATE Y%, X%, 0:
            PRINT MID$(Buf$, DispStart%, VisLen%);
        ELSE
            PRINT Buf$ + " ";
        END IF

        ' tekstin mennessä yli ruudun oikeasta reunasta onnistuu
        ' kursorin kohdistaminen seuraavilla koordinaateilla
        '
        ' TempX% = (X% + (CurPos% - DispStart% - 1)) MOD 80 + 1
        ' TempY% = (X% + (CurPos% - DispStart% - 1)) \ 80 + 1
        '
        ' ... joista ei kuitenkaan ole hyötyä niin kauan, kun
        ' tulostetaan teksti PRINT:llä, joka tasaa tekstin
        ' vitulleen kun teksti menee ruudun oikean reunan yli

        LOCATE Y%, X% + (CurPos% - DispStart%), 1, 14 - (Ins% XOR 1) * 14, 15

        ' odota napi
        Key$ = "": WHILE Key$ = "": Key$ = INKEY$: WEND

        SELECT CASE Key$
            CASE CHR$(8)        ' backspace
                IF (CurPos% > 1) THEN
                    CurPos% = CurPos% - 1
                    CALL Delete(Buf$, CurPos%, 1)
                END IF

            CASE CHR$(27)       ' ESC, peruuta
                GetText% = 0
                Done% = 1

            CASE CHR$(13)       ' ENTER, ok
                GetText% = 1
                Txt$ = Buf$
                Done% = 1

            CASE CHR$(21)       ' C-U
                Buf$ = ""
                CurPos% = 1

            CASE CHR$(0) + "G"  ' Home
                CurPos% = 1

            CASE CHR$(0) + "O"  ' Home
                CurPos% = LEN(Buf$) + 1
                IF (CurPos% > MaxLen%) THEN CurPos% = MaxLen%

            CASE CHR$(0) + "K"  ' <-
                IF (CurPos% > 1) THEN
                    CurPos% = CurPos% - 1
                END IF

            CASE CHR$(0) + "M"  ' ->
                IF (CurPos% <= LEN(Buf$)) THEN
                    CurPos% = CurPos% + 1
                END IF

            CASE CHR$(0) + "S"  ' Delete
                CALL Delete(Buf$, CurPos%, 1)

            CASE CHR$(0) + "R"  ' Lisäys/korvaus
                Ins% = Ins% XOR 1

            CASE ELSE
                IF (INSTR(Accept$, Key$) > 0) THEN
                    IF (Ins%) THEN
                        IF (LEN(Buf$) < MaxLen%) THEN
                            CALL Insert(Buf$, CurPos%, Key$)
                            CurPos% = CurPos% + 1
                        END IF
                    ELSE
                        MID$(Buf$, CurPos%, 1) = Key$
                        IF (CurPos% < MaxLen%) THEN CurPos% = CurPos% + 1
                    END IF
                END IF
        END SELECT
    WEND
    LOCATE Y%, X%
END FUNCTION

SUB Insert (st$, i%, c$)
    st$ = LEFT$(st$, i% - 1) + c$ + MID$(st$, i%)
END SUB