home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / baswiz / wdemo.bas < prev    next >
BASIC Source File  |  1992-07-05  |  9KB  |  226 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         BASWIZ  Copyright (c) 1990-1992  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   |                       The BASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE FUNCTION FEOF% (Handle%)
  10.    DECLARE FUNCTION FReadLn$ (BYVAL Handle%)
  11.    DECLARE SUB FDone ()
  12.    DECLARE SUB FInit (Handles%, ErrCode%)
  13.    DECLARE SUB FOpen (File$, FMode$, BufferLen%, Handle%, ErrCode%)
  14.    DECLARE SUB GetDisplay (Adapter%, Mono%)
  15.    DECLARE SUB WClear (BYVAL Handle%)
  16.    DECLARE SUB WCollapse (Handle%)
  17.    DECLARE SUB WColor (BYVAL Handle%, BYVAL Fore%, BYVAL Back%)
  18.    DECLARE SUB WCopy (BYVAL FromHandle%, BYVAL ToHandle%)
  19.    DECLARE SUB WDone ()
  20.    DECLARE SUB WExplode (Handle%)
  21.    DECLARE SUB WFixColor (BYVAL Convert%)
  22.    DECLARE SUB WFrame (BYVAL Handle%, BYVAL Frame%, BYVAL Fore%, BYVAL Back%)
  23.    DECLARE SUB WGetVSize (BYVAL Handle%, Rows%, Columns%)
  24.    DECLARE SUB WHidden (BYVAL Handle%, Hidden%)
  25.    DECLARE SUB WHide (BYVAL Handle%, BYVAL Hide%)
  26.    DECLARE SUB WInit (Rows%, Columns%, ErrCode%)
  27.    DECLARE SUB WLocate (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  28.    DECLARE SUB WOpen (Rows%, Columns%, SRow1%, SCol1%, SRow2%, SCol2%, Handle%, ErrCode%)
  29.    DECLARE SUB WPlace (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  30.    DECLARE SUB WShadow (BYVAL Handle%, Shadow$, BYVAL Fore%, BYVAL Back%)
  31.    DECLARE SUB WSize (BYVAL Handle%, BYVAL Rows%, BYVAL Columns%)
  32.    DECLARE SUB WTitle (BYVAL Handle%, Title$, BYVAL Fore%, BYVAL Back%)
  33.    DECLARE SUB WUpdate ()
  34.    DECLARE SUB WView (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  35.    DECLARE SUB WWrite (BYVAL Handle%, St$)
  36.    DECLARE SUB WWriteLn (BYVAL Handle%, St$)
  37.  
  38.  
  39.    DECLARE FUNCTION Center$ (St$)
  40.  
  41.    DEFINT A-Z
  42.    Rows = 25: Columns = 80                         ' define display size
  43.    WInit Rows, Columns, ErrCode                    ' initialize VWS
  44.    IF ErrCode THEN                                 ' stop if we couldn't...
  45.       PRINT "Sorry, insufficient memory to run Demo."
  46.       END
  47.    END IF
  48.    FInit 15, ErrCode                               ' initialize file handler
  49.    FOpen "WDEMO.DAT", "RT", 256, TextFile, ErrCode ' open file for Read, Text
  50.    IF ErrCode THEN
  51.       PRINT "Unable to access WDEMO.DAT file."
  52.       FDone
  53.       END
  54.    END IF
  55.  
  56.    IF INSTR(COMMAND$, "/B") THEN
  57.       Mono = -1
  58.    ELSE
  59.       GetDisplay Adapter, Mono
  60.    END IF
  61.    WFixColor Mono
  62.  
  63.    Handle0 = 0                                     ' use background handle
  64.    St$ = "Demonstration of The BASIC Wizard's Library"
  65.    WWriteLn Handle0, Center$(St$)
  66.    WWriteLn Handle0, ""
  67.    St$ = "Copyright (c) 1990-1992  Thomas G. Hanlin III"
  68.    WWriteLn Handle0, Center$(St$)
  69.    WWriteLn Handle0, ""
  70.    WWriteLn Handle0, ""
  71.    DO UNTIL FEOF(TextFile)                         ' read text from file and
  72.       WWriteLn Handle0, FReadLn$(TextFile)         ' ...print it to the
  73.    LOOP                                            ' ...virtual screen
  74.    FDone                                           ' terminate file handler
  75.    WLocate Handle0, 25, 1
  76.    St$ = "Press the space bar for a virtual window demonstration."
  77.    WWrite Handle0, Center$(St$)
  78.    WUpdate                                         ' update the display
  79.    DO
  80.    LOOP UNTIL INKEY$ = " "
  81.  
  82.    ' ------------ This sets up the second demo screen --------------
  83.  
  84.    WOpen Rows, Columns, 7, 5, 22, 45, Handle1, ErrCode
  85.    IF ErrCode THEN
  86.       PRINT "I'm sorry, there's not enough memory available!"
  87.       WDone
  88.       END
  89.    END IF
  90.    WCopy Handle0, Handle1                          ' copy text to new window
  91.    WColor Handle0, 0, 2                            ' recolor the background
  92.    WClear Handle0                                  ' clear it
  93.    WLocate Handle0, 1, 1                           ' home the cursor
  94.    WWriteLn Handle0, " This is Window #0, the background screen"
  95.    WColor Handle0, 15, 2
  96.    WLocate Handle0, 14, 48
  97.    WWriteLn Handle0, "This is a slow-motion demo!"
  98.    WColor Handle0, 0, 2
  99.    WLocate Handle0, 25, 1
  100.    WWrite Handle0, Center$("Press the <ESC> key to exit")
  101.    WFrame Handle1, 2, 14, 3                        ' set frame (double lines)
  102.    WTitle Handle1, " Window #1 ", 5, 3             ' set title
  103.    WExplode Handle1                                ' "explode" it on
  104.  
  105.    Rows2 = 10: Columns2 = 40
  106.    Row2 = 9: Col2 = 35
  107.    WOpen Rows2, Columns2, Row2, Col2, 17, 70, Handle2, ErrCode
  108.    IF ErrCode THEN
  109.       PRINT "I'm sorry, there's not enough memory available!"
  110.       WDone
  111.       END
  112.    END IF
  113.    WFrame Handle2, 1, 4, 1                         ' set frame (single lines)
  114.    WTitle Handle2, " Window #2 ", 14, 1            ' set title
  115.    WShadow Handle2, CHR$(255), 8, 0                ' set shadow
  116.    WColor Handle2, 7, 1                            ' set colors
  117.    WClear Handle2                                  ' clear to new colors
  118.    WWriteLn Handle2, "Adding virtual windows to"
  119.    WWriteLn Handle2, "your programs uses only about"
  120.    WWriteLn Handle2, "5K RAM, plus extra memory for"
  121.    WWriteLn Handle2, "each window (around 4K for a"
  122.    WWriteLn Handle2, "full 25x80 virtual screen,"
  123.    WWriteLn Handle2, "which is larger than you'll"
  124.    WWriteLn Handle2, "need for most windows)."
  125.    WWriteLn Handle2, ""
  126.    WWriteLn Handle2, ""
  127.    WWrite Handle2, "                  Look Ma, No Hands!"
  128.    WExplode Handle2                                ' "explode" it on
  129.  
  130.    St$ = "Just a little BASIC Wizardry..."         ' a tiny one-line window!
  131.    Rows = 1: Columns = LEN(St$) + 1
  132.    WOpen Rows, Columns, 3, 38, 3, 37 + LEN(St$), Handle3, ErrCode
  133.    IF ErrCode THEN
  134.       PRINT "I'm sorry, there's not enough memory available!"
  135.       WDone
  136.       END
  137.    END IF
  138.    WColor Handle3, 15, 4                           ' set color
  139.    WWrite Handle3, St$                             ' no <CR><LF> or it scrolls
  140.  
  141.    WOpen 2, 10, 16, 14, 17, 23, Handle4, ErrCode
  142.    IF ErrCode THEN
  143.       PRINT "I'm sorry, there's not enough memory available!"
  144.       WDone
  145.       END
  146.    END IF
  147.    WFrame Handle4, 1, 0, 7                         ' set frame (single lines)
  148.    WColor Handle4, 0, 7                            ' set colors
  149.    WClear Handle4                                  ' clear to new colors
  150.    WHide Handle4, 1                                ' hide the window
  151.    WWriteLn Handle4, "  Windows"
  152.    WWrite Handle4, " Can HIDE"
  153.  
  154.    WUpdate                                         ' pop on the micro windows
  155.  
  156.    ' ------------- The second screen is on- let's animate it! ------------
  157.  
  158.    Counter1H = 0                     ' for Window #1
  159.    Direction1H = 1
  160.    Counter1V = 0
  161.    Direction1V = 0
  162.    Counter2A = 0                     ' for Window #2
  163.    Counter2B = 0
  164.    Direction2 = 1
  165.    DO
  166.       ' The following four statements do the main work.  The rest mostly -----
  167.       ' calculates the information for the next step in the animation. -------
  168.       WView Handle1, 1 + Counter1V, 1 + Counter1H                ' set viewport
  169.       WPlace Handle2, Row2 - Counter2B, Col2 + Counter2B         ' screen pos'n
  170.       WSize Handle2, Rows2 - Counter2B, Columns2 - Counter2B * 2 ' window size
  171.       WUpdate                                                    ' display it
  172.       Counter2A = Counter2A + 1
  173.       IF (Counter2A AND 1) = 0 THEN
  174.          Counter2A = 0
  175.          Counter2B = Counter2B + Direction2
  176.          IF Counter2B < 1 OR Counter2B > 5 THEN
  177.             Direction2 = -Direction2
  178.          END IF
  179.       END IF
  180.       Counter1H = Counter1H + Direction1H
  181.       Counter1V = Counter1V + Direction1V
  182.       IF Counter1H < 0 THEN
  183.          Counter1H = 0
  184.          Direction1H = 0
  185.          Direction1V = -1
  186.       ELSEIF Counter1H > 39 THEN
  187.          Counter1H = 39
  188.          Direction1H = 0
  189.          Direction1V = 1
  190.       ELSEIF Counter1V < 0 THEN
  191.          Counter1V = 0
  192.          Direction1V = 0
  193.          Direction1H = 1
  194.          WHidden Handle4, Hidden
  195.          WHide Handle4, NOT Hidden
  196.       ELSEIF Counter1V > 9 THEN
  197.          Counter1V = 9
  198.          Direction1V = 0
  199.          Direction1H = -1
  200.       END IF
  201.       DEF SEG = 0                    ' delay a while so we can see
  202.       t = PEEK(&H46C)                ' what's going on
  203.       WHILE t = PEEK(&H46C): WEND
  204.       t = PEEK(&H46C)
  205.       WHILE t = PEEK(&H46C): WEND
  206.    LOOP UNTIL INKEY$ = CHR$(27)      ' continue until <ESC> is pressed
  207.  
  208.    ' -------------- All done, time to terminate and exit -----------------
  209.  
  210.    WCollapse Handle3                 ' collapse windows in mixed order
  211.    WCollapse Handle1
  212.    WCollapse Handle2
  213.    WCollapse Handle4
  214.    WDone                             ' terminate VWS
  215.    junk& = SETMEM(999999)            ' give QB its memory back
  216.    END
  217.  
  218. FUNCTION Center$ (St$)         ' ------ used for centering lines on the screen
  219.    WGetVSize 0, Rows, Columns                ' get size of display
  220.    IF LEN(St$) > Columns THEN
  221.       Center$ = LEFT$(St$, Columns)          ' truncate if string is too long
  222.    ELSE
  223.       Center$ = SPACE$((Columns - LEN(St$) + 1) \ 2) + St$  ' center it
  224.    END IF
  225. END FUNCTION
  226.