home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / code_it4 / demom2.bas < prev    next >
Encoding:
BASIC Source File  |  1991-06-10  |  7.1 KB  |  233 lines
  1. DECLARE SUB PUTestDefine ()
  2. DECLARE SUB PUTest ()
  3. '============================================================================
  4. 'DEMOM2.BAS Copyright (C) 1991, Clear Software. ALL RIGHTS RESERVED.
  5. '============================================================================
  6.  
  7. '$INCLUDE: 'CITOOLS.BI'
  8. '$INCLUDE: 'CIMENU2.BI'
  9. '$INCLUDE: 'CIMOUSE.BI'
  10.  
  11. '============================================================================
  12.  
  13. DEFINT A-Z
  14.  
  15. '============================================================================
  16.  
  17. CONST TRUE = -1, FALSE = 0
  18.  
  19. DIM SHARED ESCKEY, F1KEY
  20.  
  21. '============================================================================
  22.  
  23.  
  24.     MouseInit
  25.     PUTestDefine
  26.     
  27.     CLS
  28.     COLOR 0, 1
  29.     ScreenPaint 1, 80, 1, 23, ""
  30.     COLOR 9, 1
  31.     DrawBox 1, 80, 1, 23, 2
  32.  
  33.     PUTest
  34.  
  35.     COLOR 7, 0
  36.     CLS
  37.     END
  38.  
  39. SUB PUTest
  40.  
  41. '============================================================================
  42. 'This sub uses the pop up menus to control the program. The pop up menus were
  43. 'pre-defined in the PopUpPreSet SUB.
  44. '============================================================================
  45.  
  46.  
  47. '============================================================================
  48. 'Show the main menu and process any menu events.
  49. '============================================================================
  50.  
  51.     ESCKEY = -27
  52.  
  53.     MouseShow
  54.  
  55.     POPUPDONE = FLASE
  56.  
  57.     WHILE NOT POPUPDONE
  58.  
  59.         popItem = PopUpActive(1)
  60.  
  61.         SELECT CASE popItem
  62.  
  63.             CASE 1
  64.                 DO
  65.                     popItem = PopUpActive(2)
  66.                     SELECT CASE popItem
  67.                         CASE 1
  68.                             
  69.                         CASE 2
  70.                             
  71.                         CASE 4, ESCKEY
  72.                            PULLDOWNDONE = TRUE
  73.                            EXIT DO
  74.                     END SELECT
  75.                  LOOP
  76.  
  77.             CASE 2
  78.                 DO
  79.                     popItem = PopUpActive(3)
  80.                     SELECT CASE popItem
  81.                         CASE 1
  82.                             
  83.                         CASE 2
  84.                         
  85.                         CASE 4, ESCKEY
  86.                             EXIT DO
  87.                     END SELECT
  88.                 LOOP
  89.  
  90.  
  91.             CASE 3
  92.                 DO
  93.                     popItem = PopUpActive(4)
  94.                     SELECT CASE popItem
  95.                         CASE 1
  96.  
  97.                         CASE 2
  98.                             
  99.                         CASE 4, ESCKEY
  100.                             EXIT DO
  101.  
  102.                         CASE F1KEY      'F1 as a pre-defined exit key.
  103.                                         '(see the PUTestDefine SUB)
  104.                     END SELECT
  105.                 LOOP
  106.  
  107.             CASE 5
  108.                 MASTEREXITFLAG = TRUE
  109.                 POPUPDONE = TRUE
  110.  
  111.  
  112.         END SELECT
  113.  
  114.     WEND
  115.  
  116. MouseHide
  117.  
  118.  
  119. END SUB
  120.  
  121. SUB PUTestDefine
  122.  
  123. '============================================================================
  124. 'This SUB contains the pre-defined pop up menus used with DEMOM2.BAS.
  125. '============================================================================
  126.  
  127. '============================================================================
  128. 'Define the Escape key as an exit key on all menus exept the main menu (menu 1)
  129. 'and the F1 key on the 4th menu only.
  130. '============================================================================
  131.  
  132.     ESCKEY = -27      'Shared variables declared at the start of the program.
  133.     F1KEY = -1
  134.  
  135.     PopUpExitKeySet 2, 1, CHR$(27), ESCKEY
  136.     PopUpExitKeySet 3, 1, CHR$(27), ESCKEY
  137.     PopUpExitKeySet 4, 1, CHR$(27), ESCKEY
  138.     PopUpExitKeySet 4, 1, CHR$(27), ESCKEY
  139.     PopUpExitKeySet 4, 2, CHR$(0) + CHR$(59), F1KEY
  140.  
  141. '============================================================================
  142. 'Main program menus.
  143. '============================================================================
  144.  
  145.     PopUpDefine 1, 0, 1, " Main Menu ", 1
  146.     PopUpDefine 1, 1, 1, "Chevy...", 1
  147.     PopUpDefine 1, 2, 1, "Ford...", 1
  148.     PopUpDefine 1, 3, 1, "Chrysler...", 2
  149.     PopUpDefine 1, 4, 1, "-", 1
  150.     PopUpDefine 1, 5, 1, "Exit", 2
  151.  
  152.     PopUpColors 1, 0, 7, 0, 7, 0, 7, 15, 0, 8, 7, 15, 15
  153.     PopUpPlace 1, 6, 31
  154.  
  155.     PopUpDefine 2, 0, 1, " Chevrolet ", 1
  156.     PopUpDefine 2, 1, 1, "Corvette", 1
  157.     PopUpDefine 2, 2, 1, "Camero", 2
  158.     PopUpDefine 2, 3, 1, "-", 1
  159.     PopUpDefine 2, 4, 1, "Return", 1
  160.  
  161.     PopUpColors 2, 0, 7, 0, 7, 0, 7, 15, 0, 8, 7, 15, 15
  162.     PopUpPlace 2, 6, 28
  163.  
  164.     PopUpDefine 3, 0, 1, " FORD ", 1
  165.     PopUpDefine 3, 1, 1, "Mustang", 1
  166.     PopUpDefine 3, 2, 1, "Shelby Cobra", 8
  167.     PopUpDefine 3, 3, 1, "-", 1
  168.     PopUpDefine 3, 4, 1, "Return", 1
  169.  
  170.     PopUpColors 3, 0, 7, 0, 7, 0, 7, 15, 0, 8, 7, 15, 15
  171.     PopUpPlace 3, 6, 26
  172.  
  173.     PopUpDefine 4, 0, 1, " Chrysler ", 1
  174.     PopUpDefine 4, 1, 1, "Cuda", 1
  175.     PopUpDefine 4, 2, 1, "Charger", 2
  176.     PopUpDefine 4, 3, 1, "-", 1
  177.     PopUpDefine 4, 4, 1, "Return", 1
  178.  
  179.     PopUpColors 4, 0, 7, 0, 7, 0, 7, 15, 0, 8, 7, 15, 15
  180.     PopUpPlace 4, 6, 28
  181.  
  182. '============================================================================
  183. 'Define the menu help descriptions.
  184. '============================================================================
  185.  
  186.     DIM pophelp$(1 TO 20)    'Array used for menu description lines.
  187.                              'NOTE: Define (1 TO 20) as shown.
  188.  
  189.     PopUpDescriptArea 23, 2, 78, 0, 7
  190.  
  191.     pophelp$(1) = " Two of Chevy's best                                      | <Arrow=Next Item>"
  192.     pophelp$(2) = " A couple of Ford's best                                  | <Arrow=Next Item>"
  193.     pophelp$(3) = " Two of Chryslers muscle cars                             | <Arrow=Next Item>"
  194.     pophelp$(5) = " Exit the program                                         | <Arrow=Next Item>"
  195.  
  196.     PopUpChoiceDescript 1, pophelp$()
  197.     ERASE pophelp$
  198.  
  199.     DIM pophelp$(1 TO 20)
  200.  
  201.     pophelp$(1) = " Remember the 1964 split window              | <Arrow=Next Item> <Esc=Return>"
  202.     pophelp$(2) = " The street drags were full of them          | <Arrow=Next Item> <Esc=Return>"
  203.     pophelp$(3) = ""
  204.     pophelp$(4) = " Return to the main menu                     | <Arrow=Next Item> <Esc=Return>"
  205.  
  206.     PopUpChoiceDescript 2, pophelp$()
  207.     ERASE pophelp$
  208.  
  209.     DIM pophelp$(1 TO 20)
  210.  
  211.     pophelp$(1) = " Shelby, BOSS, Mach,.... true muscle cars    | <Arrow=Next Item> <Esc=Return>"
  212.     pophelp$(2) = " A bullet with wheels                        | <Arrow=Next Item> <Esc=Return>"
  213.     pophelp$(3) = ""
  214.     pophelp$(4) = " Returns to the Main Menu                    | <Arrow=Next Item> <Esc=Return>"
  215.  
  216.     PopUpChoiceDescript 3, pophelp$()
  217.     ERASE pophelp$
  218.  
  219.     DIM pophelp$(1 TO 20)
  220.  
  221.     pophelp$(1) = " Unbelievable with a 426 Hemi                | <Arrow=Next Item> <Esc=Return>"
  222.     pophelp$(2) = " 383 Big block power                         | <Arrow=Next Item> <Esc=Return>"
  223.     pophelp$(3) = ""
  224.     pophelp$(4) = " Returns to the Main Menu                    | <Arrow=Next Item> <Esc=Return>"
  225.  
  226.     PopUpChoiceDescript 4, pophelp$()
  227.     ERASE pophelp$
  228.  
  229.  
  230.  
  231. END SUB
  232.  
  233.