home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / maj / 4319 / q4t16c / q4t_demo.bas < prev    next >
BASIC Source File  |  1993-08-10  |  28KB  |  625 lines
  1. '----------------------------------------------------------------------------
  2. '                         **    Q4T-DEMO.BAS    **
  3. '      Demonstration of the capabilities of the Q4Tool Library routines
  4. '     Written for and compiled with Microsoft (R), QuickBASIC  4.00b (C)
  5. '              By R. J. Crouch  -  Jun 90/Jan 92/Jun 92/Apr 93
  6. '                     Copyright  -  1990-93  -  CareWare
  7. '                            All Rights Reserved
  8. '----------------------------------------------------------------------------
  9.  
  10. ' For Q4Tool v.1.6/v.1.6a/v.1.6b/v.1.6c
  11.  
  12. '----------------------------------------------------------------------------
  13. ' Initialize
  14. '----------------------------------------------------------------------------
  15.  
  16. REM $INCLUDE: 'Q4T.BI'                            ' Contains declarations for
  17.                                                   '  Ctr() and Delay()
  18. DEFINT A-Z
  19.  
  20. TYPE RegType                                      ' Necessary for the CALL to
  21.    ax    AS INTEGER                               ' QB's Interrupt() routine
  22.    bx    AS INTEGER                               ' used to clear the screen
  23.    cx    AS INTEGER                               ' at end of demo
  24.    dx    AS INTEGER                               ' Generally placed in the
  25.    bp    AS INTEGER                               ' "$INCLUDE:" file
  26.    si    AS INTEGER                               '
  27.    di    AS INTEGER                               '
  28.    flags AS INTEGER                               '
  29. END TYPE                                          '
  30.                                                   
  31. DIM InReg AS RegType, OutReg AS RegType               ' Typed for Interrupt()
  32. DIM Menu(5, 4) AS STRING                        ' Array for BarMenu() routine
  33. DIM ScrnBuf(8) AS STRING * 4000                          ' Room for 9 screens
  34.                                                          '  w/ option base 0
  35. False = 0: True = NOT False                                           ' Flags
  36. CONST CONT = "Press any key to continue"                            ' Prompts
  37. CONST MCONT = "Left mouse button to continue"                       '
  38.  
  39. Menu(0, 0) = "0303020401"          '<== Contains upper limits of each 2nd dim-
  40.                                       ' ension for each 1st dimension of any
  41. Menu(1, 0) = " Menu Item #1 "         ' menu array.  The field for each value
  42. Menu(1, 1) = " Select Item #1 "       ' is 2 characters in length.
  43. Menu(1, 2) = " Do Item #2     "       '
  44. Menu(1, 3) = " Pick Item #3   "       '     1st Dim      1   2   3   4   5
  45.                                       '
  46. Menu(2, 0) = " Item #2 "              '  # of level 2   03  03  02  04  01
  47. Menu(2, 1) = " #1           "         '  menu items
  48. Menu(2, 2) = " Level 2 - #2 "         '   
  49. Menu(2, 3) = " #3           "         ' 2nd dim. of any menu array must be as
  50.                                       ' large as the largest 1st dim. set.
  51. Menu(3, 0) = " Level #1 Item #3 "     ' ie.  since 1st dim. 4 of Menu() has 4
  52. Menu(3, 1) = " Pick Item #1      "    ' 2nd dim. items - Menu() must be DIMed
  53. Menu(3, 2) = " Show This Item #2 "    ' DIM Menu(5, 4) AS STRING
  54.                                       '             |-- largest number of 2nd
  55. Menu(4, 0) = " Selection #4 "         '                 dimension items
  56. Menu(4, 1) = " Sub Menu Item #1  " '<== The window width of the level 2 menu
  57. Menu(4, 2) = " Sub Item #2       "    ' is determined by the length of ele-
  58. Menu(4, 3) = " Sub Level Item #3 "    ' ment 1 of the 2nd dim.  All strings
  59. Menu(4, 4) = " Sub Menu Item #4  "    ' should be as long as the longest item
  60.                                       ' title.  Spaces at start and end of
  61. Menu(5, 0) = " Quit "                 ' string are not required, but present a
  62. Menu(5, 1) = " Exit Menu Demo "       ' better looking menu when highlighting.
  63.  
  64. b1$ = CHR$(221) + " ": b2$ = " " + CHR$(222)                       ' Brackets
  65. cpyr$ = b1$ + "Copyright - 1990-93 - CareWare" + b2$
  66. mpos1$ = b1$ + "Row ## - Col ##" + b2$                         ' Formats for
  67. mpos2$ = b1$ + "Y ###  -  X ###" + b2$                         '  PRINT USING
  68. buttons = 0
  69. prompt$ = CONT: pctr = Ctr(CONT)
  70.  
  71. 'ON KEY(10) GOSUB Terminate                                 ' For programming
  72. 'KEY(10) ON                                                 '  purposes only
  73.  
  74. '----------------------------------------------------------------------------
  75. 'Title Screen
  76. '----------------------------------------------------------------------------
  77.  
  78.    CALL GetVideo(VMode, VPage, VCol, CStrt, CStp, CAtt)
  79.    COLOR 7, 0, 0: CLS
  80.    CALL DoWindow(1, 3, 25, 76, 103, 5, 0, "Q4Tool Demo - Ver. 1.6c", 2)
  81.    CALL PrtScrn(cpyr$, 25, 24, 103)
  82.    CALL DoWindow(3, 13, 16, 56, 15, 5, 3, prompt$, 3)
  83.    FOR row = 5 TO 14
  84.       READ line$: lctr = Ctr(line$) + 1
  85.       IF row < 8 THEN att = 12 ELSE att = 14
  86.       CALL PrtScrn(line$, row, lctr, att)
  87.    NEXT row
  88.    READ line$
  89.    CALL PrtScrn(line$, row + 1, lctr, 10)
  90.    CALL PrtScrn("█▀▀▐ █ █", 21, 11, 103)
  91.    CALL PrtScrn("█▄▄▐▄█▄█", 22, 11, 103)
  92.    CALL PrtScrn("Software", 23, 11, 103)
  93.    CALL PrtScrn("by  R. J. Crouch", 21, 55, 103)
  94.    CALL PrtScrn("Member", 22, 65, 103)
  95.    CALL PrtScrn(" ssociation of  hareware  rofessionals", 23, 33, 103)
  96.    CALL PrtScrn("A", 23, 33, 96)
  97.    CALL PrtScrn("S", 23, 48, 96)
  98.    CALL PrtScrn("P", 23, 58, 96)
  99.    CALL PutScrn(ScrnBuf(0))
  100.    WHILE INKEY$ = "": WEND                       ' Typical wait for key press
  101.    CALL MouseStatus(have)                         ' Check for mouse interrupt
  102.    IF have THEN                                            ' Ask to use mouse
  103.       CALL DoWindow(7, 16, 12, 49, 12, 1, 0, "", 0)
  104.       CALL MouseVersion(ver$)
  105.       FOR row = 9 TO 14
  106.          READ line$
  107.          lcrt = Ctr(line$)
  108.          CALL PrtScrn(line$, row, lctr, 14)
  109.          IF row = 10 THEN
  110.             CALL PrtScrn(ver$, row, lctr + 26, 10)
  111.             CALL PrtScrn(".", row, lctr + 26 + LEN(ver$), 14)
  112.          END IF
  113.       NEXT row
  114.       finish! = TIMER + 30
  115.       DO
  116.          i$ = UCASE$(INKEY$)                                   ' Wait for key
  117.          now! = TIMER                                          '  or 30 sec.
  118.       LOOP UNTIL i$ = "N" OR i$ = "Y" OR now! > finish!
  119.       IF i$ = "Y" THEN                              ' Initialize mouse driver
  120.          CALL MouseReset(buttons)                       ' Return # of buttons
  121.          IF buttons > 0 THEN
  122.             Mouse = True
  123.             prompt$ = MCONT: pctr = Ctr(MCONT)             ' Use mouse prompt
  124.          ELSE
  125.             Mouse = False
  126.          END IF
  127.       ELSE                                                 ' Mouse not wanted
  128.          Mouse = False
  129.       END IF
  130.       CALL PrtScrn(prompt$, 16, pctr, 10)
  131.       CALL Delay(30, 0, Mouse)
  132.    ELSE                                                   ' No mouse detected
  133.       FOR x = 1 TO 6: READ nul$: NEXT x                ' Skip mouse text data
  134.    END IF
  135.    CALL GetScrn(ScrnBuf(0))                         ' Retrieve opening screen
  136.    IF Mouse THEN CALL PrtScrn(b1$ + prompt$ + b2$, 18, pctr - 2, 15)
  137.    CALL Delay(60, 0, Mouse)
  138.    CLS
  139.    CALL DoWindow(8, 14, 9, 53, 13, 5, 3, prompt$, 3)
  140.    FOR row = 11 TO 13
  141.       READ line$: lctr = Ctr(line$)
  142.       CALL PrtScrn(line$, row, lctr, 15)
  143.    NEXT row
  144.    CALL Delay(60, 0, Mouse)
  145.  
  146. '----------------------------------------------------------------------------
  147. 'Frame types and screen save/restore
  148. '----------------------------------------------------------------------------
  149.  
  150.    COLOR 0, 0, 0: CLS
  151.    col = 0: frm = -1: scrn = -1
  152.    bgd = 0: fgd = 15
  153.    FOR row = 2 TO 14 STEP 3
  154.       col = col + 6: bgd = bgd + 1
  155.       frm = frm + 1: fgd = fgd - 1
  156.       watt = (bgd * 16) + fgd
  157.       CALL DoWindow(row, col, 10, 20, watt, frm, 0, "Window", 2)
  158.       scrn = scrn + 1
  159.       CALL PutScrn(ScrnBuf(scrn))                   ' Screen save w/PutScrn()
  160.    NEXT row
  161.    FOR row = 11 TO 2 STEP -3
  162.       col = col + 6: bgd = bgd + 1
  163.       frm = frm + 1: fgd = fgd - 1
  164.       IF frm = 6 THEN frm = 1
  165.       IF bgd = 9 THEN bgd = 1
  166.       watt = (bgd * 16) + fgd
  167.       CALL DoWindow(row, col, 10, 20, watt, frm, 0, "Q4Tool", 3)
  168.       IF scrn < 8 THEN                             ' Save all but last screen
  169.          scrn = scrn + 1
  170.          CALL PutScrn(ScrnBuf(scrn))             ' Save screens for later use
  171.       END IF
  172.    NEXT row
  173.    FOR row = 3 TO 9
  174.       READ line$
  175.       CALL PrtScrn(line$, row, col + 2, 31)
  176.    NEXT row
  177.    CALL PrtScrn(prompt$, 25, pctr, 10)
  178.    CALL Delay(60, 0, Mouse)
  179.    CALL DoWindow(9, 12, 7, 56, 15, 5, 0, "", 3)
  180.    FOR row = 11 TO 13
  181.       READ line$: lctr = Ctr(line$)
  182.       CALL PrtScrn(line$, row, lctr, 10)
  183.    NEXT row
  184.    CALL Delay(60, 0, Mouse)
  185.    FOR show = 7 TO 0 STEP -1
  186.       CALL GetScrn(ScrnBuf(show))                    ' Retrieve saved screens
  187.    NEXT show
  188.    FOR row = 5 TO 7
  189.       CALL PrtScrn("*  Fast  *", row, 11, 16)
  190.    NEXT row
  191.    CALL Delay(2, 0, Mouse)
  192.    CALL DoWindow(10, 12, 7, 56, 15, 5, 0, prompt$, 3)
  193.    FOR row = 12 TO 13
  194.       READ line$: lctr = Ctr(line$)
  195.       CALL PrtScrn(line$, row, lctr, 10)
  196.    NEXT row
  197.    CALL Delay(60, 0, Mouse)
  198.    FOR show = 1 TO 8
  199.       CALL GetScrn(ScrnBuf(show))                ' Screen restore w/GetScrn()
  200.       CALL Delay(.5, 0, Mouse)                   '  half second delay added
  201.    NEXT show
  202.    CALL PrtScrn("Now a three", 5, 58, 31)
  203.    CALL PrtScrn("second pause", 7, 58, 31)
  204.    CALL Delay(3, 0, Mouse)
  205.    FOR show = 8 TO 0 STEP -1
  206.       CALL GetScrn(ScrnBuf(show))
  207.       CALL Delay(.5, 0, Mouse)
  208.    NEXT show
  209.    CALL DoWindow(2, 6, 10, 20, 116, 5, 0, "Q4Tool", 2)
  210.    CALL PrtScrn("*  Next  *", 5, 11, 112)
  211.    CALL PrtScrn("Shadow Styles", 7, 10, 112)
  212.    CALL PrtScrn(prompt$, 25, pctr, 10)
  213.    CALL Delay(60, 0, Mouse)
  214.  
  215. '----------------------------------------------------------------------------
  216. 'Shadowing
  217. '----------------------------------------------------------------------------
  218.  
  219.    CLS
  220.    CALL DoWindow(1, 1, 25, 80, 57, 5, 0, prompt$, 3)
  221.    CALL DoWindow(2, 21, 3, 38, 112, 1, 0, "", 0)
  222.    CALL DoWindow(6, 41, 18, 35, 17, 0, 0, "", 0)
  223.    READ line$: lctr = Ctr(line$)
  224.    CALL PrtScrn(line$, 3, lctr, 117)
  225.    FOR row = 7 TO 19 STEP 6                           ' print boxes w/shadows
  226.       FOR col = 8 TO 43 STEP 35
  227.          shadow = shadow + 1
  228.          back = back + 1
  229.          watt = (back * 16) + 14
  230.          IF row = 19 THEN                                         ' print x's
  231.             IF col = 8 THEN
  232.                FOR r = row TO row + 4
  233.                   CALL PrtScrn(STRING$(34, "x"), r, col - 3, 62)
  234.                NEXT r
  235.             ELSE
  236.                FOR r = row TO row + 4
  237.                   CALL PrtScrn(STRING$(34, "x"), r, col - 1, 30)
  238.                NEXT r
  239.                back = 3
  240.                watt = (back * 16) + 14
  241.             END IF
  242.          END IF
  243.          CALL DoWindow(row, col, 4, 30, watt, frame, shadow, "", 0)
  244.          frame = frame + 1
  245.          FOR x = row + 1 TO row + 2
  246.             READ line$
  247.             CALL PrtScrn(line$, x, col + 5, back * 16)
  248.          NEXT x
  249.       NEXT col
  250.       back = back + 1
  251.    NEXT row
  252.    CALL PutScrn(ScrnBuf(0))
  253.    CALL Delay(60, 0, Mouse)
  254.    CALL DoWindow(8, 9, 10, 62, 14, 5, 0, prompt$, 3)
  255.    FOR row = 10 TO 14
  256.       READ line$: lctr = Ctr(line$)
  257.       IF row < 12 THEN att = 15 ELSE att = 10
  258.       CALL PrtScrn(line$, row, lctr, att)
  259.    NEXT row
  260.    CALL Delay(60, 0, Mouse)
  261.    CALL GetScrn(ScrnBuf(0))
  262.    CALL DoWindow(11, 12, 7, 57, 11, 5, 0, prompt$, 3)
  263.    FOR row = 13 TO 14
  264.       READ line$
  265.       CALL PrtScrn(line$, row, 18, 15)
  266.    NEXT row
  267.    CALL Delay(60, 0, Mouse)
  268.  
  269. '----------------------------------------------------------------------------
  270. 'MenuDemo
  271. '----------------------------------------------------------------------------
  272.  
  273.    COLOR 1, 1, 0: CLS
  274.    DO
  275.       R1 = 2: R2 = 0
  276.       CALL PrtScrn("Use the arrow keys to highlight and press <Enter> to select.", 12, 10, 31)
  277.       IF Mouse THEN
  278.          CALL PrtScrn("or", 13, 39, 31)
  279.          CALL PrtScrn("Roll your mouse to highlight and press the LEFT button to select.", 14, 8, 31)
  280.       END IF
  281.       shadow = 6                ' the shadowing argument is new with ver. 1.6
  282.       CALL BarMenu(Menu(), 11, 4, 120, 112, 79, shadow, Mouse, R1, R2)
  283.  
  284.       ' Generally placed after this CALL is some type of selectional
  285.       ' trapping.  The following remarked section outlines a brief example
  286.       ' of one type of system.  The number of CASEs required depends on the
  287.       ' number of items per menu level.
  288.       '
  289.       ' SELECT CASE R1                     Level #1
  290.       '    CASE 0
  291.       '       SELECT CASE R2               Level #2
  292.       '          CASE 0
  293.       '             <Esc> key or RIGHT mouse button pressed
  294.       '          CASE ELSE
  295.       '       END SELECT
  296.       '    CASE 1
  297.       '       SELECT CASE R2               Level #2
  298.       '          CASE 1
  299.       '             Do this
  300.       '          CASE 2
  301.       '             Do this instead
  302.       '          Etc...
  303.       '          CASE ELSE
  304.       '       END SELECT
  305.       '    CASE 2
  306.       '       SELECT CASE R2
  307.       '          CASE 1
  308.       '             Now do this
  309.       '          CASE 2
  310.       '             Do this instead
  311.       '          Etc...
  312.       '          CASE ELSE
  313.       '       END SELECT
  314.       '    Etc...
  315.       '    Etc...
  316.       '    CASE ELSE
  317.       ' END SELECT
  318.  
  319.       IF Mouse THEN CALL MouseVisible(0)
  320.       CALL DoWindow(8, 12, 11, 57, 6, 5, 0, prompt$, 3)
  321.       CALL PrtScrn("The following values were returned.", 11, 23, 14)
  322.       CALL PrtScrn("Level 1 menu item is ==>" + STR$(R1), 13, 27, 11)
  323.       CALL PrtScrn("Level 2 menu item is ==>" + STR$(R2), 15, 27, 11)
  324.       CALL Delay(0, 0, Mouse)
  325.       CALL DoWindow(8, 12, 11, 57, 17, 0, 0, "", 0)
  326.    LOOP UNTIL (R1 = 5 AND R2 = 1)
  327.    CLS
  328.    CALL DoWindow(9, 12, 7, 57, 13, 5, 0, prompt$, 3)
  329.    FOR row = 11 TO 12
  330.       READ line$
  331.       CALL PrtScrn(line$, row, 21, 15)
  332.    NEXT row
  333.    CALL Delay(60, 0, Mouse)
  334.  
  335. '----------------------------------------------------------------------------
  336. 'Equipment and System Information
  337. '----------------------------------------------------------------------------
  338.  
  339.    ' Video variables were returned at beginning of Demo using GetVideo()
  340.    CALL GetDrive(DrvTot, CurDrv, CurDir$)
  341.    Avail& = CurDrv
  342.    CALL DriveSpc(Avail&)
  343.    CALL GetDOS(Dver$)
  344.    CALL GetSize("Q4T-DEMO.EXE", FSize&)
  345.    CALL GetComPorts(ComP)
  346.    CALL Get87(got)
  347.    IF got THEN C87$ = "Yes" ELSE C87$ = "No"
  348.    CALL DoWindow(3, 8, 20, 65, 7, 5, 0, "Equipment and System Information", 2)
  349.    CALL PrtScrn(b1$ + prompt$ + b2$, 22, pctr - 2, 7)
  350.    CALL PrtScrn("     The Current Drive:  " + CHR$(CurDrv + 64) + ":", 6, 21, 11)
  351.    CALL PrtScrn("Total Drives Installed: " + STR$(DrvTot), 7, 21, 11)
  352.    CALL PrtScrn("     Current Directory:  " + CurDir$, 8, 21, 11)
  353.    CALL PrtScrn("  Disk Space Available: " + STR$(Avail&) + " Bytes", 9, 21, 11)
  354.    CALL PrtScrn("    Current Video Mode: " + STR$(VMode), 10, 21, 11)
  355.    CALL PrtScrn("    Current Video Page: " + STR$(VPage), 11, 21, 11)
  356.    CALL PrtScrn("     Number of Columns: " + STR$(VCol), 12, 21, 11)
  357.    CALL PrtScrn("     Cursor Start Line: " + STR$(CStrt), 13, 21, 11)
  358.    CALL PrtScrn("      Cursor Stop Line: " + STR$(CStp), 14, 21, 11)
  359.    CALL PrtScrn("      Cursor Attribute: " + STR$(CAtt), 15, 21, 11)
  360.    CALL PrtScrn("   Current DOS Version:  " + Dver$, 16, 21, 11)
  361.    CALL PrtScrn("  Size of Q4T-DEMO.EXE: " + STR$(FSize&) + " Bytes", 17, 21, 11)
  362.    CALL PrtScrn("Number of Serial Ports: " + STR$(ComP), 18, 21, 11)
  363.    CALL PrtScrn(" Coprocessor Installed:  " + C87$, 19, 21, 11)
  364.    CALL Delay(60, 0, Mouse)
  365.    CALL DoWindow(9, 12, 7, 57, 13, 5, 0, prompt$, 3)
  366.    FOR row = 11 TO 12
  367.       READ line$
  368.       CALL PrtScrn(line$, row, 18, 15)
  369.    NEXT row
  370.    CALL Delay(60, 0, Mouse)
  371.    
  372. '----------------------------------------------------------------------------
  373. 'Mouse Services
  374. '----------------------------------------------------------------------------
  375.  
  376.    mver$ = b1$ + "Mouse Driver ver. " + ver$ + "  -  "
  377.    mstat$ = mver$ + "With" + STR$(buttons) + " buttons installed" + b2$
  378.    sctr = Ctr(mstat$)
  379.  
  380.    CLS
  381.    CALL DoWindow(1, 1, 25, 80, 30, 5, 0, "Q4Tool", 2)
  382.    CALL DoWindow(2, 31, 3, 20, 31, 1, 0, "", 0)
  383.    CALL PrtScrn("Mouse Services", 3, 34, 31)
  384.    CALL DoWindow(5, 5, 10, 35, 12, 5, 0, "Mouse State #1", 2)
  385.    CALL DoWindow(7, 14, 3, 18, 12, 1, 0, "", 0)
  386.    CALL DoWindow(5, 42, 10, 35, 12, 5, 0, "Mouse State #2", 2)
  387.    CALL DoWindow(16, 7, 6, 68, 115, 5, 3, "", 0)
  388.    FOR row = 17 TO 20
  389.       READ line$
  390.       CALL PrtScrn(line$, row, 10, 112)
  391.    NEXT row
  392.    CALL PutScrn(ScrnBuf(0))
  393.    IF Mouse THEN
  394.       CALL PrtScrn(mstat$, 25, sctr, 30)
  395.       CALL MouseLimits(6, 6, 13, 38, 1)                 ' -------------------
  396.       CALL MouseLocate(11, 22, 1)                       '
  397.       CALL MouseCursor(9, 7, 30)                        '
  398.       CALL MouseReset(2)                                ' Save mouse state #1
  399.       CALL MouseVisible(1)                              ' Mouse pointer on
  400.       DO
  401.          CALL MouseClick(lft, mid, rgt)                 ' Typical wait for a
  402.       LOOP UNTIL lft OR rgt                             ' mouse button
  403.       IF rgt THEN
  404.          CALL MouseLimits(6, 43, 13, 75, 1)             ' -------------------
  405.          CALL MouseLocate(11, 59, 1)                    '
  406.          CALL MouseCursor(14, 0, 24)                    '
  407.          CALL MouseReset(4)                             ' Save mouse state #2
  408.  
  409.          pos$ = mpos1$: Mode = 1
  410.          DO                                             ' Loop conditional to
  411.             CALL MouseClick(lft, mid, rgt)              ' mouse button
  412.             IF rgt AND switch THEN
  413.                CALL MouseVisible(0)                   ' Turn old cursor off
  414.                CALL MouseReset(5)                     ' Recall mouse state #2
  415.                CALL MouseVisible(1)                   ' Turn new cursor on
  416.                switch = False
  417.             ELSEIF rgt THEN
  418.                CALL MouseVisible(0)                   ' Turn old cursor off
  419.                CALL MouseReset(3)                     ' Recall mouse state #1
  420.                CALL MouseVisible(1)                   ' Turn new cursor on
  421.                CALL PrtScrn("Black Hole", 8, 18, 12)
  422.                switch = True
  423.             END IF
  424.             IF switch THEN                                   ' Mouse state #1
  425.                CALL MouseExclude(7, 14, 9, 31, 1)           ' Black hole area
  426.                CALL MousePosition(mr, mc, 1)                 ' Turn cursor on
  427.                IF mr < 7 OR mr > 9 OR mc < 14 OR mc > 31 THEN ' outside of
  428.                   CALL MouseVisible(1)                        ' excluded area
  429.                END IF
  430.             ELSE                                             ' Mouse state #2
  431.                IF lft THEN                                     ' Toggle modes
  432.                   IF Mode = 0 THEN
  433.                      pos$ = mpos1$: Mode = 1
  434.                   ELSE
  435.                      pos$ = mpos2$: Mode = 0
  436.                   END IF
  437.                END IF
  438.                CALL MousePosition(r, c, Mode)         ' Return mouse position
  439.                LOCATE 14, 50: COLOR 12, 0: PRINT USING pos$; r; c
  440.             END IF
  441.          LOOP UNTIL lft AND switch
  442.       END IF
  443.       CALL MouseVisible(0)
  444.       READ line$, line$
  445.    ELSE                                                 ' Print no mouse text
  446.       CALL PrtScrn("Black Hole", 8, 18, 12)
  447.       CALL DoWindow(21, 7, 4, 68, 12, 1, 0, CONT$, 3)
  448.       FOR row = 22 TO 23
  449.          READ line$: lctr = Ctr(line$)
  450.          CALL PrtScrn(line$, row, lctr, 14)
  451.       NEXT row
  452.       CALL Delay(60, 0, Mouse)
  453.       CALL GetScrn(ScrnBuf(0))
  454.    END IF
  455.    CALL DoWindow(8, 12, 11, 56, 6, 5, 0, prompt$, 3)
  456.    FOR row = 10 TO 16
  457.       READ line$: lctr = Ctr(line$)
  458.       IF row < 12 THEN att = 15 ELSE att = 10
  459.       CALL PrtScrn(line$, row, lctr, att)
  460.    NEXT row
  461.    CALL Delay(60, 0, Mouse)
  462.  
  463. '----------------------------------------------------------------------------
  464. 'Closing
  465. '----------------------------------------------------------------------------
  466.  
  467.    CLS
  468.    CALL DoWindow(1, 1, 25, 80, 71, 5, 0, "Q4Tool Demo - Ver. 1.6c", 2)
  469.    CALL DoWindow(3, 6, 21, 69, 15, 5, 0, "", 3)
  470.    CALL PrtScrn(cpyr$, 25, 24, 71)
  471.    READ line$: lctr = Ctr(line$)
  472.    CALL PrtScrn(line$, 5, lctr, 12)
  473.    FOR row = 7 TO 19
  474.       READ line$: lctr = Ctr(line$)
  475.       CALL PrtScrn(line$, row, lctr, 14)
  476.    NEXT row
  477.    CALL PrtScrn(prompt$, 21, pctr, 10)
  478.    CALL Delay(90, 0, Mouse)
  479.  
  480. '----------------------------------------------------------------------------
  481. Terminate:
  482. '----------------------------------------------------------------------------
  483.   
  484.    IF Mouse THEN CALL MouseReset(0)
  485.  
  486.    ah = 7: al = 0                               ' Example of system Interrupt
  487.    bh = CAtt: bl = 0                            '  to clear a screen (ie. CLS)
  488.    ch = 0: cl = 0                               '  with int 10H function 7H
  489.    dh = 24: dl = 79                             '  (ah = scroll down)
  490.    InReg.ax = (ah * 256) + al                   ' Conversion of high and low
  491.    InReg.bx = (bh * 256) + bl                   '  byte for acceptance by QB
  492.    InReg.cx = (ch * 256) + cl                   '
  493.    InReg.dx = (dh * 256) + dl                   '
  494.    CALL Interrupt(&H10, InReg, OutReg)          ' Returns nothing
  495.  
  496.    SYSTEM                                  ' End program and return to system
  497.  
  498. '----------------------------------------------------------------------------
  499. ' Data items for READ Statement
  500. '----------------------------------------------------------------------------
  501.  
  502.    DATA "Welcome to the world of the"
  503.    DATA "Q4Tool Library [Q4T]"
  504.    DATA "═══════════════════════════"," "
  505.    DATA "This program is set up to demonstrate  the"
  506.    DATA "features of the Q4T Library.  This library"
  507.    DATA "is  designed  to  work with Microsoft (R),"
  508.    DATA "QuickBASIC 4.xx (C).   The source code for"
  509.    DATA "this demo is provided so you  can  examine"
  510.    DATA "the  actual  usage  of these Q4T routines."
  511.    DATA "             Shall we begin?"
  512.    DATA "This  program  detects  the presence of a"
  513.    DATA "mouse driver; version no."
  514.    DATA "Do  you wish to use your mouse throughout"
  515.    DATA "this demonstration?"," "
  516.    DATA "             <Y>es  -  <N>o"
  517.    DATA "First you will see the various windowing"
  518.    DATA "frame  styles and a demonstration of the"
  519.    DATA "screen save and restore routines.       "
  520.    DATA "Q4Tool  offers a"
  521.    DATA "wide variety  of"
  522.    DATA "frame styles."
  523.    DATA "----------------"
  524.    DATA "The window title"
  525.    DATA "can be placed at"
  526.    DATA "top or bottom.  "
  527.    DATA "Each window screen was saved with PutScrn()."
  528.    DATA "We will now use  GetScrn()  and recall those"
  529.    DATA "nine screens.                               "
  530.    DATA "Now  we will add a half second delay and"
  531.    DATA "again recycle through the saved screens."
  532.    DATA "**  Window Shadow Styles  **"
  533.    DATA "left side and bottom"
  534.    DATA "*  black in color  *"
  535.    DATA "right side and bottom"
  536.    DATA "*  black in  color  *"
  537.    DATA "left side and bottom"
  538.    DATA "*   tinted black   *"
  539.    DATA "right side and bottom"
  540.    DATA "*   tinted  black   *"
  541.    DATA "left side and bottom"
  542.    DATA "* shadow character *"
  543.    DATA "right side and bottom"
  544.    DATA "* shadow  character *"
  545.    DATA "So far this demonstration has used  the  following"
  546.    DATA "routines with a combined number of 72 occurrences."," "
  547.    DATA "   MouseStatus() - DoWindow() - PrtScrn()   "
  548.    DATA "   Delay() - PutScrn() - GetScrn() - Ctr()  "
  549.    DATA "Next is a demonstration of the mouse and key"
  550.    DATA "driven pull-down bar menu routine of Q4Tool."
  551.    DATA "Next is a list of equipment and system"
  552.    DATA "information returned by Q4Tool routines."
  553.    DATA "Next will be a demonstration of  the  various"
  554.    DATA "mouse services offered in the Q4Tool Library."
  555.    DATA "The right mouse button will toggle between the separate mouse"
  556.    DATA "states.  While in mouse state #2,  the left mouse button will"
  557.    DATA "toggle  between  modes  for  MousePosition().  While in mouse"
  558.    DATA "state #1, the left mouse button will exit Mouse Services.    "
  559.    DATA "Sorry, but a mouse driver is not detected by this program."
  560.    DATA "A demonstration of the mouse services will not be done."
  561.    DATA "The following routines are used in the mouse"
  562.    DATA "services demonstration.                     ", " "
  563.    DATA "MouseStatus()    MouseReset()     MousePosition()"
  564.    DATA "MouseLocate()    MouseLimits()    MouseVersion() "
  565.    DATA "MouseVisible()   MouseExclude()   MouseCursor()  "
  566.    DATA "MouseClick()                                     "
  567.    DATA "  ==   Q4Tool Library (Q4T)   =="
  568.    DATA "This concludes the short demonstration of the features"
  569.    DATA "offered by the Q4Tool Library.  Nearly  every  routine"
  570.    DATA "in  Q4T  was used in this demo.  Over 2/3 of the lines"
  571.    DATA "of code in this program contain  a  Q4Tool  statement."
  572.    DATA "The  features  offered  in  this library are common to"
  573.    DATA "most programming needs.  The  prototypes  and  a  full"
  574.    DATA "description  of  these  routines are documented in the"
  575.    DATA "file Q4TOOL.DOC.  Information on the object files  and"
  576.    DATA "source codes for the routines in Q4T is also available"
  577.    DATA "in this file.                                         "," "
  578.    DATA "Microsoft is a registered  trademark of the  Microsoft"
  579.    DATA "Corporation.  Good Luck and Enjoy!                    "
  580.  
  581. '============================================================================
  582. '
  583. '      The source code for  this  demonstration  is  quite  simple.  It
  584. '      should, however, give you a better idea as to the practical  use
  585. '      of  the  Q4Tool  Library routines.  Q4T is designed to be a lib-
  586. '      rary containing the routines generally needed most.   The  mouse
  587. '      services, DoWindow, & BarMenu are the backbone of  this library.
  588. '      There's few programs, large  or  small,  that  couldn't  utilize
  589. '      these features.
  590. '
  591. '      The complete Q4Tool Library was originally  distributed  as  the
  592. '      file Q4T16.ZIP and contains the following files:
  593. '
  594. '                Q4T.LIB         Q4T.QLB           Q4T.BI
  595. '                Q4TOOL.DOC      Q4T-DEMO.BAS      Q4T-DEMO.EXE
  596. '                REGISTER.TXT    README.1ST        VENDOR.DOC
  597. '                FILE_ID.DIZ
  598. '
  599. '      Information  on  the availability of the source and object codes
  600. '      for Q4Tool is found in  the  file  Q4TOOL.DOC.  You  can  always
  601. '      obtain the latest version of Q4Tool from CompuServe (R), IBMPRO,
  602. '      LIB 4 (Browse Q4T) or directly from CareWare.
  603. '
  604. '      Q4Tool is copyrighted to the author with all rights reserved and
  605. '      is  distributed  as  a Shareware product.  If you acquire Q4Tool
  606. '      and decide to use its services, beyond a  30 day  trial  period,
  607. '      than a registration fee of $25.00 is required.   This fee,  when
  608. '      paid, entitles you to full usage & support of this product,  and
  609. '      the latest version of Q4Tool and individual QBJ modules on disk.
  610. '
  611. '                                           _______
  612. '                                      ____|__     |                (R)
  613. '      R. J. Crouch                 --|       |    |-------------------
  614. '      CareWare                       |   ____|__  |  Association of
  615. '      10217 Ridge View Dr.           |  |       |_|  Shareware
  616. '      Grass Valley, CA  95945        |__|   o   |    Professionals
  617. '      (916) 477-6024               -----|   |   |---------------------
  618. '      CIS - 74270,516                   |___|___|    MEMBER
  619. '
  620. '
  621. '      Microsoft is registered trademark of the Microsoft Corporation.
  622. '
  623. '============================================================================
  624.  
  625.