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