home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / DATABASE / BASWIZ14.ZIP / DEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-02  |  7.1 KB  |  180 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |           BASWIZ  Copyright (c) 1990  Thomas G. Hanlin III           |
  4. '   |                                                                      |
  5. '   |                       The BASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE FUNCTION Center$ (St$)
  10.  
  11.    REM $INCLUDE: 'BASWIZ.BI'
  12.  
  13.    DEFINT A-Z
  14.    Rows = 25: Columns = 80                         ' define display size
  15.    WInit Rows, Columns, ErrCode                    ' initialize VWS
  16.    IF ErrCode THEN                                 ' stop if we couldn't...
  17.       PRINT "Sorry, insufficient memory to run Demo."
  18.       END
  19.    END IF
  20.    FInit 15, ErrCode                               ' initialize file handler
  21.    FOpen "DEMO.DAT", "RT", 256, TextFile, ErrCode  ' open file for Read, Text
  22.    IF ErrCode THEN
  23.       PRINT "Unable to access DEMO.DAT file."
  24.       FDone
  25.       END
  26.    END IF
  27.  
  28.    IF INSTR(COMMAND$, "/B") THEN
  29.       Mono = -1
  30.    ELSE
  31.       GetDisplay Adapter, Mono
  32.    END IF
  33.    WFixColor Mono
  34.  
  35.    Handle0 = 0                                     ' use background handle
  36.    St$ = "Demonstration of The BASIC Wizard's Library"
  37.    WWriteLn Handle0, Center$(St$)
  38.    WWriteLn Handle0, ""
  39.    St$ = "Copyright (c) 1990  Thomas G. Hanlin III"
  40.    WWriteLn Handle0, Center$(St$)
  41.    WWriteLn Handle0, ""
  42.    WWriteLn Handle0, ""
  43.    DO UNTIL FEOF(TextFile)                         ' read text from file and
  44.       WWriteLn Handle0, FReadLn$(TextFile)         ' ...print it to the
  45.    LOOP                                            ' ...virtual screen
  46.    FDone                                           ' terminate file handler
  47.    WLocate Handle0, 25, 1
  48.    St$ = "Press the space bar for a virtual window demonstration."
  49.    WWrite Handle0, Center$(St$)
  50.    WUpdate                                         ' update the display
  51.    DO
  52.    LOOP UNTIL INKEY$ = " "
  53.  
  54.    ' ------------ This sets up the second demo screen --------------
  55.  
  56.    WOpen Rows, Columns, 7, 5, 22, 45, Handle1, ErrCode
  57.    IF ErrCode THEN
  58.       PRINT "I'm sorry, there's not enough memory available!"
  59.       WDone
  60.       END
  61.    END IF
  62.    WCopy Handle0, Handle1                          ' copy text to new window
  63.    WColor Handle0, 0, 2                            ' recolor background
  64.    WClear Handle0                                  ' clear it
  65.    WLocate Handle0, 1, 1                           ' home the cursor
  66.    WWriteLn Handle0, " This is Window #0, the background screen"
  67.    WColor Handle0, 15, 2
  68.    WLocate Handle0, 14, 48
  69.    WWriteLn Handle0, "This is a slow-motion demo!"
  70.    WColor Handle0, 0, 2
  71.    WLocate Handle0, 25, 1
  72.    WWrite Handle0, Center$("Press the <ESC> key to exit")
  73.    WFrame Handle1, 2, 14, 3                        ' set frame (double lines)
  74.    WTitle Handle1, " Window #1 ", 5, 3             ' set title
  75.    WExplode Handle1                                ' "explode" it on
  76.  
  77.    Rows2 = 10: Columns2 = 40
  78.    Row2 = 9: Col2 = 35
  79.    WOpen Rows2, Columns2, Row2, Col2, 17, 70, Handle2, ErrCode
  80.    IF ErrCode THEN
  81.       PRINT "I'm sorry, there's not enough memory available!"
  82.       WDone
  83.       END
  84.    END IF
  85.    WFrame Handle2, 1, 4, 1                         ' set frame (single lines)
  86.    WTitle Handle2, " Window #2 ", 14, 1            ' set title
  87.    WColor Handle2, 7, 1                            ' set colors
  88.    WClear Handle2                                  ' clear to new colors
  89.    WWriteLn Handle2, "Adding virtual windows to"
  90.    WWriteLn Handle2, "your programs uses only about"
  91.    WWriteLn Handle2, "5K RAM, plus extra memory for"
  92.    WWriteLn Handle2, "each window (around 4K for a"
  93.    WWriteLn Handle2, "full 25x80 virtual screen,"
  94.    WWriteLn Handle2, "which is larger than you'll"
  95.    WWriteLn Handle2, "need for most windows)."
  96.    WWriteLn Handle2, ""
  97.    WWriteLn Handle2, ""
  98.    WWrite Handle2, "                  Look Ma, No Hands!"
  99.    WExplode Handle2                                ' "explode" it on
  100.  
  101.    St$ = "Just a little BASIC Wizardry..."         ' a tiny one-line window!
  102.    Rows = 1: Columns = LEN(St$) + 1
  103.    WOpen Rows, Columns, 3, 38, 3, 37 + LEN(St$), Handle3, ErrCode
  104.    IF ErrCode THEN
  105.       PRINT "I'm sorry, there's not enough memory available!"
  106.       WDone
  107.       END
  108.    END IF
  109.    WColor Handle3, 15, 4                           ' set color
  110.    WWrite Handle3, St$                             ' no <CR><LF> or it scrolls
  111.  
  112.    WUpdate                                         ' pop on the micro window
  113.  
  114.    ' ------------- The second screen is on- let's animate it! ------------
  115.  
  116.    Counter1H = 0                     ' for Window #1
  117.    Direction1H = 1
  118.    Counter1V = 0
  119.    Direction1V = 0
  120.    Counter2A = 0                     ' for Window #2
  121.    Counter2B = 0
  122.    Direction2 = 1
  123.    DO
  124.       ' The following four statements do the actual work.  The rest is just --
  125.       ' to calculate the information for the next step in the animation. -----
  126.       WView Handle1, 1 + Counter1V, 1 + Counter1H                ' set viewport
  127.       WPlace Handle2, Row2 - Counter2B, Col2 + Counter2B         ' screen pos'n
  128.       WSize Handle2, Rows2 - Counter2B, Columns2 - Counter2B * 2 ' window size
  129.       WUpdate                                                    ' display it
  130.       Counter2A = Counter2A + 1
  131.       IF (Counter2A AND 1) = 0 THEN
  132.          Counter2A = 0
  133.          Counter2B = Counter2B + Direction2
  134.          IF Counter2B < 1 OR Counter2B > 5 THEN
  135.             Direction2 = -Direction2
  136.          END IF
  137.       END IF
  138.       Counter1H = Counter1H + Direction1H
  139.       Counter1V = Counter1V + Direction1V
  140.       IF Counter1H < 0 THEN
  141.          Counter1H = 0
  142.          Direction1H = 0
  143.          Direction1V = -1
  144.       ELSEIF Counter1H > 39 THEN
  145.          Counter1H = 39
  146.          Direction1H = 0
  147.          Direction1V = 1
  148.       ELSEIF Counter1V < 0 THEN
  149.          Counter1V = 0
  150.          Direction1V = 0
  151.          Direction1H = 1
  152.       ELSEIF Counter1V > 9 THEN
  153.          Counter1V = 9
  154.          Direction1V = 0
  155.          Direction1H = -1
  156.       END IF
  157.       t! = TIMER                     ' these delay a while so we have long
  158.       WHILE t! = TIMER: WEND         ' enough to see what's going on
  159.       t! = TIMER
  160.       WHILE t! = TIMER: WEND
  161.    LOOP UNTIL INKEY$ = CHR$(27)      ' continue until <ESC> is pressed
  162.  
  163.    ' -------------- All done, time to terminate and exit -----------------
  164.  
  165.    WCollapse Handle3                 ' collapse windows in mixed order
  166.    WCollapse Handle1
  167.    WCollapse Handle2
  168.    WDone                             ' terminate VWS
  169.    junk& = SETMEM(999999)            ' give QB its memory back
  170.    END
  171.  
  172. FUNCTION Center$ (St$)        ' ------ used for centering lines on the screen
  173.    WGetVSize 0, Rows, Columns                ' get size of display
  174.    IF LEN(St$) > Columns THEN
  175.       Center$ = LEFT$(St$, Columns)          ' truncate if string is too long
  176.    ELSE
  177.       Center$ = SPACE$((Columns - LEN(St$) + 1) \ 2) + St$  ' center it
  178.    END IF
  179. END FUNCTION
  180.