home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / heimw_p / box.bas next >
Encoding:
BASIC Source File  |  1990-12-12  |  5.5 KB  |  173 lines
  1. '* =< Listing 4 >========================================= *
  2. '*                          BOX.BAS                        *
  3. '*              (C) 1991 J. Braun & TOOLBOX                *
  4. '*             für Quick-Basic und Basic PDS 7.1           *
  5. '* ======================================================= *
  6.  
  7. DECLARE SUB Answer (y AS INTEGER, x AS INTEGER, _
  8.                     s AS STRING, corr AS STRING, _
  9.                     ch AS STRING)
  10. DECLARE SUB Ausblick ()
  11. DECLARE SUB ClrScr (y1 AS INTEGER, x1 AS INTEGER, _
  12.                     y2 AS INTEGER, x2 AS INTEGER)
  13. DECLARE SUB Frame (y1 AS INTEGER, x1 AS INTEGER, _
  14.                    y2 AS INTEGER, x2 AS INTEGER)
  15. DECLARE SUB Message (head AS STRING, y AS INTEGER, _
  16.                      x AS INTEGER, s AS STRING)
  17. DECLARE SUB Shadow (y1 AS INTEGER, x1 AS INTEGER, _
  18.                     y2 AS INTEGER, x2 AS INTEGER)
  19. DECLARE SUB WriteCharXY (y AS INTEGER, x AS INTEGER, _
  20.                          ch AS STRING, num AS INTEGER)
  21. DECLARE SUB WriteTextXY (y AS INTEGER, x AS INTEGER, _
  22.                          s AS STRING)
  23.  
  24. DIM SHARED TextAttr AS INTEGER
  25. CONST ScrSeg = &HB800              '* für monochrom:  &HB000
  26.  
  27. TextAttr = 7
  28. ClrScr 1, 1, 25, 80
  29. Message "OK-Box", 15, 30, "Alles paletti"
  30. Ausblick
  31. Message "", 20, 15, "Eine Message-Box ohne Header"
  32. yesno$ = "JN"
  33. Answer 3, 10, "Drücken Sie [J/N] ...", yesno$, ans$
  34.  
  35.  
  36. '* ======================================================= *
  37. SUB Answer (y AS INTEGER, x AS INTEGER, s AS STRING, _
  38.             corr AS STRING, ch AS STRING)
  39.   '* Der Prozedur muß ein Zeichensatz übergeben
  40.   '* werden, der die gültige Auswahl beinhaltet
  41.   '*
  42.   '* yesno$ = "JN"
  43.   '* Answer 3, 10, "Drücken Sie [J/N]", yesno$, ans$
  44.   '* IF ans$ = "J" THEN
  45.   '*   ...
  46.   '* END IF
  47.   '* END
  48.   '* Das angewählte Zeichen wird nicht mehr ausgegeben.
  49.  
  50.   Message "Answer", y, x, s
  51.  
  52.   DO
  53.     DO
  54.       ch = UCASE$(INKEY$)
  55.     LOOP UNTIL LEN(ch) > 0
  56.     IF INSTR(1, corr, ch) THEN
  57.       ' WriteCharXY y + 1 , x + LEN(s), ch, 1
  58.     ELSE
  59.       BEEP
  60.     END IF
  61.   LOOP UNTIL INSTR(1, corr, ch)
  62. END SUB
  63.  
  64. '* ======================================================= *
  65. SUB Ausblick
  66.   ClrScr 5, 55, 20, 75
  67.   Frame 5, 55, 20, 75
  68.   Shadow 5, 55, 20, 75
  69.  
  70.   '*   in allen drei Prozeduren die Parameter wegen der
  71.   '*   Übersichtlichkeit ... (und Unabhängigkeit!)
  72.  
  73.   WriteTextXY 5 + 5, 55 + 2, "demnächst in"
  74.   WriteTextXY 5 + 7, 55 + 2, "diesem"
  75.   WriteTextXY 5 + 9, 55 + 2, "Theater .."
  76. END SUB
  77.  
  78. '* ======================================================= *
  79. SUB ClrScr (y1 AS INTEGER, x1 AS INTEGER, _
  80.             y2 AS INTEGER, x2 AS INTEGER)
  81. '*           Löscht einen Bildschirmausschnitt
  82. DIM p AS INTEGER
  83.   FOR p = y1 TO y2
  84.     CALL WriteCharXY(p, x1, CHR$(32), x2 - x1 + 1)
  85.   NEXT p
  86. END SUB
  87.  
  88. '* ======================================================= *
  89. SUB Frame (y1 AS INTEGER, x1 AS INTEGER, _
  90.            y2 AS INTEGER, x2 AS INTEGER)
  91. DIM i AS INTEGER
  92.   ClrScr y1, x1, y2, x2
  93.  
  94.   WriteCharXY y1, x1, CHR$(201), 1                 '*  oben
  95.   WriteCharXY y1, x1 + 1, CHR$(205), x2 - x1 - 2
  96.   WriteCharXY y1, x2 - 1, CHR$(187), 1
  97.  
  98.   FOR i = y1 + 1 TO y2 - 1
  99.      WriteCharXY i, x1, CHR$(186), 1               '* links
  100.      CALL WriteCharXY(i, x2 - 1, CHR$(186), 1)     '* rechts
  101.   NEXT i
  102.  
  103.   WriteCharXY y2, x1, CHR$(200), 1                 '* unten
  104.   WriteCharXY y2, x1 + 1, CHR$(205), x2 - x1 - 2
  105.   WriteCharXY y2, x2 - 1, CHR$(188), 1
  106. END SUB
  107.  
  108. '* ======================================================= *
  109. SUB Message (head AS STRING, y AS INTEGER, x AS INTEGER, _
  110.              s AS STRING)
  111. '* "head" ist die Kopfzeile der Box. Wird der Leerstring
  112. '* als Parameter angegeben, erscheint keine Kopfzeile. Der
  113. '* Kopf wird zentriert.
  114. DIM length AS INTEGER, hlen AS INTEGER
  115.   length = LEN(s) + 4
  116.   Frame y, x, y + 2, x + length
  117.  
  118.   IF head <> "" THEN
  119.     head = " " + head + " "
  120.     hlen = (length - LEN(head)) \ 2
  121.     WriteTextXY y, x + hlen, head
  122.   END IF
  123.  
  124.   WriteTextXY y + 1, x + 2, s
  125.  
  126.   '*  sollte optional sein: der Schatten ...
  127.   Shadow y, x, y + 2, x + length
  128. END SUB
  129.  
  130. '* ======================================================= *
  131. SUB Shadow (y1 AS INTEGER, x1 AS INTEGER, _
  132.             y2 AS INTEGER, x2 AS INTEGER)
  133. '*   "schattiert" den Bildschirmausschnitt. Zwischen dem
  134. '*   Rahmen und dem Bildschirmrand muß noch Platz für den
  135. '*   Schatten sein. Kein Check!!
  136. DIM i AS INTEGER
  137.   FOR i = y1 TO y2
  138.     WriteCharXY i + 1, x2, CHR$(177), 1               '* "▒"
  139.   NEXT i
  140.   WriteCharXY y2 + 1, x1 + 1, CHR$(177), x2 - x1
  141. END SUB
  142.  
  143. '* ======================================================= *
  144. SUB WriteCharXY (y AS INTEGER, x AS INTEGER, ch AS STRING, _
  145.                  num AS INTEGER)
  146. '*  Schreibt ein Zeichen "ch$" an der Stelle "y"/"x"
  147. '*  "num"-mal in den Bildschirmspeicher. Da in Basic keine
  148. '*  absolute Adressierung außer mit PEEK/POKE möglich ist,
  149. '*  muß die Positionierung im Speicher jedesmal berechnet
  150. '*  werden.
  151.   '* Berechnung der Anfangsadresse im Bildschirmspeicher:
  152. DIM Offset AS INTEGER, i AS INTEGER
  153.   Offset = 160 * (y - 1) + x + x - 2
  154.  
  155.   DEF SEG = ScrSeg
  156.   FOR i = Offset TO (Offset + (num - 1) * 2) STEP 2
  157.     POKE i, ASC(ch)
  158.     POKE i + 1, TextAttr
  159.   NEXT i
  160.   DEF SEG
  161. END SUB
  162.  
  163. '* ======================================================= *
  164. SUB WriteTextXY (y AS INTEGER, x AS INTEGER, s AS STRING)
  165. DIM i AS INTEGER
  166.   FOR i = 0 TO LEN(s) - 1
  167.     WriteCharXY y, x + i, MID$(s, i + 1, 1), 1
  168.   NEXT i
  169. END SUB
  170.  
  171. '* ======================================================= *
  172. '*                    Ende von BOX.BAS                     *
  173.