home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / window / qbaswin / qbaswin.bas
Encoding:
BASIC Source File  |  1991-10-17  |  7.2 KB  |  257 lines
  1. '***************************************************************************
  2. '                     QBASWIN Demo Program for QBASIC
  3.  
  4. '                               Written by
  5.  
  6. '                   John Strong, StrongSoft Engineering
  7. '                           3155 SW 178th Avenue
  8. '                             Aloha, OR 97006
  9.  
  10. '                    *This is Public Domain Software*
  11. '
  12. '  To use this routine in your own programs, cut and paste the code between
  13. '  the $$$ bars into your own program.
  14. '***************************************************************************
  15.  
  16. '------- Subprocedure declarations --------
  17.  
  18. DECLARE SUB intro (prog1%())
  19. DECLARE SUB demo1 (prog1%())
  20. DECLARE SUB demo2 (prog1%())
  21. DECLARE SUB tutorial (prog1%())
  22. DECLARE SUB OuttaHere (prog1%())
  23.  
  24. '                      $$$$$$$$$$$$$$$$$$$$$$$$$
  25. '$$$$$$$$$$$$$$$$$$$$$$$$ Start cutting here! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
  26. '                      $$$$$$$$$$$$$$$$$$$$$$$$$
  27.  
  28. '-------- Define an integer array to hold routine ---------
  29.  
  30. DEFINT A-Z
  31. DIM prog1(270 / 2)
  32.  
  33. '-------- Load the machine language program into an integer array --------
  34.  
  35. DEF SEG = VARSEG(prog1(0))
  36. FOR i = 0 TO 269
  37.         READ D$
  38.         POKE i, VAL("&H" + D$)
  39. NEXT
  40. DEF SEG
  41.  
  42. prog1:
  43.  
  44. DATA 55,8B,EC,83,EC,E,53,51,6,57,B9,7,0,BF,0,0,8B,5B,6,8B,7,48,89,43,F2,47,47
  45. DATA E2,F3,FF,46,F6,FF,46,F4,FF,46,F2,BB,0,B0,A1,10,0,25,30,0,3D,30,0,74,3,BB
  46. DATA 0,B8,8E,C3,8B,5E,FE,B8,A0,0,F7,E3,8B,5E,FC,D1,E3,3,C3,8B,F8,57,8B,46,F8
  47. DATA 8B,5E,FC,2B,C3,40,8B,D8,53,8B,46,FA,8B,56,FE,2B,C2,40,8B,C8,51,BA,0,0,8A
  48. DATA 66,F6,B0,20,83,7E,F4,0,74,5,B0,C4,BA,1,0,51,8B,CB,83,7E,F4,0,74,8,50,B0
  49. DATA B3,AB,83,E9,1,58,F3,AB,83,7E,F4,0,74,8,50,83,EF,2,B0,B3,AB,58,83,FA,0,75
  50. DATA E,83,7E,F2,0,74,8,50,B0,8,47,AA,4F,4F,58,2B,FB,2B,FB,81,C7,A0,0,59,B0,20
  51. DATA 83,7E,F4,0,74,7,83,F9,2,75,2,B0,C4,BA,0,0,E2,AF,83,7E,F2,0,74,B,8B,CB,B0
  52. DATA 8,83,C7,2,47,AA,E2,FC,83,7E,F4,0,74,27,59,5B,5F,B0,DA,AB,3,FB,3,FB,83,EF
  53. DATA 4,B0,BF,AB,50,B8,A0,0,49,F7,E1,3,F8,58,83,EF,2,B0,D9,AB,2B,FB,2B,FB,B0
  54. DATA C0,AB,5F,7,59,5B,8B,E5,5D,CA,E
  55.  
  56. '                      $$$$$$$$$$$$$$$$$$$$$$$$$
  57. '$$$$$$$$$$$$$$$$$$$$$$$$ Stop cutting here! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
  58. '                      $$$$$$$$$$$$$$$$$$$$$$$$$
  59.  
  60.  
  61. '-------- Begin the demo ---------
  62.  
  63. intro prog1()
  64. demo1 prog1()
  65. demo2 prog1()
  66. tutorial prog1()
  67. OuttaHere prog1()
  68.  
  69. END
  70.  
  71. '------------ Data ----------------
  72.  
  73. tutorial:
  74.  
  75. DATA "To create a window, one only needs to use CALL ABSOLUTE."
  76. DATA "The call requires 7 arguments, plus the starting offset,"
  77. DATA "which should always be 0."
  78. DATA ""
  79. DATA "You must first give the routine the coordinates of the upper
  80. DATA "left and lower right corners: ULR, ULC, LRR, LRC (Upper left"
  81. DATA "row, upper left column, etc).  The fifth argument is the attribute,
  82. DATA "a value specifying the foreground color and background color.  It
  83. DATA "is given by the formula: background*16+foreground.  For bright
  84. DATA "white (15) on blue (1), the attribute would be 31.  The sixth and
  85. DATA "seventh arguments are the frame and shadow flags, respectively."
  86. DATA "These flags simply determine whether these features are displayed:
  87. DATA "1 = yes, 0 = no."
  88. DATA ""
  89. DATA "For example, this very window could be created with:"
  90. DATA ""
  91. DATA "DEG SEG = VARSEG(prog1(0))  'address of array holding routine"
  92. DATA "CALL ABSOLUTE(2, 5, 23, 75, 79, 1, 1, 0)
  93. DATA "DEF SEG"
  94.  
  95. SUB demo1 (prog1())
  96.  
  97.         RANDOMIZE TIMER
  98.         ulr = 14
  99.         ulc = 54
  100.         lrr = 22
  101.         lrc = 78
  102.         frame = 1
  103.         shadow = 1
  104.         DEF SEG = VARSEG(prog1(0))
  105.         FOR i = 1 TO 7
  106.                 bg = INT(RND * 8)
  107.                 fg = INT(RND * 16)
  108.                 attr = bg * 16 + fg
  109.                 CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  110.                 ulr = ulr - 2
  111.                 lrr = lrr - 2
  112.                 ulc = ulc - 8
  113.                 lrc = lrc - 8
  114.                 SOUND 880, .1
  115.                 x! = TIMER
  116.                 WHILE TIMER = x!: WEND
  117.         NEXT
  118.         DEF SEG
  119.         COLOR 15, bg
  120.         LOCATE 4, 8
  121.         PRINT "QBWINDOWS are instant,"
  122.         LOCATE 5, 8
  123.         PRINT "featuring transparent"
  124.         LOCATE 6, 8
  125.         PRINT "shadows and a frame!"
  126.         LOCATE 9, 8
  127.         PRINT "Hit any key..."
  128.         SLEEP
  129.         COLOR 7, 1
  130.         CLS
  131.         EXIT SUB
  132.  
  133.  
  134. END SUB
  135.  
  136. SUB demo2 (prog1())
  137.        
  138.         WHILE INKEY$ <> "": WEND
  139.         DEF SEG = VARSEG(prog1(0))
  140.         x! = TIMER
  141.         FOR i = 1 TO 100
  142.                 ulr = INT(RND * 10) + 2
  143.                 lrr = ulr + INT(RND * 9) + 3
  144.                 ulc = INT(RND * 40) + 2
  145.                 lrc = ulc + INT(RND * 19) + 20
  146.                 bg = INT(RND * 8)
  147.                 fg = INT(RND * 16)
  148.                 attr = bg * 16 + fg
  149.                 frame = 1
  150.                 shadow = 1
  151.                 CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  152.                 SOUND 400 + i * 10, .1
  153.                 SOUND 0, .1
  154.         NEXT
  155.         period! = TIMER - x!
  156.         ulr = 8
  157.         ulc = 25
  158.         lrr = 17
  159.         lrc = 55
  160.         attr = 31
  161.         CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  162.         DEF SEG
  163.         LOCATE 10, 27
  164.         PRINT "Phew!  That was one hundred"
  165.         LOCATE 11, 27
  166.         PRINT "windows in only "; period!
  167.         LOCATE 12, 27
  168.         PRINT "seconds! "
  169.         LOCATE 14, 27
  170.         PRINT "Hit any key..."
  171.         SLEEP
  172.  
  173. END SUB
  174.  
  175. SUB intro (prog1())
  176.        
  177.         'Set background color so that shadow is visible.
  178.         COLOR 7, 1      'white on blue
  179.         CLS
  180.        
  181.         LOCATE 2, 5: PRINT "Get ready for..."
  182.         SLEEP 1
  183.  
  184.         ulr = 5
  185.         ulc = 10
  186.         lrr = 20
  187.         lrc = 70
  188.         attr = 64 + 15
  189.         frame = 1
  190.         shadow = 1
  191.         DEF SEG = VARSEG(prog1(0))
  192.         CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  193.         DEF SEG
  194.         COLOR 15, 4
  195.         LOCATE 8, 28: PRINT "Pop-up windows in QBASIC!"
  196.         LOCATE 16, 28: PRINT "Written by John C. Strong"
  197.         COLOR 4, 7
  198.         LOCATE 19, 32: PRINT " Hit any key..."
  199.         SLEEP
  200.         COLOR 7, 1
  201.         CLS
  202.  
  203. END SUB
  204.  
  205. SUB OuttaHere (prog1())
  206.        
  207.         COLOR 7, 1
  208.         ulr = 14
  209.         ulc = 48
  210.         lrr = 18
  211.         lrc = 72
  212.         attr = 2 * 16 + 15
  213.         frame = 1
  214.         shadow = 1
  215.         DEF SEG = VARSEG(prog1(0))
  216.         CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  217.         DEF SEG
  218.         COLOR 15, 2
  219.         LOCATE 16, 50: PRINT "Hit any key to quit"
  220.         SLEEP
  221.         COLOR 7, 0
  222.         CLS
  223.  
  224.  
  225. END SUB
  226.  
  227. SUB tutorial (prog1())
  228.  
  229.         COLOR 7, 1
  230.         CLS
  231.         ulr = 2
  232.         ulc = 5
  233.         lrr = 23
  234.         lrc = 75
  235.         attr = 64 + 15
  236.         frame = 1
  237.         shadow = 1
  238.         DEF SEG = VARSEG(prog1(0))
  239.         CALL absolute(ulr, ulc, lrr, lrc, attr, frame, shadow, 0)
  240.         DEF SEG
  241.         COLOR 4, 7
  242.         LOCATE 2, 35
  243.         PRINT " Tutorial "
  244.         RESTORE tutorial
  245.         COLOR 14, 4
  246.         FOR i = 1 TO 19
  247.                 READ lin$
  248.                 LOCATE i + 2, 7
  249.                 PRINT lin$
  250.         NEXT
  251.         COLOR 4, 7
  252.         LOCATE 23, 34
  253.         PRINT " Hit any key "
  254.         SLEEP
  255. END SUB
  256.  
  257.