home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / qbasic / topmenu2.arc / TOPMENU2.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-09-07  |  16.1 KB  |  397 lines
  1.  
  2. SUB Top.Menu (sel, sel$(), fgc, bgc, hlc, topline, dis.time, dis.date, scn.blank, msg$, bgc$)
  3.  
  4. '========================================================================
  5. 'Initilize Routine Varables
  6. '========================================================================
  7.         DIM a(20)     ' maximum number of top selections allowed
  8.         month.data$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
  9. start:  S$ = ""
  10.         a = 0
  11.       
  12. '========================================================================
  13. ' Clear The Screen Using The Character in bgc$
  14. ' Using The Colors Specified in fgc,bgc this will print the bgc$
  15. ' Character to all locations on the screen.
  16. '========================================================================
  17.         COLOR fgc, bgc
  18.         FOR i = 1 TO 25
  19.          LOCATE i, 1
  20.          PRINT STRING$(80, bgc$);
  21.         NEXT
  22.      
  23. '========================================================================
  24. 'Initilize Line# 25 (The Help Line)
  25. 'This will init the Help Line to reverse colors specified in fgc,bgc.
  26. '
  27. 'Line 25 is where the Help messages are displayed for the Selections
  28. '
  29. 'The Message Strings are passed via the SEL$(x,10) string of each selection
  30. '========================================================================
  31.        LOCATE 25, 1
  32.        COLOR bgc, fgc
  33.        PRINT SPACE$(80);
  34.        COLOR fgc, bgc
  35.  
  36. '========================================================================
  37. 'Read the Selection Names that where passed in array SEL$(x,0)
  38. 'Store the length of each one in the array A().
  39. 'Get the 1st character of each SEL$(x,0), and build a string of them,
  40. 'this string is used to make top row selections based on letters.
  41. 'Read them until SEL$(x,0) is a Nul (0) length.
  42. '========================================================================
  43.        i = -1
  44.        DO
  45.           i = i + 1
  46.           a(i) = LEN(sel$(i, 0))
  47.           z$ = LTRIM$(sel$(i, 0))
  48.           S$ = S$ + UCASE$(LEFT$(z$, 1))
  49.        LOOP WHILE sel$(i, 0) <> ""
  50.         
  51. '========================================================================
  52. ' Setup the SEL variable to the correct value based on the number of
  53. ' selections that are to be displayed in the menu.
  54. '========================================================================'
  55.         sel = i - 1
  56.    
  57. '========================================================================
  58. ' Print the Message thats in MSG$ on the top line of the menu.
  59. ' If no message (MSG$=""), then make top line a line
  60. ' else center the message in MSG$ on the top line.
  61. '========================================================================
  62.        LOCATE topline + 1, 3
  63.        COLOR fgc, bgc
  64.        t = INT((75 - LEN(msg$)) / 2)
  65.        IF t * 2 + LEN(msg$) < 75 THEN f$ = STRING$((75 - (t * 2 + LEN(msg$))), "─") ELSE f$ = ""
  66.        PRINT "┌" + STRING$(t, "─") + msg$ + f$ + STRING$(t, "─") + "┐";
  67.       
  68. '========================================================================
  69. 'Initilize 2nd line of Menu
  70. 'Print blank line as 2nd line
  71. 'then display Selection Names on line 2
  72. 'The names are in array SEL$(x,0)
  73. '========================================================================
  74.        LOCATE topline + 2, 2            'print blank line
  75.        COLOR 0, 0
  76.        PRINT " ";
  77.        COLOR fgc, bgc
  78.        PRINT "│" + SPACE$(75) + "│";
  79.        '-----------------------------------------------------------------
  80.        LOCATE topline + 2, 5            'print selection Names
  81.        COLOR fgc, bgc
  82.        FOR i = 0 TO sel
  83.          PRINT sel$(i, 0);
  84.        NEXT
  85.   
  86. '========================================================================
  87. 'Print 3rd line of Menu ( bottom of box)
  88. '========================================================================
  89.        LOCATE topline + 3, 2
  90.        COLOR 0, 0
  91.        PRINT " ";
  92.        COLOR fgc, bgc
  93.        PRINT "└" + STRING$(75, "─") + "┘";
  94.  
  95. '========================================================================
  96. ' Setup varables
  97. '========================================================================
  98.        subsel = 1
  99.        subnum = 1
  100.        zold = 2
  101.        S = 0
  102.        x = 5
  103. '========================================================================
  104. ' Display submenu for the new Selection Name of SEL number
  105. '========================================================================
  106.   GOSUB dis.sub
  107.  
  108. '========================================================================
  109. 'Display New Selection Name highlited on selection bar
  110. '========================================================================'
  111. lp:    oldx = x                         'update variables
  112.           x = 5
  113.        '-----------------------------------------------------------------
  114.        FOR i = 0 TO S                   'Calculate new Selection position
  115.          x = x + LEN(sel$(i, 0))
  116.        NEXT
  117.        '-----------------------------------------------------------------
  118.        x = x - LEN(sel$(i - 1, 0))      'fix  x  to equal location
  119.                                         'start of NEW selection Name
  120.        '-----------------------------------------------------------------
  121.        COLOR fgc, bgc                   'put OLD selection Name back to
  122.        LOCATE topline + 2, oldx         'original color
  123.        PRINT sel$(olds, 0);
  124.        '-----------------------------------------------------------------
  125.        COLOR hlc, fgc                   'Select NEW selection Name
  126.        LOCATE topline + 2, x            'with highlite color
  127.        PRINT sel$(S, 0);
  128.                                                      
  129. '========================================================================
  130. ' Print the message for the New Selection Name centered on line 25
  131. ' The string is taken from SEL$(x,10)
  132. ' Based on the current value of S.
  133. '========================================================================'
  134.        t = INT((80 - LEN(sel$(S, 10))) / 2)
  135.        IF t * 2 + LEN(sel$(S, 10)) < 78 THEN f$ = STRING$((78 - (t * 2 + LEN(sel$(S, 10)))), "─") ELSE f$ = ""
  136.        LOCATE 25, 1
  137.        COLOR bgc, fgc
  138.        PRINT SPACE$(t) + sel$(S, 10) + f$ + SPACE$(t);
  139.        COLOR fgc, bgc
  140.  
  141. '========================================================================'
  142. ' Wait for KEY to be pressed and....
  143. ' Display Current TIME if variable Dis.Time is not equal to 0.
  144. ' Display Current DATE if variable Dis.Date is not equal to 0.
  145. ' if screen blank is ON (scn.blank=1) then blank screen if no key is
  146. ' pressed for 3 minutes
  147. '========================================================================'
  148. get.key: blk.time = VAL(MID$(TIME$, 4, 2))
  149.  
  150.          DO
  151.            a$ = INKEY$
  152.        '-----------------------------------------------------------------
  153.          IF dis.date = 0 THEN GOTO dtime          'Display Date
  154.            month$ = MID$(month.data$, (((VAL(DATE$) - 1) * 3) + 1), 3)
  155.            LOCATE topline + 1, 4
  156.            PRINT CHR$(16) + month$ + " " + MID$(DATE$, 4, 2) + "," + MID$(DATE$, 9, 2) + CHR$(17)
  157.        '-----------------------------------------------------------------
  158. dtime:   IF dis.time = 0 THEN GOTO chk.blank      'Display Time
  159.            tx = VAL(LEFT$(TIME$, 2))
  160.            am$ = "Am"
  161.            IF tx > 12 THEN tx = tx - 12: am$ = "Pm"
  162.            t$ = CHR$(16) + RIGHT$(STR$(tx), 2) + ":" + MID$(TIME$, 4, 2) + " " + am$ + CHR$(17)
  163.           
  164.            LOCATE topline + 1, 69
  165.            PRINT t$
  166.        '-----------------------------------------------------------------
  167. chk.blank: IF scn.blank = 0 THEN GOTO key.loop    'blank screen
  168.            IF VAL(MID$(TIME$, 4, 2)) > blk.time + 2 THEN GOTO blk.scrn
  169.           
  170. key.loop: LOOP WHILE a$ = ""
  171.  
  172. '========================================================================'
  173. 'Process the key that was pressed
  174. '========================================================================''
  175.          IF LEN(a$) < 2 THEN GOTO reg.key       'if the key is an
  176.                                                 'extended key (len>1)
  177.                                                 'then process as cursor key
  178.                                                 'else check for other key
  179.        '-----------------------------------------------------------------
  180.          a = ASC(RIGHT$(a$, 1))                 'check for cursor keys
  181.          IF a <> 77 AND a <> 75 AND a <> 72 AND a <> 80 GOTO get.key
  182.          olds = S
  183.          IF a <> 77 AND a <> 75 GOTO get.updnkey
  184.          IF a = 77 THEN S = S + 1               'check for left/right keys
  185.          IF a = 75 THEN S = S - 1
  186.          IF S > sel THEN S = 0
  187.          IF S < 0 THEN S = sel
  188.          c = S
  189.          subsel = 1
  190.          subnum = 1
  191.          GOSUB dis.sub
  192.          GOTO lp
  193.        '-----------------------------------------------------------------
  194. get.updnkey:                                    'check for up/down cursor 
  195.          IF a = 80 THEN subsel = subsel + 1
  196.          IF a = 72 THEN subsel = subsel - 1
  197.          GOSUB update.sub
  198.          GOTO lp
  199.         
  200.        '-----------------------------------------------------------------
  201. reg.key: a$ = UCASE$(a$)                        'else make the key
  202.                                                 'Upper Case
  203.        '-----------------------------------------------------------------
  204.        IF a$ = CHR$(27) THEN sel = -1: EXIT SUB 'check for escape key
  205.                                                 'if the key is 'ESC' then
  206.                                                 'return with SEL= -1 (neg.1)
  207.        '-----------------------------------------------------------------
  208. ret:   IF a$ <> CHR$(13) GOTO test.num          'if key is ENTER then
  209.        sel = (S * 10) + subnum: EXIT SUB        'return with selection
  210.                                                 'number in SEL
  211.        '-----------------------------------------------------------------
  212.                                                 'else test for number Key
  213. test.num:                                       'if not a valid # key test
  214.        q = VAL(a$)                              'for letter key
  215.        IF q >= 1 AND q <= cv AND q <= 9 AND q > 0 THEN
  216.        subsel = q
  217.        GOSUB update.sub
  218.        a$ = CHR$(13): GOTO ret
  219.        END IF
  220.       
  221.        '-----------------------------------------------------------------
  222. test.ltr: IF c <> 0 THEN                       'test for first letter key
  223.             c = c + 1                          'if c<>0 then add 1 to c
  224.             c = INSTR(c, S$, a$)               'and test for match
  225.           IF c <> 0 GOTO tr                    'this allows multilble
  226.          END IF                                'selections with the same
  227.             c = INSTR(S$, a$)                  'letter to be selected as
  228.           IF c = 0 GOTO get.key                'round-robin type
  229. tr:    olds = S
  230.        S = c - 1
  231.        subsel = 1
  232.        subnum = 1
  233.        GOSUB dis.sub                           'go display new Sub menu
  234.        GOTO lp                                 'and go display new Selection
  235.                                                'Name
  236.  
  237. '========================================================================'
  238. '* * * * * * * * Subroutine To Display NEW Sub Menu * * * * * * * * * *
  239. ' Clear old submenu box to back ground character (BGC$)
  240. ' and display NEW sub menu
  241. '
  242. '========================================================================'
  243. dis.sub:                                       'init variables
  244.         i = 0
  245.         a = 0
  246.         xtemp = x
  247.       
  248.        '-----------------------------------------------------------------
  249.        'clear old submenu box to back ground character
  250.        
  251.         COLOR fgc, bgc
  252.         FOR i = 1 TO cv + 2
  253.          LOCATE topline + 4 + i, zold - 1
  254.          PRINT STRING$(aold + 7, bgc$)
  255.         NEXT
  256.       
  257.        '-----------------------------------------------------------------
  258.        'fix the 'shadow' line of the top box
  259.       
  260.         LOCATE topline + 4, 1
  261.         COLOR fgc, bgc
  262.         PRINT bgc$;
  263.         COLOR 0, 0
  264.         PRINT SPACE$(77);
  265.         COLOR fgc, bgc
  266.         PRINT STRING$(2, bgc$);
  267.  
  268.        '-----------------------------------------------------------------
  269.        'find the length of the longest submenu title to be displayed
  270.        'and store in A. If there is no Submenu for this Selection then
  271.        'return, Else Display NEW Submenu
  272.       
  273.        i = 1
  274.        
  275.        DO WHILE (sel$(S, i) <> "") AND (i < 10)
  276.        IF LEN(sel$(S, i)) > a THEN a = LEN(sel$(S, i))
  277.          i = i + 1
  278.        LOOP
  279.        cv = 0
  280.        IF i = 1 THEN RETURN                     'no Submenu
  281.       
  282.        '-----------------------------------------------------------------
  283.        'Display new SubMenu
  284.       
  285.        aold = a                                 'init variables
  286.        cvold = cv
  287.        cv = i - 1
  288.      
  289.        cvold = cv
  290.        x = 5
  291.                                                 'calculate cursor position
  292.        FOR i = 0 TO S
  293.          x = x + LEN(sel$(i, 0))
  294.        NEXT
  295.  
  296.                                                 'fix cursor position to
  297.                                                 'start of selection string
  298.        x = x - LEN(sel$(i - 1, 0))
  299.       
  300.        '-----------------------------------------------------------------
  301.        'if starting position + longest string found > 77 then adjust
  302.        'start position.
  303.        'if starting pos. < 4 then set it to 4.
  304.        '-----------------------------------------------------------------
  305.       
  306.        IF x + a > 77 THEN z = 72 - a ELSE z = x - 3
  307.        IF z < 4 THEN z = 4
  308.        zold = z
  309.       
  310.        '-----------------------------------------------------------------
  311.        'Print NEW SubMenu
  312.       
  313.        COLOR fgc, bgc
  314.        LOCATE topline + 4, z
  315.        PRINT "┌" + STRING$((x - z) - 1, "─");
  316.        LOCATE topline + 4, x
  317.        PRINT "┘" + SPACE$(LEN(sel$(S, 0)) - 2) + "└";
  318.        b = x + LEN(sel$(S, 0)) - 1
  319.        n = z + a + 3
  320.        xx = (n) - (b - 1)
  321.        IF xx < 1 THEN xx = 0
  322.        PRINT STRING$(xx, "─") + "┐";
  323.       
  324.        FOR i = 1 TO cv
  325.          LOCATE topline + i + 4, z - 1
  326.          COLOR 0, 0
  327.          PRINT " ";
  328.          COLOR fgc, bgc
  329.          PRINT "│";
  330.          PRINT LTRIM$(STR$(i)) + ". " + sel$(S, i) + SPACE$(a - (LEN(sel$(S, i)) - 1)) + "│";
  331.        NEXT
  332.       
  333.        LOCATE topline + i + 4, z - 1
  334.        COLOR 0, 0
  335.        PRINT " ";
  336.        COLOR fgc, bgc
  337.        PRINT "└" + STRING$(a + 4, "─") + "┘";
  338.        LOCATE topline + i + 5, z - 1
  339.        COLOR 0, 0
  340.        PRINT STRING$(a + 6, " ");
  341.        x = xtemp
  342.  
  343.  
  344. '========================================================================'
  345. '* * * * * * * * Subroutine To Display NEW title in Submenu * * * * * * *
  346. ' restore previous title to normal colors
  347. ' and display NEW tile in High-lite Color (HLC)
  348. '========================================================================'
  349. update.sub:
  350.        COLOR fgc, bgc
  351.        IF cv = 0 THEN RETURN
  352.        IF subsel > cv THEN subsel = 1
  353.        IF subsel < 1 THEN subsel = cv
  354.        '-----------------------------------------------------------------
  355.                                                 'restore previous title
  356.        LOCATE topline + subnum + 4, z + 1
  357.        PRINT LTRIM$(STR$(subnum)) + ". " + sel$(S, subnum);
  358.        '-----------------------------------------------------------------
  359.                                                 'print new title
  360.        LOCATE topline + subsel + 4, z + 1
  361.        COLOR hlc, fgc
  362.        PRINT LTRIM$(STR$(subsel)) + ". " + sel$(S, subsel);
  363.        subnum = subsel
  364.        COLOR fgc, bgc
  365.        RETURN
  366.  
  367. '========================================================================'
  368. '* * * * * * * * Subroutine To Blank the Screen * * * * * * *
  369. '========================================================================'
  370. blk.scrn:
  371.        SOUND 600, 3
  372.        SOUND 400, 3
  373.        COLOR 0, 0
  374.        CLS
  375.        x = 1: y = 1
  376. blk1:  RANDOMIZE z
  377.        ox = x: oy = y
  378.        LOCATE ox, oy
  379.        COLOR 0, 0
  380.        PRINT SPACE$(19);
  381.  
  382. blk2:  x = INT(RND * 25)
  383.        y = INT(RND * 80)
  384.       
  385.        IF x > 25 OR y > 60 OR x < 1 OR y < 1 THEN GOTO blk2:
  386.        COLOR fgc, bgc
  387.        LOCATE x, y
  388.        PRINT "...Press Any Key...";
  389.        t = VAL(MID$(TIME$, 8, 1))
  390. tlp:   IF t = VAL(MID$(TIME$, 8, 1)) THEN GOTO tlp
  391.        a$ = INKEY$
  392.        IF a$ = "" GOTO blk1
  393.        GOTO start
  394.  
  395. END SUB
  396.  
  397.