home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / QDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-08  |  13.5 KB  |  404 lines
  1. ' ──────────────────────────────────────────────────────────────────────────
  2. '
  3. '                            Q D E M O . B A S
  4. '
  5. '  This program was written to demonstrate (and hopefully sell) the QBSCR
  6. '  Screen Routines.  It is an excellent resource for learning as well,
  7. '  since its source code makes use of most of the Screen Routines.
  8. '
  9. '  Note that this source code, the executable, and all associated document-
  10. '  ation are copyright (c) 1992 by Tony Martin.
  11. '
  12. ' ──────────────────────────────────────────────────────────────────────────
  13. '
  14. '  To correctly compile this code to an executable, you need the following
  15. '  files available:  QDEMO.BAS
  16. '                    QDEMO_A.BAS
  17. '                    QDEMO_B.BAS
  18. '                    QDEMO_C.BAS
  19. '                    QDEMO_D.BAS
  20. '                    QDEMO_E.BAS
  21. '                    QDEMO_F.BAS
  22. '                    QBSCR20.QLB
  23. '                    QBSCR20.LIB
  24. '                    QBSCR.INC
  25. '                    MOUSE.BI
  26. '                    QDEMO.MAK
  27. '
  28. '  To load this program into the QuickBASIC environment and have it run
  29. '  properly, make sure the above files are all available, and issue the
  30. '  followng DOS command:
  31. '
  32. '                           QB QDEMO /L QBSCR20
  33. '
  34. '  This will load the QDEMO program, all its source files (assuming the
  35. '  QDEMO.MAK file is available), and will make the QBSCR20.QLB library
  36. '  available for the program to use.
  37. '
  38. ' ──────────────────────────────────────────────────────────────────────────
  39.  
  40. ' ──────────────────────────────────────────────────────────────────────────
  41. '  Include any program-specific constants here.
  42. ' ──────────────────────────────────────────────────────────────────────────
  43. CONST NUMMENUS% = 7
  44. CONST MAXITEMS% = 6
  45. CONST SAVEFILE = "QDEMO.TMP"
  46.  
  47. ' ──────────────────────────────────────────────────────────────────────────
  48. '  Include the constants, types, and declare statements for the QBSCR Screen
  49. '  routines, as well as the mouse routines.
  50. ' ──────────────────────────────────────────────────────────────────────────
  51. '$INCLUDE: 'qbscr.inc'
  52. '$INCLUDE: 'mouse.bi'
  53.  
  54. ' ──────────────────────────────────────────────────────────────────────────
  55. '  Place all local declare statements here.
  56. ' ──────────────────────────────────────────────────────────────────────────
  57. DECLARE SUB Initialize ()
  58. DECLARE SUB Interface ()
  59. DECLARE SUB MainMenu ()
  60. DECLARE SUB Quit ()
  61.  
  62. ' From QDEMO_A.BAS
  63. DECLARE FUNCTION QuitVerification% ()
  64. DECLARE SUB OpeningScreen ()
  65.  
  66. ' From QDEMO_B.BAS
  67. DECLARE SUB BrightBacks ()
  68. DECLARE SUB GetForeBack ()
  69. DECLARE SUB GeneralInfo ()
  70. DECLARE SUB OrderingInfo ()
  71. DECLARE SUB About ()
  72. DECLARE SUB EgaVgaColors ()
  73.  
  74. ' From QDEMO_C.BAS
  75. DECLARE SUB Info3D ()
  76. DECLARE SUB Buttons3D ()
  77. DECLARE SUB Boxes3D ()
  78. DECLARE SUB MenuDemo ()
  79.  
  80. ' From QDEMO_D.BAS
  81. DECLARE SUB EditDemo ()
  82. DECLARE SUB VerificationDemo ()
  83. DECLARE SUB ListDemo ()
  84. DECLARE SUB EventsDemo ()
  85.  
  86. ' From QDEMO_E.BAS
  87. DECLARE SUB MouseMovement ()
  88. DECLARE SUB FontsDemo ()
  89.  
  90. ' From QDEMO_F.BAS
  91. DECLARE SUB DisplayScreensDemo ()
  92. DECLARE SUB WindowsDemo ()
  93. DECLARE SUB ButtonStatusDemo ()
  94. DECLARE SUB MouseInfoDemo ()
  95. DECLARE SUB SensitivityDemo ()
  96.  
  97.  
  98. ' ──────────────────────────────────────────────────────────────────────────
  99. '  List data shared between modules.  Always keep this to a bare minimum.
  100. ' ──────────────────────────────────────────────────────────────────────────
  101. COMMON SHARED kolor%
  102. COMMON SHARED mouseExists%
  103. COMMON SHARED mouseState%
  104.  
  105. DIM SHARED cursorRow%
  106.  
  107. ' ────────────────────────────────────────────────────────────────────────
  108. '  Allocate enough stack space so that we can use our VGA font routines
  109. '  later in the demo.
  110. ' ────────────────────────────────────────────────────────────────────────
  111. CLEAR , , 8192
  112.  
  113. ' ──────────────────────────────────────────────────────────────────────────
  114. '  Initialize any data that may require it.
  115. ' ──────────────────────────────────────────────────────────────────────────
  116. Initialize
  117.  
  118. ' ──────────────────────────────────────────────────────────────────────────
  119. '  Display the opening screen for the demo.
  120. ' ──────────────────────────────────────────────────────────────────────────
  121. OpeningScreen
  122.  
  123. ' ──────────────────────────────────────────────────────────────────────────
  124. '  Draw the basic user interface.
  125. ' ──────────────────────────────────────────────────────────────────────────
  126. Interface
  127.  
  128. ' ──────────────────────────────────────────────────────────────────────────
  129. '  Call the main menu routine.  This handles all user actions and kicks off
  130. '  all commands to the program.
  131. ' ──────────────────────────────────────────────────────────────────────────
  132. MainMenu
  133.  
  134. ' ──────────────────────────────────────────────────────────────────────────
  135. '  At this point, the MainMenu function is finished, and we are done here.
  136. '  Call the Quit routine to clean up and exit.
  137. ' ──────────────────────────────────────────────────────────────────────────
  138. Quit
  139.  
  140. ' ──────────────────────────────────────────────────────────────────────────
  141. '  Bye bye!
  142. ' ──────────────────────────────────────────────────────────────────────────
  143. END
  144.  
  145. SUB Initialize
  146.  
  147.     ' ────────────────────────────────────────────────────────────────────────
  148.     '  This SUBprogram initializes any settings that may need to be determined
  149.     '  right away, such as color capability and mouse presence.
  150.     ' ────────────────────────────────────────────────────────────────────────
  151.  
  152.     ' ────────────────────────────────────────────────────────────────────────
  153.     '  If we can use color, make sure the whole program knows it.
  154.     ' ────────────────────────────────────────────────────────────────────────
  155.     IF ColorChk THEN
  156.         kolor% = TRUE
  157.     ELSE
  158.         kolor% = FALSE
  159.     END IF
  160.  
  161.     ' ────────────────────────────────────────────────────────────────────────
  162.     '  If a mouse is around, then make sure we know it.
  163.     ' ────────────────────────────────────────────────────────────────────────
  164.     mouseExists% = MouseInit%
  165.  
  166.     ' ────────────────────────────────────────────────────────────────────────
  167.     '  Save the existing screen for redisplay later when we exit.
  168.     ' ────────────────────────────────────────────────────────────────────────
  169.     IF (GetDiskFreeSpace(0) > 4096) THEN
  170.         GetScreen SAVEFILE
  171.     END IF
  172.  
  173.     ' ────────────────────────────────────────────────────────────────────────
  174.     '  Save cursor row.
  175.     ' ────────────────────────────────────────────────────────────────────────
  176.     cursorRow% = CSRLIN
  177.  
  178. END SUB
  179.  
  180. SUB MainMenu
  181.  
  182.     ' ────────────────────────────────────────────────────────────────────────
  183.     '  This routine is a high-level sub that runs the menu and kicks off other
  184.     '  routines based on what the user does in the menu.  The MultiMenu
  185.     '  routine is used for the multiple pulldown menu.
  186.     ' ────────────────────────────────────────────────────────────────────────
  187.  
  188.     ' ────────────────────────────────────────────────────────────────────────
  189.     '  Save the top half of the screen underneath, so that it can be restored
  190.     '  between calls to MultiMenu.
  191.     ' ────────────────────────────────────────────────────────────────────────
  192.     DIM scr%(BlockSize%(1, 80, 1, 25))
  193.     IF mouseExists% THEN
  194.         MouseHide
  195.     END IF
  196.     BlockSave 1, 80, 1, 25, scr%(), GetVideoSegment!
  197.  
  198.     ' ────────────────────────────────────────────────────────────────────────
  199.     '  Now we're going to define our multiple menu, the information MultiMenu
  200.     '  requires to operate.  It can be a bit lengthy, so have patience while
  201.     '  reading this.
  202.     ' ────────────────────────────────────────────────────────────────────────
  203.  
  204.     ' ────────────────────────────────────────────────────────────────────────
  205.     '  DIMension arrays for MultiMenu.  Note that the numbers inside the array
  206.     '  parenthesis are named constants, defined in the module-level code.
  207.     '  This is important to do, so that if any of them change (like you want
  208.     '  to add or remove menus or items), all you have to do is change the
  209.     '  value of these constants in one place.  Otherwise, you'd have to change
  210.     '  the literal value all over the program.
  211.     ' ────────────────────────────────────────────────────────────────────────
  212.     DIM menuItems$(NUMMENUS%, MAXITEMS%)
  213.     DIM numItems%(NUMMENUS%)
  214.     DIM titles$(NUMMENUS%)
  215.  
  216.     ' ────────────────────────────────────────────────────────────────────────
  217.     '  Fill in the values and text for all the menu items.
  218.     ' ────────────────────────────────────────────────────────────────────────
  219.     IF kolor% THEN
  220.         ft% = 6
  221.     ELSE
  222.         ft% = 0
  223.     END IF
  224.     numItems%(1) = 4
  225.     titles$(1) = " ^Info "
  226.     menuItems$(1, 1) = "^General Info"
  227.     menuItems$(1, 2) = "^Ordering Info"
  228.     menuItems$(1, 3) = "^About QDEMO"
  229.     menuItems$(1, 4) = "^Quit"
  230.  
  231.     numItems%(2) = 3
  232.     titles$(2) = " ^Colors "
  233.     menuItems$(2, 1) = "^Get Fore/Back"
  234.     menuItems$(2, 2) = "^Bright Backgrounds"
  235.     menuItems$(2, 3) = "^EGA/VGA Text Colors"
  236.     
  237.     numItems%(3) = 2
  238.     titles$(3) = " ^3D Stuff "
  239.     menuItems$(3, 1) = "^Info on 3D Stuff"
  240.     menuItems$(3, 2) = "B^uttons"
  241.  
  242.     numItems%(4) = 4
  243.     titles$(4) = " I^nput "
  244.     menuItems$(4, 1) = "^Menus"
  245.     menuItems$(4, 2) = "Editing ^Fields"
  246.     menuItems$(4, 3) = "^Lists"
  247.     menuItems$(4, 4) = "^Events"
  248.  
  249.     numItems%(5) = 2
  250.     titles$(5) = " ^Display "
  251.     menuItems$(5, 1) = "^Displaying Screens"
  252.     menuItems$(5, 2) = "^Windows"
  253.     
  254.     numItems%(6) = 4
  255.     titles$(6) = " ^Mouse "
  256.     menuItems$(6, 1) = "B^utton Status"
  257.     menuItems$(6, 2) = "M^ovement"
  258.     menuItems$(6, 3) = "^Information"
  259.     menuItems$(6, 4) = "^Sensitivity"
  260.  
  261.     numItems%(7) = 1
  262.     titles$(7) = " ^Other "
  263.     menuItems$(7, 1) = "^Fonts"
  264.  
  265.     ' ────────────────────────────────────────────────────────────────────────
  266.     '  Now we sit in a loop.  In this loop we call MultiMenu, which creates
  267.     '  the pulldown menu.  Based on what the user does in this menu, we will
  268.     '  call other routines to perform the user's chosen action.  Keep looping
  269.     '  in this fashion until the user chooses to quit.
  270.     ' ────────────────────────────────────────────────────────────────────────
  271.     done% = FALSE
  272.     WHILE done% = FALSE
  273.  
  274.         MultiMenu menuItems$(), numItems%(), titles$(), 5, 3, 76, "L", "^", "|", ft%, -1, 0, 7, 15, 0, 15, 7, menuSelected%, itemSelected%, mouseExists%
  275.      
  276.         SELECT CASE menuSelected%
  277.             CASE 1         ' Info
  278.                 SELECT CASE itemSelected%
  279.                     CASE 1     ' General Info
  280.                         GeneralInfo
  281.                     CASE 2     ' Ordering Info
  282.                         OrderingInfo
  283.                     CASE 3     ' About
  284.                         About
  285.                     CASE 4     ' Quit
  286.                         done% = QuitVerification%
  287.                     CASE ELSE
  288.                 END SELECT
  289.             CASE 2         ' Colors
  290.                 SELECT CASE itemSelected%
  291.                     CASE 1     ' Get Fore/Back
  292.                         GetForeBack
  293.                     CASE 2     ' Bright Backgrounds
  294.                         BrightBacks
  295.                     CASE 3     ' EGA/VGA Text Colors
  296.                         EgaVgaColors
  297.                     CASE ELSE
  298.                 END SELECT
  299.             CASE 3         ' 3D Stuff
  300.                 SELECT CASE itemSelected%
  301.                     CASE 1     ' Info on 3D Stuff
  302.                         Info3D
  303.                     CASE 2     ' Buttons
  304.                         Buttons3D
  305.                     CASE ELSE
  306.                 END SELECT
  307.             CASE 4         ' Input
  308.                 SELECT CASE itemSelected%
  309.                     CASE 1     ' Menus
  310.                         MenuDemo
  311.                     CASE 2     ' Edit Fields
  312.                         EditDemo
  313.                     CASE 3     ' Lists
  314.                         ListDemo
  315.                     CASE 4     ' Events
  316.                         EventsDemo
  317.                     CASE ELSE
  318.                 END SELECT
  319.             CASE 5         ' Display stuff
  320.                 SELECT CASE itemSelected%
  321.                     CASE 1     ' Displaying Screens
  322.                         DisplayScreensDemo
  323.                     CASE 2     ' Windows
  324.                         WindowsDemo
  325.                     CASE ELSE
  326.                 END SELECT
  327.             CASE 6         ' Mouse
  328.                 SELECT CASE itemSelected%
  329.                     CASE 1     ' Button Status
  330.                         ButtonStatusDemo
  331.                     CASE 2     ' Movement
  332.                         MouseMovement
  333.                     CASE 3     ' Info
  334.                         MouseInfoDemo
  335.                     CASE 4     ' Sensitivity
  336.                         SensitivityDemo
  337.                     CASE ELSE
  338.                 END SELECT
  339.             CASE 7         ' Other goodies
  340.                 SELECT CASE itemSelected%
  341.                     CASE 1       ' Fonts
  342.                         FontsDemo
  343.                     CASE ELSE
  344.                 END SELECT
  345.             CASE ELSE
  346.         END SELECT
  347.      
  348.         IF mouseExists% THEN
  349.             MouseHide
  350.         END IF
  351.         BlockRestore 1, 80, 1, 25, scr%(), GetVideoSegment!
  352.  
  353.     WEND
  354.  
  355. END SUB
  356.  
  357. SUB Quit
  358.  
  359.     ' ────────────────────────────────────────────────────────────────────────
  360.     '  This routine will take care of cleanup operations, including the last
  361.     '  clearing of the display and the hiding of the mouse, if it exists.
  362.     ' ────────────────────────────────────────────────────────────────────────
  363.  
  364.     ' ────────────────────────────────────────────────────────────────────────
  365.     '  Hide the mouse before we do any drawing.
  366.     ' ────────────────────────────────────────────────────────────────────────
  367.     IF mouseExists% THEN
  368.         MouseHide
  369.     END IF
  370.  
  371.     ' ────────────────────────────────────────────────────────────────────────
  372.     '  If there is a VGA crad present, then the user might have changed the
  373.     '  screen font using the FontsDemo routine. So, if there is a VGA card
  374.     '  present, we will, at this point, force a reset of the VGA character
  375.     ' font to the standard VGA hardware font.
  376.     ' ────────────────────────────────────────────────────────────────────────
  377.     IF VgaPresent% THEN
  378.         LoadVgaTextFont ""
  379.     ELSE
  380.         IF EgaPresent% THEN
  381.             LoadEgaTextFont ""
  382.         END IF
  383.     END IF
  384.  
  385.     ' ────────────────────────────────────────────────────────────────────────
  386.     '  Almost lastly, redisplay the screen as it was when we started.
  387.     ' ────────────────────────────────────────────────────────────────────────
  388.     IF (FirstFile%(SAVEFILE, NormalAttr, dta$)) THEN
  389.         RANDOMIZE TIMER
  390.         BuildScreen SAVEFILE, INT(RND(1) * 19)
  391.         KILL SAVEFILE
  392.     ELSE
  393.         COLOR 7, 0
  394.         CLS
  395.     END IF
  396.  
  397.     ' ────────────────────────────────────────────────────────────────────────
  398.     '  Relocate the cursor where it was saved in the first place.
  399.     ' ────────────────────────────────────────────────────────────────────────
  400.     LOCATE cursorRow%, 1, 1
  401.  
  402. END SUB
  403.  
  404.