CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/Basic/TOPMENU.ZIP/TOPMENU.BAS

BASIC Source File | 1988-08-11 | 14.6 KB | 612 lines

'========================================================================
'                                 Top.Menu
'
'    Written By:  Glenn Miller (Not The Band Leader)
'                 Route 8 Box 492-A
'                 Asheboro, North Carolina  27203
'
'            On:  August 5, 1988
'
'
'    This Program is " FreeWare "  use it, abuse it, loose-it..etc...
'
'    Please Don't send me money for using this routine, because it would
'    only be used by me to buy more computer stuff.
'========================================================================
'
'This routine was created as an easy means to set up a menu operated system,
'without having to deal with passing "zillions" of varables to a subroutine.
'
'This is in NO way intended to replace any of the fine utilities available
'but to be considered as a simpler (and less definable) substitute.
'
'Okay..Enough of that..Now on to this....
'
'
'As you can see in the DECLARE statement on the 1st line of this program there
'are only 4 varables that need to be passed to the subroutine..
'
'and here they are.....
'
'
'  SEL   Returns containing the number of the selection that was selected.
'
'  SEL$  an arry of strings containing all the menu and submenu selections
'        as well as the help line (line 25)
'
'  FGC   Fore Ground Color of the Menus
'
'  BGC   Back Ground Color of the Menus
'
'  MSG$  a string that will be centered on the Top Line of the Menu.
'        If MSG$="" then No Message is displayed on the top line.
'
'Heres the Details..........
'
'This Menu system is a bar type with sub menus.
'There can be up to 9 selections per sub menu.
'There can be as many Selections on the Top Bar That you can fit on it
'and these DO NOT have to be the same length.
'
'
'The KEY to this menu system is the SEL$() array.
'
'This array should be dimensioned as DIM SEL$(x,10) in the start of your
'program, Where x=number of Top Bar Selections you will have.
'
'Array SEL$(x,0) needs to contain the Selection Names For the Top Bar.
'
'Arrays SEL$(x,1) thru SEL$(x,9) contain the Selection Names For the
'sub menu under the SEL$(x,0) Name.
'
'Array SEL$(x,10) needs to contain the HELP message that will be displayed
'on line 25. (if you want one.)
'
'
'Example:  To Set up a Selection called "DOS" and have 3 sub selections
'          called:
'
'                 Exit To Dos
'                 Shell To Dos
'                 Enter Dos Commands
'
'         with a Help Message of:  What Do You Want!
'
'The arrays would be:
'
'         SEL$(0,0)=" Dos "
'         SEL$(0,1)=" Exit To Dos "
'         SEL$(0,2)=" Shell To Dos "
'         SEL$(0,3)=" Enter Dos Commands "
'         SEL$(0,4)=""
'         SEL$(0,10)="What Do You Want!"
'
'
' !!!!! NOTICE !!!!!
'
'       See How SEL$(0,4)=""
'
'       You MUST always define the next array AFTER the last one you want
'       to use as "" (Nul).
'
'       This makes it work right!..Okay..OK
'
'
'Define all the Selections you need by this method.
'Of course you will change to the next array..ie 1,2,3...etc. instead of 0.
'
'
'
'Running the program........
'
'Once you have setup all the SEL$() your ready to go.
'
'The Top Bar Selections can be selected by 2 different ways.....
'
' 1 - Use The Left-Right cursor Keys to move to the desired selection.
' 2 - Press the Key of the 1st letter of a selection.
'
'     Note: If more than one selection has the same starting letter the
'           program will move to the next selection when that same letter
'           key is pressed again. I call this a "round-robin" display but I
'           really dont know why.
'
'
'The Sub selections can be selected 2 different ways...
'
' 1 - Use the Up-Down cursor keys to move to the desired selection and press
'     the Enter Key.
' 2 - Enter the Number of the selection.(no enter key needed)
'
'
'
'
'What you get back for all your trouble........
'
'The SEL variable returns to you with a number containing the Selection that
'was selected. (wheeeee...)
'
' If the user pressed the "Esc" Key SEL will be -1. (neg.1)
' else heres what you get.
'
'
' The number is determined by: (Top Bar Selection Number *10) + selected sub#
'
'Example:  If the user selected item# 5 from the first Top Bar selection the
'          number would be: 5.
'
'          First Top Bar number = 0     SEL$(0,x)
'
'          0 * 10 = 0  + 5      = 5
'
'
'    If item# 5 was selected from the 5th Top Bar the number would be: 45
'
'          5th  Top Bar Number  = 4    SEL$(4,x)
'
'          4 * 10 = 40 + 5      = 45
'
'
'
'
' Below is a short program using the TOP MENU subroutine this will help
' show you how it works and the numbers that will be returned.
'
' Thats about it for now....so....
' Waiter!.....TOP.MENU......please!
'========================================================================

DECLARE SUB Top.Menu (sel, sel$(), fgc!, bgc!, msg$)

DIM sel$(6, 10)                 'remember this?



'====== Define the Top Bar Selections

sel$(0, 0) = " Directories "
sel$(1, 0) = " Dos "
sel$(2, 0) = " Set Time "
sel$(3, 0) = " Exit "
sel$(4, 0) = " Set Date "
sel$(5, 0) = " HELP! "

'===== Define Help messages for line 25

sel$(0, 10) = "Display The Directory For The Selected Drive"
sel$(1, 10) = "Use This To Interact With Dos"
sel$(2, 10) = "Press Enter To Set The Systems TIME"
sel$(3, 10) = "Press Enter To Return To System"
sel$(4, 10) = "Press Enter To Set The Systems DATE"

sel$(5, 10) = ""   'no message for HELP! selection


'===== Define Sub Selections For  "Directories" (0,0)

sel$(0, 1) = " Display File Names For Current Directory "
sel$(0, 2) = " Display File Names For 'C:\' Drive "
sel$(0, 3) = " Display File Names For 'A:\' Drive "

sel$(0, 4) = ""


'===== Define Sub Selections For  "Dos" (1,0)

sel$(1, 1) = " Exit To Dos "
sel$(1, 2) = " Shell To Dos "

sel$(1, 3) = ""


'==== NO sub selections for (2,0) (3,0) (4,0) (5,0)

sel$(2, 1) = ""
sel$(3, 1) = ""
sel$(4, 1) = ""
sel$(5, 1) = ""


'===== Define Top Row Message

msg$ = " Use Cursor/Letter/Number Keys To Make Selection "


'===== Define Colors

begin: fgc = 7
       bgc = 1


'===== Make Call to Top.Menu =============================================

       CALL Top.Menu(sel, sel$(), fgc!, bgc!, msg$)

'===== Do the desired Selection
'
'if its 'Esc' then end

      IF sel = -1 THEN END


      SELECT CASE sel


             CASE IS = 1

                CLS
                LOCATE 1, 1
                SHELL "dir /p"
                PRINT "Press Any Key . . .";
                a$ = INPUT$(1)
                GOTO begin

             CASE IS = 2

                CLS
                LOCATE 1, 1
                SHELL "dir c:\ /p"
                PRINT "Press Any Key . . .";
                a$ = INPUT$(1)
                GOTO begin

             CASE IS = 3

                CLS
                LOCATE 1, 1
                SHELL "dir a:\ /p"
                PRINT "Press Any Key . . .";
                a$ = INPUT$(1)
                GOTO begin


             CASE IS = 11

                CLS
                LOCATE 1, 1
                SYSTEM

             CASE IS = 12

                CLS
                LOCATE 1, 1
                PRINT "Enter EXIT To Return To Menu"
                SHELL
                GOTO begin

             CASE IS = 21

                CLS
                LOCATE 10, 1

                SHELL "time"
                GOTO begin

             CASE IS = 31

                CLS
                LOCATE 1, 1
                SYSTEM

             CASE IS = 41

                CLS
                LOCATE 10, 1

                SHELL "date"
                GOTO begin

             CASE IS = 51

                LOCATE 10, 10
                PRINT "We All Need Help Now And Then...Press a Key";
                a$ = INPUT$(1)
                GOTO begin

             CASE ELSE
                GOTO begin
      END SELECT

SUB Top.Menu (sel, sel$(), fgc, bgc, msg$)
DIM a(20)

       s$ = ""
       a = 0

'================== clr screen

       COLOR fgc, bgc

       FOR i = 1 TO 25
         LOCATE i, 1
         PRINT STRING$(80, "░");
       NEXT

'================== init line 25

       LOCATE 25, 1
       COLOR bgc, fgc
       PRINT SPACE$(80);
       COLOR fgc, bgc

' ===== get the length of each sel$
' ===== and get the 1st character of each sel$ and build a string of them
' ===== this string is used to select based on letters.
' ===== end when sel$=""

       i = -1
       DO
          i = i + 1
          a(i) = LEN(sel$(i, 0))
          z$ = LTRIM$(sel$(i, 0))
          s$ = s$ + UCASE$(LEFT$(z$, 1))
       LOOP WHILE sel$(i, 0) <> ""

'===== fix sel to the right number of selections

       sel = i - 1

'==== print the top message row
'====if no message then make top row a line else center the message on the top
'
'
       LOCATE 1, 1
       COLOR fgc, bgc
       t = INT((78 - LEN(msg$)) / 2)
       IF t * 2 + LEN(msg$) < 78 THEN f$ = STRING$((78 - (t * 2 + LEN(msg$))), "─") ELSE f$ = ""
       PRINT "┌" + STRING$(t, "─") + msg$ + f$ + STRING$(t, "─") + "┐";

'===== print blank line as middle row

       PRINT "│" + SPACE$(78) + "│";


'===== print selections on middle row

       LOCATE 2, 2
       FOR i = 0 TO sel
         PRINT sel$(i, 0);
       NEXT

'===== print bottom row  of box

       LOCATE 3, 1
       PRINT "└" + STRING$(78, "─") + "┘";

'===== init varables
       subsel = 1
       subnum = 1
       zold = 2
       s = 0
       x = 2

'===== display sub menu

  GOSUB dis.sub


'
'===== highlite selection on bar
'
lp:
       oldx = x
       x = 2

'===== calculate cursor position

       FOR i = 0 TO s
         x = x + LEN(sel$(i, 0))
       NEXT

'===== fix cursor position to start of selection string

       x = x - LEN(sel$(i - 1, 0))


'===== put OLD selection back to original color

       COLOR fgc, bgc
       LOCATE 2, oldx
       PRINT sel$(olds, 0);

'===== select NEW selection with highlite color

       COLOR 15, fgc
       LOCATE 2, x
       PRINT sel$(s, 0);


'===== print sel$(s,10) 'message string' on line 25

       t = INT((80 - LEN(sel$(s, 10))) / 2)
       IF t * 2 + LEN(sel$(s, 10)) < 78 THEN f$ = STRING$((78 - (t * 2 + LEN(sel$(s, 10)))), "─") ELSE f$ = ""
       LOCATE 25, 1
       COLOR bgc, fgc
       PRINT SPACE$(t) + sel$(s, 10) + f$ + SPACE$(t);
       COLOR fgc, bgc

'
'===== wait for key to be pressed

get.key:
       DO
         a$ = INKEY$
       LOOP WHILE a$ = ""

'
'===== if the key is an extended key ( len > 1 ) then process ext keys

       IF LEN(a$) > 1 THEN GOTO get.curkey

'===== else make the key Upper Case

       a$ = UCASE$(a$)

'===== check for escape key
'===== if esc then return with sel=-1

       IF a$ = CHR$(27) THEN sel = -1: EXIT SUB
'
'===== if key is CR then return with selection number in sel
'
ret:   IF a$ <> CHR$(13) GOTO test.num

       sel = (s * 10) + subnum: EXIT SUB


'===== test for number key
test.num:
       q = VAL(a$)
       IF q >= 1 AND q <= cv AND q <= 9 AND q > 0 THEN
       subsel = q
       GOSUB update.sub
       a$ = CHR$(13): GOTO ret
       END IF


'====== test for first letter key

'===== if c<>0 then add 1 to c and test for match
'===== this allows multilble selections with the same letter
'===== round-robin type
'
test.ltr:
       IF c <> 0 THEN
         c = c + 1
         c = INSTR(c, s$, a$)
         IF c <> 0 GOTO tr
       END IF
       c = INSTR(s$, a$)
       IF c = 0 GOTO get.key
tr:    olds = s
       s = c - 1
       subsel = 1
       subnum = 1
       GOSUB dis.sub
       GOTO lp



'===== check for cursor keys

get.curkey:

    a = ASC(RIGHT$(a$, 1))
    IF a <> 77 AND a <> 75 AND a <> 72 AND a <> 80 GOTO get.key
    olds = s
    IF a <> 77 AND a <> 75 GOTO get.updnkey


    IF a = 77 THEN s = s + 1
    IF a = 75 THEN s = s - 1
    IF s > sel THEN s = 0
    IF s < 0 THEN s = sel
    c = s
    subsel = 1
    subnum = 1

    GOSUB dis.sub
    GOTO lp


get.updnkey:

         IF a = 80 THEN subsel = subsel + 1
         IF a = 72 THEN subsel = subsel - 1
         GOSUB update.sub
         GOTO lp


'
'===== display the sub menu box
'
dis.sub:

         i = 0
         a = 0
         xtemp = x

'===== clear old box
         COLOR fgc, bgc
         FOR i = 1 TO cv + 2
             LOCATE 3 + i, zold - 1
             PRINT STRING$(aold + 6, "░")
         NEXT


'===== get the length of the longest string
'===== to be displayed


       i = 0

       DO
          i = i + 1
          IF LEN(sel$(s, i)) > a THEN a = LEN(sel$(s, i))
       LOOP WHILE sel$(s, i) <> "" AND i < 10

       cv = 0

       IF i = 1 THEN RETURN
       aold = a
       cvold = cv
       cv = i - 1
       cvold = cv

'===== calculate cursor position

       x = 2
       FOR i = 0 TO s
         x = x + LEN(sel$(i, 0))
       NEXT

'===== fix cursor position to start of selection string

       x = x - LEN(sel$(i - 1, 0))



'===== if starting position + longest string found > 80 then adjust start pos.
'===== if starting pos. < 2 then set it to 2.


       IF x + a > 78 THEN z = 76 - a ELSE z = x - 5

       IF z < 2 THEN z = 2
       zold = z
       LOCATE 4, z - 1: PRINT "┌" + STRING$(x - z, "─");
       LOCATE 4, x: PRINT "┘" + SPACE$(LEN(sel$(s, 0)) - 2) + "└";
       b = x + LEN(sel$(s, 0)) - 1
       n = z + a + 3
       PRINT STRING$((n) - b, "─") + "┐";

       FOR i = 1 TO cv
         LOCATE i + 4, z - 1: PRINT "│";
         PRINT LTRIM$(STR$(i)) + ". " + sel$(s, i) + SPACE$(a - (LEN(sel$(s, i)) - 1)) + "│";
       NEXT

       LOCATE i + 4, z - 1: PRINT "└" + STRING$(a + 4, "─") + "┘";
       x = xtemp


'===== display the selection in the sub menu

update.sub:


       IF cv = 0 THEN RETURN
       IF subsel > cv THEN subsel = 1
       IF subsel < 1 THEN subsel = cv
       LOCATE subnum + 4, z
       PRINT LTRIM$(STR$(subnum)) + ". " + sel$(s, subnum);
       LOCATE subsel + 4, z
       COLOR 15, fgc
       PRINT LTRIM$(STR$(subsel)) + ". " + sel$(s, subsel);
       subnum = subsel


       RETURN

END SUB