home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 01 / baskurs / baskurs9.bas next >
Encoding:
BASIC Source File  |  1990-10-17  |  4.3 KB  |  131 lines
  1. DECLARE SUB Tastenabfrage ()
  2. DECLARE FUNCTION UpCase$ (InVar AS STRING)
  3. DECLARE FUNCTION JaNein2$ ()
  4. DECLARE SUB ClearKeyBoard ()
  5. DECLARE SUB FillScreen ()
  6. DECLARE SUB JaNein1 (ch AS STRING)
  7.  
  8. DIM farbe AS INTEGER              '* farbe   = Ganzzahl
  9. DIM ch AS STRING * 1              '* ch      = CHAR
  10. DIM jn AS STRING * 1              '* jn      = CHAR
  11. DIM i AS INTEGER, j AS INTEGER    '* i und j = Ganzzahl
  12.  
  13. CONST nein = "N"                  '* Definition echter
  14. CONST ja = "J"                    '* Konstanten
  15.  
  16. '* Vorspann zur Demonstration der Funktion UpCase$
  17. CLS: LOCATE 12, 15
  18. PRINT UpCase$("ein teststring mit den umlauten ä,ö und ü")
  19. DO
  20.   LOCATE 24, 1, 1                 '* Tastaturabfrage
  21.   PRINT "Weitermachen? (J/N) ";   '* mit fußgesteuerter
  22.   CALL JaNein1(jn)                '* Kontrolle
  23.   IF UpCase(jn) = nein THEN PRINT "jn": STOP
  24. LOOP UNTIL UpCase$(jn) = ja
  25.  
  26. '* Hauptprogramm in einer DO/LOOP-Schleife ohne Abbruch-
  27. '* bedingungen. Die Schleife kann nur noch mit "EXIT DO"
  28. '* verlassen werden.
  29. farbe = 7
  30. DO
  31.   COLOR farbe
  32.   FillScreen
  33.   LOCATE 1, 1
  34.   COLOR 7
  35.   ClearKeyBoard
  36.   PRINT "Weitermachen (J/N)? ";
  37.   ch = JaNein2$
  38.   IF INSTR("Nn", ch) THEN PRINT ch: EXIT DO
  39.   farbe = farbe + 1
  40.   IF farbe > 15 THEN farbe = 1
  41. LOOP
  42. END
  43.  
  44. SUB ClearKeyBoard
  45.   DO WHILE INKEY$ <> "" '* kopfgesteuerte LOOP-Schleife
  46.   LOOP                  '* die solange durchlaufen wird,
  47. END SUB                 '* bis der Tastaturpuffer leer ist.
  48.  
  49. SUB FillScreen
  50.   DIM i AS INTEGER, j AS INTEGER
  51.   DIM x AS SINGLE, y AS SINGLE
  52.   CLS
  53.   PRINT "Füllen des Bildschirmes. Benutzt werden"
  54.   PRINT "zwei Schleifen mit ganzzahlige Variablen."
  55.   PRINT "Um zu beginnen, Taste drücken ...";
  56.   LOCATE , , 1: Tastenabfrage
  57.   FOR i = 1 TO 80                '* verschachtelte FOR/NEXT
  58.     FOR j = 1 TO 25              '* Schleifen. Die innere
  59.       LOCATE j, i, 0: PRINT "X"; '* und die äußere Schleife
  60.     NEXT j                       '* dürfen nicht überkreuzt
  61.   NEXT i                         '* werden.
  62.   FOR i = 25 TO 1 STEP -1
  63.     FOR j = 80 TO 1 STEP -1      '* Die selbe Schleife mit
  64.       LOCATE i, j, 0: PRINT " "; '* negativem Schritt
  65.    NEXT j, i
  66.   LOCATE 1, 1
  67.   CLS
  68.   PRINT "Und jetzt das gleiche nochmals mit ";
  69.   PRINT "Laufzeitvariablen einfacher Genauigkeit."
  70.   PRINT "Um zu beginnen, Taste drücken ...";
  71.   LOCATE , , 1: Tastenabfrage
  72.   FOR y = 1 TO 80                '* verschachtelte FOR/NEXT
  73.     FOR x = 1 TO 25              '* Schleifen mit Fließkom-
  74.       LOCATE x, y, 0: PRINT "X"; '* mazahlen einfacher Ge-
  75.     NEXT x                       '* nauigkeit. Die Aus-
  76.   NEXT y                         '* führungsgeschwindigkeit
  77.   FOR y = 25 TO 1 STEP -1        '* ist deutlich geringer.
  78.    FOR x = 80 TO 1 STEP -1
  79.      LOCATE y, x, 0: PRINT " ";
  80.    NEXT x, y
  81.   LOCATE 1, 1
  82. END SUB
  83.  
  84. SUB JaNein1 (ch AS STRING)
  85. '* Ja/Nein-Kontrolle mit DO/LOOP (fußgesteuert)
  86.   DO                            '* Bei DO/LOOP-Konstruktio-
  87.     DO                          '* nen und Tastaturabfragen
  88.       ch = INKEY$               '* mit INSTR-Test müssen
  89.     LOOP UNTIL ch <> ""         '* zwei Abfragen ineinan-
  90.   LOOP UNTIL INSTR("JNjn", ch)  '* dergeschachtelt werden
  91. END SUB
  92.  
  93. FUNCTION JaNein2$
  94. DIM ch AS STRING
  95. '* Ja/Nein-Abfrage mit WHILE/WEND (kopfgesteuert)
  96.   WHILE UCASE$(ch) <> ja AND UCASE$(ch) <> nein
  97.     ch = INKEY$                 '* Bei WHILE/WEND-Schleifen
  98.   WEND                          '* entfällt die innere
  99.   JaNein2$ = ch                 '* Kontrollstruktur.
  100. END FUNCTION
  101.  
  102. SUB Tastenabfrage
  103.   DIM a AS STRING
  104.   ClearKeyBoard
  105.   WHILE a = ""                  '* Warten, bis beliebige
  106.     a = INKEY$                  '* Taste gedrückt wurde.
  107.   WEND
  108. END SUB
  109.  
  110. FUNCTION UpCase$ (InVar AS STRING)
  111. '* UPPER$-Funktion mit Berücksichtigung der
  112. '* deutschen Umlaute
  113. DIM Inter AS STRING, ch AS STRING
  114.   IF LEN(InVar) > 0 THEN        '* Mehrzeilige IF/ELSE/
  115.     Inter = InVar               '* ENDIF-Struktur
  116.     FOR i = 1 TO LEN(Inter)
  117.       ch$ = MID$(InVar, i, 1)
  118.       SELECT CASE ch
  119.         CASE CHR$(97) TO CHR$(122): ch = UCASE$(ch)
  120.         CASE CHR$(132): ch = CHR$(142)
  121.         CASE CHR$(148): ch = CHR$(153)
  122.         CASE CHR$(129): ch = CHR$(154)
  123.       END SELECT
  124.       MID$(Inter, i, 1) = ch
  125.     NEXT i
  126.     UpCase$ = Inter
  127.   ELSE
  128.     InVar = ""
  129.   END IF
  130. END FUNCTION
  131.