home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / einsteig / tools.bas < prev    next >
Encoding:
BASIC Source File  |  1991-02-17  |  20.7 KB  |  717 lines
  1. '*--------------------------------------------------------*
  2. '*                       TOOLS.BAS                        *
  3. '*         (C) 1990 Th.Frins, W. Kehr & TOOLBOX           *
  4. '*--------------------------------------------------------*
  5.  
  6. '*-------------- Definitionen und Deklarationen ----------*
  7.  
  8. '* Prozedur-Deklarationen:
  9. DECLARE SUB Sonder (typ$, vorzeichen%, komma%, cursor%, _
  10.         einfmerker%, eingabe$, laenge%, position%, _
  11.         Zeile%, v$)
  12. DECLARE SUB HellBlinken ()
  13. DECLARE SUB Unterstrichen ()
  14. DECLARE SUB hell ()
  15. DECLARE SUB normal ()
  16. DECLARE SUB Blinken ()
  17. DECLARE SUB invers ()
  18. DECLARE SUB bildloeschen (ZeileLinksOben%, _
  19.         SpalteLinksOben%, ZeileRechtsUnten%, _
  20.         SpalteRechtsUnten%, LoeschZeichen$)
  21. DECLARE SUB rahmen (ZeileLinksOben%, SpalteLinksOben%, _
  22.         ZeileRechtsUnten%, SpalteRechtsUnten%, _
  23.         RahmenZeichen$)
  24. DECLARE SUB InputNeu (vorgabe$, gueltig$, typ$, laenge%, _
  25.         nachkomma%, Zeile%, Spalte%, taste$)
  26. DECLARE SUB pruefuebergabe (Zeile%, Spalte%, typ$, _
  27.         laenge%, nachkomma%, gueltig$, vorgabe$, _
  28.         vorzeichen%, komma%, fehler%)
  29. DECLARE SUB warten (ZeilenNr%)
  30. DECLARE SUB numerisch (komma%, vorzeichen%, einfmerker%, _
  31.         eingabe$, laenge%, position%, v$)
  32. DECLARE SUB zeichen (einfmerker%, eingabe$, laenge%, _
  33.         position%, v$)
  34. DECLARE SUB fehlmeld (ZeilenNr%, Fehlertext$)
  35. DECLARE SUB Meldung (Zeile%, Spalte%, text$)
  36.  
  37. '* Funktionsdeklarationen:
  38. DECLARE FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%, _
  39.         Elemente%, ErsteWahl%, abstand%, Optionen$())
  40. DECLARE FUNCTION ZeilenMenue% (ZeilenNr%, SpaltenNr%, _
  41.         Elemente%, ErsteWahl%, Optionen$())
  42.  
  43. '* Variablendefinitionen:
  44.  
  45. COMMON /Tools/ inversflag
  46.  
  47. FUNCTION BalkenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, _
  48.                        ErsteWahl%, abstand%, Optionen$())
  49.   FOR i% = 1 TO Elemente%
  50.     differenz% = abstand% * (i% - 1)
  51.     LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
  52.     IF i% = ErsteWahl% THEN
  53.       invers
  54.       PRINT "["; i%; "]"; SPACE$(3);
  55.       PRINT Optionen$(i% - 1); " ";
  56.       normal
  57.     ELSE
  58.       PRINT "["; i%; "]"; SPACE$(3);
  59.       PRINT Optionen$(i% - 1); " ";
  60.     END IF
  61.   NEXT i%
  62.   differenz% = abstand% * (ErsteWahl% - 1)
  63.   taste$ = CHR$(255)
  64.   WHILE taste$ <> CHR$(13)
  65.     taste$ = INKEY$
  66.     IF (LEN(taste$) = 2 AND (RIGHT$(taste$, 1) = _
  67.     CHR$(72) OR RIGHT$(taste$, 1) = CHR$(80))) OR _
  68.     taste$ = CHR$(27) THEN
  69.       LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
  70.       PRINT "["; ErsteWahl%; "]"; SPACE$(3);
  71.       PRINT Optionen$(ErsteWahl% - 1); " ";
  72.       IF RIGHT$(taste$, 1) = CHR$(72) THEN
  73.         ErsteWahl% = ErsteWahl% - 1
  74.         IF ErsteWahl% < 1 THEN ErsteWahl% = Elemente%
  75.       END IF
  76.       IF RIGHT$(taste$, 1) = CHR$(80) THEN
  77.         ErsteWahl% = ErsteWahl% + 1
  78.         IF ErsteWahl% > Elemente% THEN ErsteWahl% = 1
  79.       END IF
  80.       IF taste$ = CHR$(27) THEN
  81.         ErsteWahl% = Elemente%
  82.       END IF
  83.       differenz% = abstand% * (ErsteWahl% - 1)
  84.       invers
  85.       LOCATE ZeilenNr% + differenz%, SpaltenNr%, 0
  86.       PRINT "["; ErsteWahl%; "]"; SPACE$(3);
  87.       PRINT Optionen$(ErsteWahl% - 1); " ";
  88.       normal
  89.     END IF
  90.   WEND
  91.   IF taste$ = CHR$(27) THEN
  92.     BalkenMenue% = Elemente%
  93.   ELSE
  94.     BalkenMenue% = ErsteWahl%
  95.   END IF
  96. END FUNCTION
  97.  
  98. SUB bildloeschen (ZeileLinksOben%, SpalteLinksOben%, _
  99.                   ZeileRechtsUnten%, SpalteRechtsUnten%, _
  100.                   LoeschZeichen$)
  101.   IF LoeschZeichen$ = "" THEN LoeschZeichen$ = " "
  102.   FOR i% = ZeileLinksOben% TO ZeileRechtsUnten%
  103.     LOCATE i%, SpalteLinksOben%
  104.     PRINT STRING$(SpalteRechtsUnten% - _
  105.                   SpalteLinksOben% + 1, LoeschZeichen$);
  106.   NEXT i%
  107.   LOCATE 1, 1, 0
  108. END SUB
  109.  
  110. SUB Blinken
  111.   COLOR 18, 0
  112. END SUB
  113.  
  114. SUB fehlmeld (ZeilenNr%, Fehlertext$)
  115. SHARED inversflag
  116.   normal
  117.   LOCATE ZeilenNr%, 2, 0
  118.   PRINT Fehlertext$;
  119.   CALL warten(23)
  120.   IF inversflag = 1 THEN invers
  121. END SUB
  122.  
  123. SUB hell
  124.   COLOR 10, 0
  125. END SUB
  126.  
  127. SUB HellBlinken
  128.   COLOR 26, 0
  129. END SUB
  130.  
  131. SUB InputNeu (vorgabe$, gueltig$, typ$, laenge%, _
  132.               nachkomma%, Zeile%, Spalte%, taste$)
  133. '* Eingaberoutine als Ersatz für INPUT
  134. '* Benötigt Zeilen- und Spaltenposition und Gesamtlänge des
  135. '* Eingabefeldes.
  136. '* Typ der Eingabe: (n)umerisch, nur (c)har oder (a)lphanum.
  137. '* Anzahl der Nachkommastellen
  138. '* String mit den gültigen zeichen, kann leer sein und wird
  139. '* dann mit Default-Zeichen belegt
  140. '* Vorgabewert, kann auch leer sein
  141.  
  142. SHARED inversflag
  143. CONST ESC = 27
  144. CONST ENTER = 13
  145. CONST UEBER = 7
  146. CONST EINF = 12
  147. CONST BACKSPACE = 8
  148.  
  149.   steuerzeichen% = 0
  150.   cursor% = UEBER
  151.   IF LEN(vorgabe$) < laenge% THEN
  152.     position% = LEN(vorgabe$) + 1
  153.   ELSE
  154.     position% = LEN(vorgabe$)
  155.   END IF
  156.   vorzeichen% = 0
  157.   komma% = 0
  158.   einfmerker% = 0
  159.  
  160.   CALL pruefuebergabe(Zeile%, Spalte%, typ$, laenge%, _
  161.                       nachkomma%, gueltig$, vorgabe$, _
  162.                       vorzeichen%, komma%, fehler%)
  163.  
  164.   '* Abbruch, falls Übergabefehler entdeckt
  165.   IF fehler% THEN EXIT SUB
  166.  
  167.   '* eingabe$ mit Blanks bis "laenge" füllen
  168.   eingabe$ = vorgabe$ + SPACE$(laenge% - LEN(vorgabe$))
  169.  
  170.   '* Eingabeschleife
  171.   invers
  172.   inversflag = 1
  173.   LOCATE Zeile%, Spalte%, 1, 6, UEBER
  174.   PRINT eingabe$
  175.   LOCATE Zeile%, Spalte% + position% - 1, 1, 6, UEBER
  176.   DO
  177.     fehler% = 0
  178.     a$ = ""
  179.     WHILE a$ = ""
  180.       a$ = INKEY$
  181.     WEND
  182.     IF LEN(a$) = 1 THEN
  183.       sonderzeichen% = 0
  184.       v$ = a$
  185.     ELSE
  186.       sonderzeichen% = 1
  187.       v$ = RIGHT$(a$, 1)
  188.     END IF
  189.     IF sonderzeichen% = 0 AND ASC(v$) <> BACKSPACE THEN
  190.       SELECT CASE ASC(v$)
  191.         CASE ESC
  192.           taste$ = "ESC"
  193.           EXIT DO
  194.         CASE ENTER
  195.           taste$ = "ENTER"
  196.           IF INSTR(eingabe$, ".") THEN
  197.             vor$ = LEFT$(eingabe$, _
  198.                    INSTR(eingabe$, ".") - 1)
  199.             nach$ = RTRIM$(RIGHT$(eingabe$, laenge% - _
  200.                            INSTR(eingabe$, ".")))
  201.           ELSE
  202.             vor$ = RTRIM$(eingabe$)
  203.             nach$ = ""
  204.           END IF
  205.           IF LEN(vor$) > laenge% - nachkomma% - 1 AND _
  206.           typ$ = "N" THEN
  207.             CALL fehlmeld(23, "Zu viele Vorkommastellen" + _
  208.                               " in der Eingabe")
  209.             fehler% = 1
  210.           END IF
  211.           IF LEN(nach$) > nachkomma% AND typ$ = "N" THEN
  212.             CALL fehlmeld(23, "Zu viele Nachkommastel" + _
  213.                               "len in der Eingabe")
  214.             fehler% = 1
  215.           END IF
  216.           IF fehler% = 0 THEN
  217.             EXIT DO
  218.           END IF
  219.         CASE ELSE
  220.           IF INSTR(gueltig$, v$) THEN
  221.             SELECT CASE typ$
  222.               CASE "C", "A"
  223.                 CALL zeichen(einfmerker%, eingabe$, _
  224.                              laenge%, position%, v$)
  225.               CASE "N"
  226.                 CALL numerisch(komma%, vorzeichen%, _
  227.                                einfmerker%, eingabe$, _
  228.                                laenge%, position%, v$)
  229.             END SELECT
  230.           ELSE
  231.             BEEP
  232.             fehler% = 1
  233.           END IF
  234.       END SELECT
  235.     ELSE
  236.       CALL Sonder(typ$, vorzeichen%, komma%, cursor%, _
  237.                   einfmerker%, eingabe$, laenge%, _
  238.                   position%, Zeile%, v$)
  239.       IF ASC(v$) = 72 THEN taste$ = "CURHOCH": EXIT DO
  240.       IF ASC(v$) = 80 THEN taste$ = "CURRUNTER": EXIT DO
  241.       IF ASC(v$) = 59 THEN taste$ = "F1": EXIT DO
  242.     END IF
  243.     LOCATE Zeile%, Spalte%, 1, 6, cursor%
  244.     CALL invers
  245.     PRINT eingabe$
  246.     CALL normal
  247.     LOCATE Zeile%, Spalte% + position% - 1, 1, 6, cursor%
  248.   LOOP
  249.  
  250.   '* Rechtsbündige BLANKS entfernen, falls ENTER oder
  251.   '* CURHOCH oder CURRUNTER oder F1
  252.   '* bei ESC bleibt vorgabe$ unverändert
  253.   IF ASC(v$) = ENTER OR taste$ = "CURHOCH" _
  254.   OR taste$ = "CURRUNTER" OR taste$ = "F1" THEN
  255.       vorgabe$ = RTRIM$(eingabe$)
  256.   END IF
  257.  
  258.   normal
  259.   inversflag = 0
  260. END SUB
  261.  
  262. SUB invers
  263.   COLOR 0, 7
  264. END SUB
  265.  
  266. SUB JaNein (Zeile%, Spalte%, text$, ant$)
  267.   CALL hell
  268.   LOCATE Zeile%, Spalte%, 0
  269.   PRINT text$
  270.   DO
  271.     ant$ = INKEY$
  272.   LOOP UNTIL UCASE$(ant$) = "J" OR UCASE$(ant$) = "N"
  273.   CALL normal
  274.   LOCATE Zeile%, Spalte%, 0
  275. END SUB
  276.  
  277. SUB JaNeinESC (Zeile%, Spalte%, text$, ant$)
  278.   CALL hell
  279.   LOCATE Zeile%, Spalte%, 0
  280.   PRINT text$
  281.   DO
  282.     ant$ = INKEY$
  283.   LOOP UNTIL UCASE$(ant$) = "J" OR UCASE$(ant$) = "N" _
  284.              OR CHR$(27) = ant$
  285.   IF CHR$(27) = ant$ THEN ant$ = "ESC"
  286.   CALL normal
  287.   LOCATE Zeile%, Spalte%, 0
  288. END SUB
  289.  
  290. SUB Meldung (Zeile%, Spalte%, text$)
  291.   CALL hell
  292.   LOCATE Zeile%, Spalte%, 0
  293.   PRINT text$
  294.   CALL normal
  295. END SUB
  296.  
  297. SUB normal
  298.   COLOR 7, 0
  299. END SUB
  300.  
  301. SUB numerisch (komma%, vorzeichen%, einfmerker%, _
  302.                eingabe$, laenge%, position%, v$)
  303.   IF v$ = "," THEN v$ = "."
  304.   IF v$ = "." THEN
  305.     SELECT CASE einfmerker%
  306.       CASE 0
  307.         IF komma% = 1 AND INSTR(eingabe$, ".") <> _
  308.                           position% THEN
  309.           CALL fehlmeld(23, _
  310.                         "Dezimalpunkt bereits vorhanden")
  311.           EXIT SUB
  312.         END IF
  313.         IF komma% = 0 THEN
  314.           komma% = 1
  315.         END IF
  316.       CASE 1
  317.         IF komma% = 1 THEN
  318.           CALL fehlmeld(23, _
  319.                         "Dezimalpunkt bereits vorhanden")
  320.           EXIT SUB
  321.         END IF
  322.         IF LEN(RTRIM$(eingabe$)) < laenge% THEN
  323.           komma% = 1
  324.         END IF
  325.     END SELECT
  326.   END IF
  327.   IF v$ <> "." AND INSTR(eingabe$, ".") = position% AND _
  328.   einfmerker% = 0 THEN
  329.     komma% = 0
  330.   END IF
  331.   IF (v$ = "+" OR v$ = "-") AND position% <> 1 THEN
  332.     CALL fehlmeld(23, "Vorzeichen nur am Anfang des" + _
  333.                       " Feldes möglich")
  334.     EXIT SUB
  335.   END IF
  336.   IF (v$ = "+" OR v$ = "-") AND position% = 1 AND _
  337.   einfmerker% = 1 AND vorzeichen% = 1 THEN
  338.     CALL fehlmeld(23, "Einfügen eines weiteren" + _
  339.                       " Vorzeichens unmöglich")
  340.     EXIT SUB
  341.   END IF
  342.   IF v$ = "+" OR v$ = "-" THEN
  343.     vorzeichen% = 1
  344.   END IF
  345.   CALL zeichen(einfmerker%, eingabe$, laenge%, " _
  346.                position%, v$)
  347. END SUB
  348.  
  349. SUB pruefuebergabe (Zeile%, Spalte%, typ$, laenge%, _
  350.                     nachkomma%, gueltig$, vorgabe$, _
  351.                     vorzeichen%, komma%, fehler%)
  352.   IF LEN(vorgabe$) > laenge% THEN
  353.     CALL fehlmeld(23, "Vorgabe ist zu lang")
  354.     fehler% = 1
  355.   END IF
  356.   SELECT CASE typ$
  357.     CASE "c", "C"
  358.       typ$ = "C"
  359.       nachkomma% = 0
  360.       IF LEN(gueltig$) = 0 THEN
  361.         gueltig$ = "abcdefghijklmnopqrstuvwxyz"
  362.         gueltig$ = gueltig$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  363.         gueltig$ = gueltig$ + äöüÄÖÜß "
  364.       END IF
  365.     CASE "a", "A"
  366.       typ$ = "A"
  367.       nachkomma% = 0
  368.       IF gueltig$ = "" THEN
  369.         FOR i% = 1 TO 255
  370.            gueltig$ = gueltig$ + CHR$(i%)
  371.         NEXT i%
  372.       END IF
  373.     CASE "n", "N"
  374.       typ$ = "N"
  375.       IF LEN(gueltig$) = 0 THEN
  376.         gueltig$ = "0123456789+-.,"
  377.       END IF
  378.       IF laenge% - nachkomma% < 2 THEN
  379.         CALL fehlmeld(23, "Gesamtlaenge des Feldes " + _
  380.                           "nicht ausreichend")
  381.         fehler% = 1
  382.       END IF
  383.       SELECT CASE INSTR(vorgabe$, "+")
  384.         CASE 0
  385.           vorzeichen% = 0
  386.         CASE 1
  387.           vorzeichen% = 1
  388.         CASE IS > 1
  389.           CALL fehlmeld(23, "Vorzeichen nur an der " + _
  390.                             "ersten Position erlaubt")
  391.           fehler% = 1
  392.       END SELECT
  393.       SELECT CASE INSTR(vorgabe$, "-")
  394.         CASE 0
  395.           vorzeichen% = 0
  396.         CASE 1
  397.           vorzeichen% = 1
  398.         CASE IS > 1
  399.           CALL fehlmeld(23, "Vorzeichen nur an der " + _
  400.                             "ersten Position erlaubt")
  401.           fehler% = 1
  402.       END SELECT
  403.       komma% = 0
  404.       FOR i = 1 TO LEN(vorgabe$)
  405.         IF MID$(vorgabe$, i, 1) = "." _
  406.         OR MID$(vorgabe$, i, 1) = "," THEN
  407.           komma% = komma% + 1
  408.         END IF
  409.         IF komma% > 1 THEN
  410.           CALL fehlmeld(23, "Mehr als ein Dezimalpunkt" + _
  411.                             "in der Vorgabe")
  412.           fehler% = 1
  413.         END IF
  414.       NEXT i
  415.       IF INSTR(vorgabe$, ",") <> 0 THEN
  416.           vorgabe$ = LEFT$(vorgabe$, _
  417.                      INSTR(vorgabe$, ",") - 1) + "." + _
  418.                      RIGHT$(vorgabe$, LEN(vorgabe$) - _
  419.                      INSTR(vorgabe$, ","))
  420.       END IF
  421.       FOR i = 1 TO LEN(vorgabe$)
  422.         SELECT CASE MID$(vorgabe$, i, 1)
  423.           CASE "0" TO "9", "+", "-", "."
  424.           CASE ELSE
  425.             CALL fehlmeld(23, "Ungültige Zeichen in " + _
  426.                               "der numerischen Vorgabe")
  427.             fehler% = 1
  428.             EXIT FOR
  429.         END SELECT
  430.       NEXT i
  431.     CASE ELSE
  432.       CALL fehlmeld(23, "Falsches Typkennzeichen " + _
  433.                         "gewählt, nur 'c', 'a' und 'n'" + _
  434.                         " erlaubt")
  435.       fehler% = 1
  436.   END SELECT
  437.   SELECT CASE Zeile%
  438.     CASE IS < 1, IS > 25
  439.       CALL fehlmeld(23, "Zeilenposition außerhalb des " + _
  440.                         "Bereichs")
  441.       fehler% = 1
  442.   END SELECT
  443.   SELECT CASE Spalte%
  444.     CASE IS < 1, IS > 80
  445.       CALL fehlmeld(23, "Spaltenposition außerhalb des" + _
  446.                         " Bereichs")
  447.       fehler% = 1
  448.   END SELECT
  449.   IF INSTR(vorgabe$, ".") THEN
  450.     vor$ = LEFT$(vorgabe$, INSTR(vorgabe$, ".") - 1)
  451.     nach$ = MID$(vorgabe$, INSTR(vorgabe$, ".") + 1)
  452.   ELSE
  453.     vor$ = RTRIM$(vorgabe$)
  454.     nach$ = ""
  455.   END IF
  456.   IF LEN(vor$) > laenge% - nachkomma% - 1 AND _
  457.   typ$ = "N" THEN
  458.     CALL fehlmeld(23, "Zu viele Vorkommastellen in der" + _
  459.                       " Vorgabe")
  460.     fehler% = 1
  461.   END IF
  462.   IF LEN(nach$) > nachkomma% AND typ$ = "N" THEN
  463.     CALL fehlmeld(23, "Zu viele Nachkommastellen in " + _
  464.                       "der Vorgabe")
  465.     fehler% = 1
  466.   END IF
  467. END SUB
  468.  
  469. SUB rahmen (ZeileLinksOben%, SpalteLinksOben%, _
  470.             ZeileRechtsUnten%, SpalteRechtsUnten%, _
  471.             RahmenZeichen$)
  472.   SELECT CASE RahmenZeichen$
  473.     CASE CHR$(201)
  474.       ZeichenLinksOben$ = CHR$(201)
  475.       ZeichenLinksUnten$ = CHR$(200)
  476.       ZeichenRechtsOben$ = CHR$(187)
  477.       ZeichenRechtsUnten$ = CHR$(188)
  478.       ZeichenWaagrecht$ = CHR$(205)
  479.       ZeichenSenkrecht$ = CHR$(186)
  480.     CASE CHR$(218)
  481.       ZeichenLinksOben$ = CHR$(218)
  482.       ZeichenLinksUnten$ = CHR$(192)
  483.       ZeichenRechtsOben$ = CHR$(191)
  484.       ZeichenRechtsUnten$ = CHR$(217)
  485.       ZeichenWaagrecht$ = CHR$(196)
  486.       ZeichenSenkrecht$ = CHR$(179)
  487.     CASE CHR$(213)
  488.       ZeichenLinksOben$ = CHR$(213)
  489.       ZeichenLinksUnten$ = CHR$(212)
  490.       ZeichenRechtsOben$ = CHR$(184)
  491.       ZeichenRechtsUnten$ = CHR$(190)
  492.       ZeichenWaagrecht$ = CHR$(205)
  493.       ZeichenSenkrecht$ = CHR$(179)
  494.     CASE CHR$(214)
  495.       ZeichenLinksOben$ = CHR$(214)
  496.       ZeichenLinksUnten$ = CHR$(211)
  497.       ZeichenRechtsOben$ = CHR$(183)
  498.       ZeichenRechtsUnten$ = CHR$(189)
  499.       ZeichenWaagrecht$ = CHR$(196)
  500.       ZeichenSenkrecht$ = CHR$(186)
  501.     CASE ELSE
  502.       ZeichenLinksOben$ = RahmenZeichen$
  503.       ZeichenLinksUnten$ = RahmenZeichen$
  504.       ZeichenRechtsOben$ = RahmenZeichen$
  505.       ZeichenRechtsUnten$ = RahmenZeichen$
  506.       ZeichenWaagrecht$ = RahmenZeichen$
  507.       ZeichenSenkrecht$ = RahmenZeichen$
  508.   END SELECT
  509.   LOCATE ZeileLinksOben%, SpalteLinksOben%
  510.   PRINT ZeichenLinksOben$;
  511.   PRINT STRING$(SpalteRechtsUnten% - SpalteLinksOben% - 1, _
  512.                 ZeichenWaagrecht$); ZeichenRechtsOben$;
  513.   FOR i% = ZeileLinksOben% + 1 TO ZeileRechtsUnten% - 1
  514.     LOCATE i%, SpalteLinksOben%
  515.     PRINT ZeichenSenkrecht$;
  516.     LOCATE i%, SpalteRechtsUnten%
  517.     PRINT ZeichenSenkrecht$;
  518.   NEXT i%
  519.   LOCATE ZeileRechtsUnten%, SpalteLinksOben%
  520.   PRINT ZeichenLinksUnten$;
  521.   PRINT STRING$(SpalteRechtsUnten% - SpalteLinksOben% - 1, _
  522.                 ZeichenWaagrecht$);
  523.   PRINT ZeichenRechtsUnten$;
  524. END SUB
  525.  
  526. SUB Sonder (typ$, vorzeichen%, komma%, cursor%, _
  527.             einfmerker%, eingabe$, laenge%, position%, _
  528.             Zeile%, v$)
  529.   CONST UEBER = 7
  530.   CONST EINF = 12
  531.   CONST BACKSPACE = 8
  532.   CONST BLANK = " "
  533.   CONST CURLINKS = 75
  534.   CONST CURRECHTS = 77
  535.   CONST CURHOCH = 72
  536.   CONST CURRUNTER = 80
  537.   CONST HOME = 71
  538.   CONST ENDE = 79
  539.   CONST DEL = 83
  540.   CONST INS = 82
  541.  
  542.   '* DEL:
  543.   IF ASC(v$) = DEL THEN
  544.     loesch$ = MID$(eingabe$, position%, 1)
  545.     IF typ$ = "N" AND loesch$ = "." THEN komma% = 0
  546.     IF typ$ = "N" AND (loesch$ = "+" OR loesch$ = "-") THEN
  547.       vorzeichen% = 0
  548.     END IF
  549.     eingabe$ = LEFT$(eingabe$, position% - 1) + _
  550.     eingabe$ = eingabe$ + RIGHT$(eingabe$, laenge% - _
  551.                position%)
  552.     eingabe$ = eingabe$ + BLANK
  553.     EXIT SUB
  554.   END IF
  555.  
  556.   '* BACKSPACE:
  557.   IF ASC(v$) = BACKSPACE THEN
  558.     IF position% = 1 THEN
  559.       BEEP
  560.       EXIT SUB
  561.     ELSE
  562.       IF position% = laenge% THEN
  563.         loesch$ = MID$(eingabe$, position%, 1)
  564.         IF MID$(eingabe$, laenge%, 1) = BLANK THEN
  565.           position% = position% - 1
  566.           eingabe$ = LEFT$(eingabe$, position% - 1) + _
  567.           eingabe$ = eingabe$ + RIGHT$(eingabe$, laenge% - _
  568.                      position%)_
  569.           eingabe$ = eingabe$ + BLANK
  570.         ELSE
  571.           eingabe$ = LEFT$(eingabe$, position% - 1) + BLANK
  572.         END IF
  573.       ELSE
  574.         loesch$ = MID$(eingabe$, position% - 1, 1)
  575.         position% = position% - 1
  576.         eingabe$ = LEFT$(eingabe$, position% - 1)
  577.         eingabe$= eingabe$ + RIGHT$(eingabe$, laenge% - _
  578.                   position%) + BLANK
  579.       END IF
  580.     END IF
  581.     IF typ$ = "N" AND loesch$ = "." THEN komma% = 0
  582.     IF typ$ = "N" AND (loesch$ = "+" OR loesch$ = "-") THEN
  583.       vorzeichen% = 0
  584.     END IF
  585.     EXIT SUB
  586.   END IF
  587.              
  588.   '* Sonderzeichen:
  589.   SELECT CASE ASC(v$)
  590.     CASE CURHOCH, CURRUNTER
  591.       '* BEEP
  592.     CASE CURLINKS
  593.       IF position% > 1 THEN
  594.         position% = position% - 1
  595.       ELSE
  596.         BEEP
  597.       END IF
  598.     CASE CURRECHTS
  599.       IF typ$ <> "N" THEN
  600.         IF position% < laenge% THEN
  601.           position% = position% + 1
  602.         ELSE
  603.           BEEP
  604.         END IF
  605.       ELSE
  606.         IF MID$(eingabe$, position%, 1) <> BLANK THEN
  607.           position% = position% + 1
  608.         ELSE
  609.           BEEP
  610.         END IF
  611.       END IF
  612.     CASE HOME
  613.       position% = 1
  614.     CASE ENDE
  615.       IF typ$ <> "N" THEN
  616.         position% = laenge%
  617.       ELSE
  618.         position% = LEN(RTRIM$(eingabe$)) + 1
  619.       END IF
  620.     CASE INS
  621.       IF einfmerker% THEN
  622.          einfmerker% = 0
  623.          cursor% = 7
  624.       ELSE
  625.          einfmerker% = 1
  626.          cursor% = 12
  627.       END IF
  628.   END SELECT
  629. END SUB
  630.  
  631. SUB Unterstrichen
  632.   COLOR 1, 0
  633. END SUB
  634.  
  635. SUB warten (ZeilenNr%)
  636.   LOCATE ZeilenNr%, 2, 0
  637.   PRINT " Weiter mit ";
  638.   invers
  639.   PRINT "<TASTE>";
  640.   normal
  641.   dummy$ = INPUT$(1)
  642.   LOCATE ZeilenNr%, 2, 0
  643.   PRINT SPACE$(78);
  644. END SUB
  645.  
  646. SUB zeichen (einfmerker%, eingabe$, laenge%, position%, v$)
  647.   IF einfmerker% = 1 THEN
  648.     IF LEN(RTRIM$(eingabe$)) < laenge% THEN
  649.       eingabe$ = LEFT$(eingabe$, position% - 1)
  650.       eingabe$ = eingabe$ + v$
  651.       eingabe$ = eingabe$ + MID$(eingabe$, position%, _
  652.                  laenge% - position%)
  653.     ELSE
  654.       CALL fehlmeld(23, "Einfügen unmöglich, "+ _
  655.                         "Feld bereits gefüllt")
  656.       position% = position% - 1
  657.     END IF
  658.   ELSE
  659.     eingabe$ = LEFT$(eingabe$, position% - 1) + v$
  660.     eingabe$ = eingabe$ + MID$(eingabe$, position% + 1, _
  661.                laenge% - position%)
  662.   END IF
  663.   IF position% < laenge% THEN
  664.     position% = position% + 1
  665.   END IF
  666. END SUB
  667.  
  668. FUNCTION ZeilenMenue% (ZeilenNr%, SpaltenNr%, Elemente%, _
  669.                        ErsteWahl%, Optionen$())
  670.   DIM OptionsLaenge%(Elemente% - 1)
  671.   OptionsLaenge%(0) = 0
  672.   LOCATE ZeilenNr%, SpaltenNr%, 0
  673.   FOR i% = 1 TO Elemente%
  674.     IF i% = ErsteWahl% THEN
  675.       invers
  676.       PRINT " "; Optionen$(i% - 1); " ";
  677.       normal
  678.     ELSE
  679.       PRINT " "; Optionen$(i% - 1); " ";
  680.     END IF
  681.     IF i% > 1 THEN
  682.       OptionsLaenge%(i% - 1) = OptionsLaenge%(i% - 2) + _
  683.                                (LEN(Optionen$(i% - 2)) + 2)
  684.     END IF
  685.   NEXT i%
  686.   taste$ = CHR$(255)
  687.   WHILE taste$ <> CHR$(13)
  688.     taste$ = INKEY$
  689.     IF (LEN(taste$) = 2 AND (RIGHT$(taste$, 1) = CHR$(75) _
  690.     OR RIGHT$(taste$, 1) = CHR$(77))) _
  691.     OR taste$ = CHR$(27) THEN
  692.       LOCATE ZeilenNr%, SpaltenNr% + _
  693.              OptionsLaenge%(ErsteWahl% - 1), 0
  694.       PRINT " "; Optionen$(ErsteWahl% - 1); " ";
  695.       IF RIGHT$(taste$, 1) = CHR$(75) THEN
  696.         ErsteWahl% = ErsteWahl% - 1
  697.         IF ErsteWahl% < 1 THEN ErsteWahl% = Elemente%
  698.       END IF
  699.       IF RIGHT$(taste$, 1) = CHR$(77) THEN
  700.         ErsteWahl% = ErsteWahl% + 1
  701.         IF ErsteWahl% > Elemente% THEN ErsteWahl% = 1
  702.       END IF
  703.       IF taste$ = CHR$(27) THEN ErsteWahl% = Elemente%
  704.       LOCATE ZeilenNr%, SpaltenNr% + _
  705.              OptionsLaenge%(ErsteWahl% - 1), 0
  706.       invers
  707.       PRINT " "; Optionen$(ErsteWahl% - 1); " ";
  708.       normal
  709.     END IF
  710.   WEND
  711.   IF taste$ = CHR$(27) THEN
  712.     ZeilenMenue% = Elemente%
  713.   ELSE
  714.     ZeilenMenue% = ErsteWahl%
  715.   END IF
  716. END FUNCTION
  717.