home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / b-window.zip / QBDEMO.BAS < prev    next >
BASIC Source File  |  1988-07-15  |  8KB  |  274 lines
  1.  
  2.  
  3.  
  4.      'QBDEMO.BAS:  Demo of compiled QuickBASIC Version 4 with B-WINDOW
  5.  
  6.      '   Compile this as "QBDEMO.OBJ"
  7.      '   Then link to "QBV4.OBJ" (available, with source code, for $20)
  8.      '            or
  9.      '   Load "QBV4.QLB" when you run QuickBASIC interactively:
  10.      '      QB QBDEMO /LQBV4.QLB
  11.  
  12.  
  13.      ' windowing constants
  14.  
  15.      w.mono% = 0: w.cga% = 1: w.ega% = 2
  16.      w.true% = 1: w.false% = 0: w.error% = 0: w.success% = 1
  17.      ' 6 border types; no border,single line, double line, mixed 1 & 2, block
  18.      w.nobdr% = 0: w.sngln% = 1: w.dbln% = 2:
  19.      w.mxd1% = 3: w.mxd2% = 4: w.blkln% = 5
  20.  
  21.      ' determine if color or monochrome video card
  22.  
  23.      CALL wscrntype(stype%)
  24.      IF stype% = w.mono% THEN
  25.         ' set everything to white-on-black if monochrome board
  26.  
  27.         'window 1    window 2    window 3    window 4
  28.          wbgc1% = 0: wbgc2% = 0: wbgc3% = 0: wbgc4% = 0  ' background color
  29.          bfgc1% = 7: bfgc2% = 7: bfgc3% = 7: bfgc4% = 7  ' foreground color
  30.          bbgc1% = 0: bbgc2% = 0: bbgc3% = 0: bbgc4% = 0  ' background color
  31.          wtc1% = 7:  wtc2% = 7:  wtc3% = 7:  wtc4% = 7   ' window text color
  32.          sfgc1% = 7: sbgc1% = 0                          ' string color
  33.      ELSE
  34.         ' color setup
  35.  
  36.         'window 1   window 2   window 3   window 4
  37.          wbgc1% = 2: wbgc2% = 5: wbgc3% = 7: wbgc4% = 5
  38.          bfgc1% = 5: bfgc2% = 4: bfgc3% = 1: bfgc4% = 2
  39.          bbgc1% = 2: bbgc2% = 4: bbgc3% = 1: bbgc4% = 2
  40.          wtc1% = 7: wtc2% = 7: wtc3% = 0: wtc4% = 14
  41.          sfgc1% = 12: sbgc1% = 1
  42.      END IF
  43.  
  44.      ' initialize windowing. do not forget to do this!
  45.      CALL winit(status%)
  46.      IF status% = w.error% THEN PRINT "initialization error": STOP
  47.  
  48.      ' draw a border on screen
  49.      x% = 8: y% = 5: wid% = 55: hgt% = 7: btype% = w.blkln%
  50.      CALL wborder(status%, x%, y%, wid%, hgt%, btype%)
  51.  
  52.      ' write on 1st screen
  53.      CALL wgotoxy(18, 7)
  54.      CALL wfgcolor(15)
  55.      CALL wwrite("Basic Windowing Toolbox Version 2.3")
  56.      CALL wgotoxy(15, 8)
  57.      CALL wfgcolor(7)
  58.      CALL wwrite("Compiled QuickBASIC Demonstration Program")
  59.      CALL wgotoxy(12, 9)
  60.      CALL wwrite("Source: QBDEMO.BAS        Linked with: QBV4.OBJ")
  61.      CALL wgotoxy(50, 23)
  62.      CALL wwrite("Press any key to continue")
  63.      GOSUB keypress
  64.  
  65.      ' define 4 windows
  66.  
  67.      wid% = 75: hgt% = 15: bdr% = w.true%
  68.      CALL wdef(wnum1%, wid%, hgt%, bdr%)
  69.      wid% = 70: hgt% = 20
  70.      CALL wdef(wnum2%, wid%, hgt%, bdr%)
  71.      wid% = 55: hgt% = 20
  72.      CALL wdef(wnum3%, wid%, hgt%, bdr%)
  73.      wid% = 38: hgt% = 12
  74.      CALL wdef(wnum4%, wid%, hgt%, bdr%)
  75.  
  76.      ' open window 1
  77.  
  78.      x% = 0: y% = 9: btype% = w.dbln%: clr% = w.true%
  79.      CALL wopen(status%, wnum1%, x%, y%, clr%, wbgc1%, btype%, bfgc1%, bbgc1%)
  80.  
  81.      ' write in window 1
  82.  
  83.      CALL wfgcolor(wtc1%)
  84.      CALL wbgcolor(wbgc1%)
  85.      CALL wgotoxy(0, 2)
  86.      CALL wwrite("Text can be ")
  87.      CALL wfgcolor(wtc1% + 16)
  88.      CALL wwrite("blinking, ")
  89.      CALL wfgcolor(15 + 16)
  90.      CALL wwrite("blinking bright, ")
  91.      CALL wfgcolor(wtc1%)
  92.      CALL wwrite("or just ")
  93.      CALL wfgcolor(15)
  94.      CALL wwrite("bright. ")
  95.      CALL wfgcolor(wtc1%)
  96.      CALL wwrite("All graphics card colors are also available. ")
  97.      IF stype% <> w.mono% THEN
  98.         ' display colors
  99.         x% = 6: y% = 5
  100.         FOR y% = 5 TO 7
  101.            CALL wgotoxy(x%, y%)
  102.            FOR i% = 1 TO 15
  103.               CALL wfgcolor(i%)
  104.               CALL wwrite("████") 'ascii 219, which has no background
  105.            NEXT i%
  106.         NEXT y%
  107.      END IF
  108.      CALL wgotoxy(24, 10)
  109.      CALL wwrite("Press any key to continue")
  110.      GOSUB keypress
  111.  
  112.      ' open window 2
  113.  
  114.      x% = 9: y% = 1
  115.      CALL wopen(status%, wnum2%, x%, y%, clr%, wbgc2%, btype%, bfgc2%, bbgc2%)
  116.  
  117.      ' write lots of text in window 2
  118.  
  119.      CALL wfgcolor(wtc2%)
  120.      CALL wbgcolor(wbgc2%)
  121.      FOR i = 1 TO 70
  122.         CALL wwrite("Scrolling ")
  123.         CALL wfgcolor(15 + 16)
  124.         CALL wwrite("up ")
  125.         CALL wfgcolor(wtc2%)
  126.         CALL wwrite("in the window ")
  127.      NEXT i
  128.      dir% = 0: num% = 5
  129.      CALL wscroll(dir%, num%)
  130.      CALL wgotoxy(0, 17)
  131.      CALL wwrite("Press any key to continue")
  132.      GOSUB keypress
  133.  
  134.      ' open window 3
  135.  
  136.      x% = 0: y% = 3: btype% = w.mxd1%: clr% = w.true%
  137.      CALL wopen(status%, wnum3%, x%, y%, clr%, wbgc3%, btype%, bfgc3%, bbgc3%)
  138.  
  139.      ' write to window 3
  140.  
  141.      CALL wfgcolor(wtc3%)
  142.      CALL wbgcolor(wbgc3%)
  143.      CALL wgotoxy(1, 1)
  144.      CALL wwrite("You can define and edit fields:")
  145.      x% = 5
  146.      CALL wgotoxy(x%, 2)
  147.      CALL wwrite("- <CR> to finish with each field")
  148.      CALL wgotoxy(x%, 3)
  149.      CALL wwrite("- Arrow keys to move left and right")
  150.      CALL wgotoxy(x%, 4)
  151.      CALL wwrite("- HOME moves to string start")
  152.      CALL wgotoxy(x%, 5)
  153.      CALL wwrite("- END moves to string end")
  154.      CALL wgotoxy(x%, 6)
  155.      CALL wwrite("- DEL erases cursor position")
  156.      CALL wgotoxy(x%, 7)
  157.      CALL wwrite("- BACKSPACE deletes to left")
  158.      CALL wgotoxy(x%, 8)
  159.      CALL wwrite("- Auto erase if first key is text")
  160.      ' define strings with optional initial value
  161.      s1$ = "Kenneth Page         "
  162.      s2$ = "59 Beech Street      "
  163.      s3$ = "Springfield, AZ 85999"
  164.      CALL wgotoxy(1, 10): CALL wwrite("Name:")
  165.      CALL wgotoxy(1, 12): CALL wwrite("Addr:")
  166.      CALL wgotoxy(1, 14): CALL wwrite("Addr:")
  167.      ' set up string display colors
  168.      CALL wfgcolor(sfgc1%)
  169.      CALL wbgcolor(sbgc1%)
  170.      CALL wgotoxy(7, 10): CALL wwrite(s1$)
  171.      CALL wgotoxy(7, 12): CALL wwrite(s2$)
  172.      CALL wgotoxy(7, 14): CALL wwrite(s3$)
  173.      ' size of editing field on screen is string length-1,
  174.      ' so have at least one extra trailing space
  175.      s1$ = s1$ + " ": s2$ = s2$ + " ": s3$ = s3$ + " "
  176.      CALL wgotoxy(7, 10): CALL wgetstr(s1$)
  177.      CALL wgotoxy(7, 12): CALL wgetstr(s2$)
  178.      CALL wgotoxy(7, 14): CALL wgetstr(s3$)
  179.      ' get rid of trailing NULL in strings
  180.      s1$ = LEFT$(s1$, INSTR(s1$, CHR$(0)) - 1)
  181.      s2$ = LEFT$(s2$, INSTR(s2$, CHR$(0)) - 1)
  182.      s3$ = LEFT$(s3$, INSTR(s3$, CHR$(0)) - 1)
  183.      CALL wfgcolor(wtc3%)
  184.      CALL wbgcolor(wbgc3%)
  185.      CALL wgotoxy(20, 17)
  186.      CALL wwrite("Press any key to continue")
  187.      GOSUB keypress
  188.  
  189.      ' open window 4
  190.  
  191.      x% = 30: y% = 6: btype% = w.blkln%: clr% = w.true%
  192.      CALL wopen(status%, wnum4%, x%, y%, clr%, wbgc4%, btype%, bfgc4%, bbgc4%)
  193.  
  194.      ' write to window 4
  195.  
  196.      CALL wfgcolor(wtc4%)
  197.      CALL wbgcolor(wbgc4%)
  198.      CALL wgotoxy(0, 1)
  199.      CALL wwrite("Type in characters.  The lines auto-")
  200.      CALL wgotoxy(0, 2)
  201.      CALL wwrite("matically wrap-around when the right")
  202.      CALL wgotoxy(0, 3)
  203.      CALL wwrite("margin is reached.  Carriage return")
  204.      CALL wgotoxy(0, 4)
  205.      CALL wwrite("causes scrolling. Press ")
  206.      CALL wfgcolor(15)
  207.      CALL wwrite("ESC ")
  208.      CALL wfgcolor(wtc4%)
  209.      CALL wwrite("to quit")
  210.      CALL wgotoxy(0, 6)
  211.      v$ = "x"
  212.      WHILE (ASC(v$) <> 27)   '27 = ASCII value for ESCAPE character
  213.        GOSUB keypress
  214.        IF ASC(v$) <> 27 THEN
  215.           ' character was <CR>? (ASCII 13)
  216.           IF ASC(v$) <> 13 THEN
  217.              CALL wwrite(v$)
  218.           ELSE
  219.              dir% = 0: num% = 1: CALL wscroll(dir%, num%)
  220.              CALL wgetcy(y%)
  221.              x% = 0: CALL wgotoxy(x%, y%)
  222.           END IF
  223.        END IF
  224.      WEND
  225.  
  226.      ' close window 4
  227.  
  228.      CALL wclose
  229.      GOSUB keypress
  230.  
  231.      ' close window 3
  232.  
  233.      CALL wclose
  234.      GOSUB keypress
  235.  
  236.      ' close window 2
  237.  
  238.      CALL wclose
  239.      GOSUB keypress
  240.  
  241.      ' reopen window 2 at a different location
  242.  
  243.      x% = 0: y% = 5: btype% = w.mxd2%: clr% = w.false%
  244.      CALL wopen(status%, wnum2%, x%, y%, clr%, wbgc2%, btype%, bfgc2%, bbgc2%)
  245.      GOSUB keypress
  246.  
  247.      ' close window 2 again
  248.  
  249.      CALL wclose
  250.      GOSUB keypress
  251.  
  252.      ' close window 1
  253.  
  254.      CALL wclose
  255.      GOSUB keypress
  256.  
  257.      ' clear screen
  258.  
  259.      CALL winit(status%)
  260.      END
  261.  
  262.      '***************
  263.      ' KEYPRESS
  264.      ' subroutine that waits for the next key press
  265.      '
  266.  
  267. keypress:
  268.        v$ = ""
  269.        WHILE v$ = ""
  270.           v$ = INKEY$
  271.        WEND
  272.        RETURN
  273.  
  274.