Turbo Toolbox/Turbo_Toolbox.iso/1990/11/einsteig/tools1.bas

BASIC Source File | 1990-08-10 | 19.4 KB | 597 lines

' *********************************************************
'                         Tools1.Bas
'            (c) 1990 W.Kehr/Th.Frins & toolbox
'
'            enthält diverse SUBs und Functions
'       komplette Version nur auf DATABOX - nicht im Heft
'                   "MERGEN" mit T1test.bas
' *********************************************************

DECLARE SUB Normal ()
DECLARE SUB Invers ()
DECLARE SUB Pruefuebergabe (zeile%, spalte%, typ$, laenge%, nachkomma%, gueltig$, vorgabe$, vorzeichen%, komma%, fehler%)
DECLARE SUB Warten (ZeilenNr%)
DECLARE SUB Numerisch (komma%, vorzeichen%, einfmerker%, eingabe$, laenge%, position%, v$)
DECLARE SUB Zeichen (einfmerker%, eingabe$, laenge%, position%, v$)
DECLARE SUB Sonder (typ$, vorzeichen%, komma%, cursor%, einfmerker%, eingabe$, laenge%, position%, v$)
DECLARE SUB Fehlmeld (ZeilenNr%, Fehlertext$)
DECLARE FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, ErsteWahl%, abstand%, Optionen$())
DECLARE FUNCTION ZeilenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, ErsteWahl%, Optionen$())

FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, ErsteWahl%, abstand%, Optionen$())
    FOR I% = 1 TO Elemente%
        differenz% = abstand% * (I% - 1)
        LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
        IF I% = ErsteWahl% THEN
            Invers
            PRINT "["; I%; "]"; SPACE$(3); Optionen$(I% - 1); " ";
            Normal
        ELSE
            PRINT "["; I%; "]"; SPACE$(3); Optionen$(I% - 1); " ";
        END IF
    NEXT I%
    differenz% = abstand% * (ErsteWahl% - 1)
    taste$ = CHR$(255)
    WHILE taste$ <> CHR$(13)
        taste$ = INKEY$
        IF (LEN(taste$) = 2 AND (RIGHT$(taste$, 1) = CHR$(72) OR RIGHT$(taste$, 1) = CHR$(80))) OR taste$ = CHR$(27) THEN
            LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
            PRINT "["; ErsteWahl%; "]"; SPACE$(3); Optionen$(ErsteWahl% - 1); " ";
            IF RIGHT$(taste$, 1) = CHR$(72) THEN
                ErsteWahl% = ErsteWahl% - 1
                IF ErsteWahl% < 1 THEN ErsteWahl% = Elemente%
            END IF
            IF RIGHT$(taste$, 1) = CHR$(80) THEN
                ErsteWahl% = ErsteWahl% + 1
                IF ErsteWahl% > Elemente% THEN ErsteWahl% = 1
            END IF
            IF taste$ = CHR$(27) THEN
                ErsteWahl% = Elemente%
            END IF
            differenz% = abstand% * (ErsteWahl% - 1)
            Invers
            LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
            PRINT "["; ErsteWahl%; "]"; SPACE$(3); Optionen$(ErsteWahl% - 1); " ";
            Normal
        END IF
    WEND
    IF taste$ = CHR$(27) THEN
        BalkenMenue% = Elemente%
    ELSE
        BalkenMenue% = ErsteWahl%
    END IF
END FUNCTION

SUB BildLoeschen (ZeileLinksOben%, SpalteLinksOben%, ZeileRechtsUnten%, SpalteRechtsUnten%, LoeschZeichen$)
    IF LoeschZeichen$ = "" THEN LoeschZeichen$ = " "
    FOR I% = ZeileLinksOben% TO ZeileRechtsUnten%
        LOCATE I%, SpalteLinksOben%
        PRINT STRING$(SpalteRechtsUnten% - SpalteLinksOben% + 1, LoeschZeichen$);
    NEXT I%
    LOCATE 1, 1, 0
END SUB

SUB Blinken
    COLOR 18, 0
END SUB

SUB Fehlmeld (ZeilenNr%, Fehlertext$)
    LOCATE ZeilenNr%, 2, 0
    PRINT Fehlertext$;
    IF LEN(Fehlertext$) > 50 THEN
        CALL Warten(ZeilenNr% + 1)
    ELSE
        CALL Warten(ZeilenNr%)
    END IF
END SUB

SUB Hell
    COLOR 10, 0
END SUB

SUB HellBlinken
    COLOR 26, 0
END SUB

SUB InputNeu (vorgabe$, gueltig$, typ$, laenge%, nachkomma%, zeile%, spalte%)

'eingaberoutine als ersatz für input
'benötigt Zeilen- und Spaltenposition und Gesamtlänge des Eingabefeldes
'typ der Eingabe: (n)umerisch, nur (c)haracter oder (a)lphanumerisch
'anzahl der nachkommastellen
'string mit den gültigen zeichen, kann leer sein und wird dann mit
'default-zeichen belegt
'vorgabewert, kann auch leer sein

    'initialisierungen und prüfungen
    '-------------------------------

    CONST ESC = 27
    CONST ENTER = 13
    CONST UEBER = 7
    CONST EINF = 12
    CONST BACKSPACE = 8

    steuerzeichen% = 0
    cursor% = UEBER
    position% = 1
    vorzeichen% = 0
    komma% = 0
    einfmerker% = 0

    CALL Pruefuebergabe(zeile%, spalte%, typ$, laenge%, nachkomma%, gueltig$, vorgabe$, vorzeichen%, komma%, fehler%)

    'Abbruch, falls Übergabefehler entdeckt
    '--------------------------------------

    IF fehler% THEN
        EXIT SUB
    END IF

    'eingabe$ mit blanks bis laenge füllen
    '--------------------------------------------------

    eingabe$ = vorgabe$ + SPACE$(laenge% - LEN(vorgabe$))

    'eingabeschleife
    '---------------

    LOCATE zeile%, spalte%, 1, 6, UEBER
    Invers
    PRINT eingabe$
    Normal
    LOCATE zeile%, spalte%, 1, 6, UEBER

    DO
        fehler% = 0
        A$ = ""
        WHILE A$ = ""
            A$ = INKEY$
        WEND

        IF LEN(A$) = 1 THEN
            SONDERZEICHEN% = 0
            v$ = A$
        ELSE
            SONDERZEICHEN% = 1
            v$ = RIGHT$(A$, 1)
        END IF

        IF SONDERZEICHEN% = 0 AND ASC(v$) <> BACKSPACE THEN
            SELECT CASE ASC(v$)
            CASE ESC
                EXIT DO
            CASE ENTER
                IF INSTR(eingabe$, ".") THEN
                    vor$ = LEFT$(eingabe$, INSTR(eingabe$, ".") - 1)
                    nach$ = RTRIM$(RIGHT$(eingabe$, laenge% - INSTR(eingabe$, ".")))
                ELSE
                    vor$ = RTRIM$(eingabe$)
                    nach$ = ""
                END IF
                IF LEN(vor$) > laenge% - nachkomma% - 1 AND typ$ = "N" THEN
                    CALL Fehlmeld(23, "Zu viele Vorkommastellen in der Eingabe")
                    fehler% = 1
                END IF
                IF LEN(nach$) > nachkomma% AND typ$ = "N" THEN
                    CALL Fehlmeld(23, "Zu viele Nachkommastellen in der Eingabe")
                    fehler% = 1
                END IF
                IF fehler% = 0 THEN
                    EXIT DO
                END IF
            CASE ELSE
                IF INSTR(gueltig$, v$) THEN
                    SELECT CASE typ$
                    CASE "C", "A"
                        CALL Zeichen(einfmerker%, eingabe$, laenge%, position%, v$)
                    CASE "N"
                        CALL Numerisch(komma%, vorzeichen%, einfmerker%, eingabe$, laenge%, position%, v$)
                    END SELECT
                ELSE
                    CALL Fehlmeld(23, "Kein gültiges Zeichen")
                    fehler% = 1
                END IF
            END SELECT
        ELSE
            CALL Sonder(typ$, vorzeichen%, komma%, cursor%, einfmerker%, eingabe$, laenge%, position%, v$)
        END IF

        LOCATE zeile%, spalte%, 1, 6, cursor%
        Invers
        PRINT eingabe$
        Normal
        LOCATE zeile%, spalte% + position% - 1, 1, 6, cursor%

    LOOP

    'Rechtsbündige BLANKS entfernen, falls ENTER
    'bei ESC bleibt vorgabe$ unverändert
    '--------------------------------------------

    IF ASC(v$) = ENTER THEN
        vorgabe$ = RTRIM$(eingabe$)
    END IF

END SUB

SUB Invers
    COLOR 0, 7
END SUB

SUB Normal
    COLOR 7, 0
END SUB

SUB Numerisch (komma%, vorzeichen%, einfmerker%, eingabe$, laenge%, position%, v$)

    IF v$ = "," THEN v$ = "."
    IF v$ = "." THEN
        SELECT CASE einfmerker%
        CASE 0
            IF komma% = 1 AND INSTR(eingabe$, ".") <> position% THEN
                CALL Fehlmeld(23, "Dezimalpunkt bereits vorhanden")
                EXIT SUB
            END IF
            IF komma% = 0 THEN
                komma% = 1
            END IF
        CASE 1
            IF komma% = 1 THEN
                CALL Fehlmeld(23, "Dezimalpunkt bereits vorhanden")
                EXIT SUB
            END IF
            IF LEN(RTRIM$(eingabe$)) < laenge% THEN
                komma% = 1
            END IF
        END SELECT
    END IF
    IF v$ <> "." AND INSTR(eingabe$, ".") = position% AND einfmerker% = 0 THEN
        komma% = 0
    END IF
    IF (v$ = "+" OR v$ = "-") AND position% <> 1 THEN
        CALL Fehlmeld(23, "Vorzeichen nur am Anfang des Feldes möglich")
        EXIT SUB
    END IF
    IF (v$ = "+" OR v$ = "-") AND position% = 1 AND einfmerker% = 1 AND vorzeichen% = 1 THEN
        CALL Fehlmeld(23, "Einfügen eines weiteren Vorzeichens unmöglich")
        EXIT SUB
    END IF
    IF v$ = "+" OR v$ = "-" THEN
        vorzeichen% = 1
    END IF

    CALL Zeichen(einfmerker%, eingabe$, laenge%, position%, v$)


END SUB

SUB Pruefuebergabe (zeile%, spalte%, typ$, laenge%, nachkomma%, gueltig$, vorgabe$, vorzeichen%, komma%, fehler%)

    IF LEN(vorgabe$) > laenge% THEN
        CALL Fehlmeld(23, "Vorgabe ist zu lang")
        fehler% = 1
    END IF
    SELECT CASE typ$
    CASE "c", "C"
        typ$ = "C"
        nachkomma% = 0
        IF LEN(gueltig$) = 0 THEN
            gueltig$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZäöüÄÖÜß"
        END IF
    CASE "a", "A"
        typ$ = "A"
        nachkomma% = 0
        IF gueltig$ = "" THEN
            FOR I = 1 TO 255
                gueltig$ = gueltig$ + CHR$(I)
            NEXT I
        END IF
    CASE "n", "N"
        typ$ = "N"
        IF LEN(gueltig$) = 0 THEN
            gueltig$ = "0123456789+-.,"
        END IF
        IF laenge% - nachkomma% < 2 THEN
            CALL Fehlmeld(23, "Gesamtlaenge des Feldes nicht ausreichend")
            fehler% = 1
        END IF
        SELECT CASE INSTR(vorgabe$, "+")
        CASE 0
            vorzeichen% = 0
        CASE 1
            vorzeichen% = 1
        CASE IS > 1
            CALL Fehlmeld(23, "Pluszeichen nur an der ersten Position erlaubt")
            fehler% = 1
        END SELECT
        SELECT CASE INSTR(vorgabe$, "-")
        CASE 0
            vorzeichen% = 0
        CASE 1
            vorzeichen% = 1
        CASE IS > 1
            CALL Fehlmeld(23, "Minuszeichen nur an der ersten Position erlaubt")
            fehler% = 1
        END SELECT
        komma% = 0
        FOR I = 1 TO LEN(vorgabe$)
            IF MID$(vorgabe$, I, 1) = "." OR MID$(vorgabe$, I, 1) = "," THEN
                komma% = komma% + 1
            END IF
            IF komma% > 1 THEN
                CALL Fehlmeld(23, "Mehr als ein Dezimalpunkt in der Vorgabe")
                fehler% = 1
            END IF
        NEXT I
        IF INSTR(vorgabe$, ",") <> 0 THEN
            vorgabe$ = LEFT$(vorgabe$, INSTR(vorgabe$, ",") - 1) + "." + RIGHT$(vorgabe$, LEN(vorgabe$) - INSTR(vorgabe$, ","))
        END IF
        FOR I = 1 TO LEN(vorgabe$)
            SELECT CASE MID$(vorgabe$, I, 1)
            CASE "0" TO "9", "+", "-", "."
            CASE ELSE
                CALL Fehlmeld(23, "Ungültige Zeichen in der numerischen Vorgabe")
                fehler% = 1
                EXIT FOR
            END SELECT
        NEXT I
    CASE ELSE
        CALL Fehlmeld(23, "Falsches Typkennzeichen gewählt, nur 'c', 'a' und 'n' erlaubt")
        fehler% = 1
    END SELECT
    SELECT CASE zeile%
    CASE IS < 1, IS > 25
        CALL Fehlmeld(23, "Zeilenposition außerhalb des Bereichs")
        fehler% = 1
    END SELECT
    SELECT CASE spalte%
    CASE IS < 1, IS > 80
        CALL Fehlmeld(23, "Spaltenposition außerhalb des Bereichs")
        fehler% = 1
    END SELECT
    IF INSTR(vorgabe$, ".") THEN
        vor$ = LEFT$(vorgabe$, INSTR(vorgabe$, ".") - 1)
        nach$ = MID$(vorgabe$, INSTR(vorgabe$, ".") + 1)
    ELSE
        vor$ = RTRIM$(vorgabe$)
        nach$ = ""
    END IF
    IF LEN(vor$) > laenge% - nachkomma% - 1 AND typ$ = "N" THEN
        CALL Fehlmeld(23, "Zu viele Vorkommastellen in der Vorgabe")
        fehler% = 1
    END IF
    IF LEN(nach$) > nachkomma% AND typ$ = "N" THEN
        CALL Fehlmeld(23, "Zu viele Nachkommastellen in der Vorgabe")
        fehler% = 1
    END IF

END SUB

SUB Rahmen (ZeileLinksOben%, SpalteLinksOben%, ZeileRechtsUnten%, SpalteRechtsUnten%, RahmenZeichen$)
    SELECT CASE RahmenZeichen$
        CASE CHR$(201)
            ZeichenLinksOben$ = CHR$(201)
            ZeichenLinksUnten$ = CHR$(200)
            ZeichenRechtsOben$ = CHR$(187)
            ZeichenRechtsUnten$ = CHR$(188)
            ZeichenWaagrecht$ = CHR$(205)
            ZeichenSenkrecht$ = CHR$(186)
        CASE CHR$(218)
            ZeichenLinksOben$ = CHR$(218)
            ZeichenLinksUnten$ = CHR$(192)
            ZeichenRechtsOben$ = CHR$(191)
            ZeichenRechtsUnten$ = CHR$(217)
            ZeichenWaagrecht$ = CHR$(196)
            ZeichenSenkrecht$ = CHR$(179)
        CASE CHR$(213)
            ZeichenLinksOben$ = CHR$(213)
            ZeichenLinksUnten$ = CHR$(212)
            ZeichenRechtsOben$ = CHR$(184)
            ZeichenRechtsUnten$ = CHR$(190)
            ZeichenWaagrecht$ = CHR$(205)
            ZeichenSenkrecht$ = CHR$(179)
        CASE CHR$(214)
            ZeichenLinksOben$ = CHR$(214)
            ZeichenLinksUnten$ = CHR$(211)
            ZeichenRechtsOben$ = CHR$(183)
            ZeichenRechtsUnten$ = CHR$(189)
            ZeichenWaagrecht$ = CHR$(196)
            ZeichenSenkrecht$ = CHR$(186)
        CASE ELSE
            ZeichenLinksOben$ = RahmenZeichen$
            ZeichenLinksUnten$ = RahmenZeichen$
            ZeichenRechtsOben$ = RahmenZeichen$
            ZeichenRechtsUnten$ = RahmenZeichen$
            ZeichenWaagrecht$ = RahmenZeichen$
            ZeichenSenkrecht$ = RahmenZeichen$
    END SELECT
    LOCATE ZeileLinksOben%, SpalteLinksOben%
    PRINT ZeichenLinksOben$; STRING$(SpalteRechtsUnten% - SpalteLinksOben% - 1, ZeichenWaagrecht$); ZeichenRechtsOben$;
    FOR I% = ZeileLinksOben% + 1 TO ZeileRechtsUnten% - 1
        LOCATE I%, SpalteLinksOben%
        PRINT ZeichenSenkrecht$;
        LOCATE I%, SpalteRechtsUnten%
        PRINT ZeichenSenkrecht$;
    NEXT I%
    LOCATE ZeileRechtsUnten%, SpalteLinksOben%
    PRINT ZeichenLinksUnten$; STRING$(SpalteRechtsUnten% - SpalteLinksOben% - 1, ZeichenWaagrecht$); ZeichenRechtsUnten$;
END SUB

SUB Sonder (typ$, vorzeichen%, komma%, cursor%, einfmerker%, eingabe$, laenge%, position%, v$)

    CONST UEBER = 7
    CONST EINF = 12
    CONST BACKSPACE = 8
    CONST BLANK = " "
    CONST CURLINKS = 75
    CONST CURRECHTS = 77
    CONST CURHOCH = 72
    CONST CURRUNTER = 80
    CONST HOME = 71
    CONST ENDE = 79
    CONST DEL = 83
    CONST INS = 82

    'DEL
    '---
    IF ASC(v$) = DEL THEN
        loesch$ = MID$(eingabe$, position%, 1)
        IF typ$ = "N" AND loesch$ = "." THEN komma% = 0
        IF typ$ = "N" AND (loesch$ = "+" OR loesch$ = "-") THEN vorzeichen% = 0
        eingabe$ = LEFT$(eingabe$, position% - 1) + RIGHT$(eingabe$, laenge% - position%) + BLANK
        EXIT SUB
    END IF

    'BACKSPACE
    '---------
    IF ASC(v$) = BACKSPACE THEN
        IF position% = 1 THEN
            BEEP
            EXIT SUB
        ELSE
            IF position% = laenge% THEN
                loesch$ = MID$(eingabe$, position%, 1)
                IF MID$(eingabe$, laenge%, 1) = BLANK THEN
                    position% = position% - 1
                    eingabe$ = LEFT$(eingabe$, position% - 1) + RIGHT$(eingabe$, laenge% - position%) + BLANK
                ELSE
                    eingabe$ = LEFT$(eingabe$, position% - 1) + BLANK
                END IF
            ELSE
                loesch$ = MID$(eingabe$, position% - 1, 1)
                position% = position% - 1
                eingabe$ = LEFT$(eingabe$, position% - 1) + RIGHT$(eingabe$, laenge% - position%) + BLANK
            END IF
        END IF
        IF typ$ = "N" AND loesch$ = "." THEN komma% = 0
        IF typ$ = "N" AND (loesch$ = "+" OR loesch$ = "-") THEN vorzeichen% = 0
        EXIT SUB
    END IF

    'Sonderzeichen
    '-------------

        SELECT CASE ASC(v$)
        CASE CURHOCH, CURRUNTER
            BEEP
        CASE CURLINKS
            IF position% > 1 THEN
                position% = position% - 1
            ELSE
                BEEP
            END IF
        CASE CURRECHTS
            IF typ$ <> "N" THEN
                IF position% < laenge% THEN
                    position% = position% + 1
                ELSE
                    BEEP
                END IF
            ELSE
                IF MID$(eingabe$, position%, 1) <> BLANK THEN
                    position% = position% + 1
                ELSE
                    BEEP
                END IF
            END IF
        CASE HOME
            position% = 1
        CASE ENDE
            IF typ$ <> "N" THEN
                position% = laenge%
            ELSE
                position% = LEN(RTRIM$(eingabe$)) + 1
            END IF
        CASE INS
            IF einfmerker% THEN
                einfmerker% = 0
                cursor% = 7
            ELSE
                einfmerker% = 1
                cursor% = 12
            END IF
        END SELECT

END SUB

SUB Unterstrichen
    COLOR 1, 0
END SUB

SUB Warten (ZeilenNr%)
    LOCATE ZeilenNr%, 55, 0
    PRINT " Weiter mit ";
    Invers
    PRINT "<TASTE>";
    Normal
    dummy$ = INPUT$(1)
    LOCATE ZeilenNr%, 2, 0
    PRINT SPACE$(78);
END SUB

SUB Zeichen (einfmerker%, eingabe$, laenge%, position%, v$)

    IF einfmerker% = 1 THEN
        IF LEN(RTRIM$(eingabe$)) < laenge% THEN
            eingabe$ = LEFT$(eingabe$, position% - 1) + v$ + MID$(eingabe$, position%, laenge% - position%)
        ELSE
            CALL Fehlmeld(23, "Einfügen unmöglich, Feld bereits gefüllt")
            position% = position% - 1
        END IF
    ELSE
        eingabe$ = LEFT$(eingabe$, position% - 1) + v$ + MID$(eingabe$, position% + 1, laenge% - position%)
    END IF
    IF position% < laenge% THEN
        position% = position% + 1
    END IF

END SUB

FUNCTION ZeilenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, ErsteWahl%, Optionen$())
    DIM OptionsLaenge%(Elemente% - 1)
    OptionsLaenge%(0) = 0
    LOCATE ZeilenNr%, SpaltenNr%, 0
    FOR I% = 1 TO Elemente%
        IF I% = ErsteWahl% THEN
            Invers
            PRINT " "; Optionen$(I% - 1); " ";
            Normal
        ELSE
            PRINT " "; Optionen$(I% - 1); " ";
        END IF
        IF I% > 1 THEN
            OptionsLaenge%(I% - 1) = OptionsLaenge%(I% - 2) + (LEN(Optionen$(I% - 2)) + 2)
        END IF
    NEXT I%
    taste$ = CHR$(255)
    WHILE taste$ <> CHR$(13)
        taste$ = INKEY$
        IF (LEN(taste$) = 2 AND (RIGHT$(taste$, 1) = CHR$(75) OR RIGHT$(taste$, 1) = CHR$(77))) OR taste$ = CHR$(27) THEN
            LOCATE ZeilenNr%, SpaltenNr% + OptionsLaenge%(ErsteWahl% - 1), 0
            PRINT " "; Optionen$(ErsteWahl% - 1); " ";
            IF RIGHT$(taste$, 1) = CHR$(75) THEN
                ErsteWahl% = ErsteWahl% - 1
                IF ErsteWahl% < 1 THEN ErsteWahl% = Elemente%
            END IF
            IF RIGHT$(taste$, 1) = CHR$(77) THEN
                ErsteWahl% = ErsteWahl% + 1
                IF ErsteWahl% > Elemente% THEN ErsteWahl% = 1
            END IF
            IF taste$ = CHR$(27) THEN
                ErsteWahl% = Elemente%
            END IF
            LOCATE ZeilenNr%, SpaltenNr% + OptionsLaenge%(ErsteWahl% - 1), 0
            Invers
            PRINT " "; Optionen$(ErsteWahl% - 1); " ";
            Normal
        END IF
    WEND
    IF taste$ = CHR$(27) THEN
        ZeilenMenue% = Elemente%
    ELSE
        ZeilenMenue% = ErsteWahl%
    END IF
END FUNCTION