'===========================================================================
' Subject: CUSTOMIZABLE MENUING SYSTEM        Date: 08-21-98 (17:07)       
'  Author: Anders Olofsson                    Code: QB, QBasic, PDS        
'  Origin: anders.olofsson@mail.bip.net     Packet: MENU.ABC
'===========================================================================
' Menuing system, by Anders Olofsson 1998.
'
'  Here is a simple & easy to use menuing system with hotkeys and shadows.
'
'    See the "InitMenus" sub for more information about
'    making menus and menuitems.
'
'      e-mail: anders.olofsson@mail.bip.net
'

DEFINT A-Z
'$DYNAMIC

DECLARE FUNCTION AltKey$ (KB$)
DECLARE SUB DisableMenuItem (Menu%, Item%)
DECLARE SUB EnableMenuItem (Menu%, Item%)
DECLARE SUB MakeMenu (MenuNum%, Col%, MenuName$)
DECLARE SUB AddMenuItem (MenuNum%, Item$)
DECLARE SUB SetMenuItemColor (Menu%, Item%, ForeColor%, BackColor%)
DECLARE SUB InitMenus ()
DECLARE SUB DrawMenuBar (HotKeys%, SelectedItem%)
DECLARE FUNCTION MenuItemSelected% (K$)

TYPE MenuType
 MenuName AS STRING * 15
 MenuLen AS INTEGER
 NumItems AS INTEGER
 CurrentItem AS INTEGER
 Col AS INTEGER
 ForeColor AS INTEGER
 BackColor AS INTEGER
 HighlightColor AS INTEGER
 DisabledColor AS INTEGER
END TYPE

TYPE MenuItemType
 Item AS STRING * 40
 Disabled AS INTEGER
 ForeColor AS INTEGER
 BackColor AS INTEGER
END TYPE

TYPE FileFindBuf
 DOS AS STRING * 21: Attributes AS STRING * 1
 AccessTime AS STRING * 2: AccessDate AS STRING * 2
 FileSize AS LONG: Filename AS STRING * 13
END TYPE

TYPE RegTypeX
 ax AS INTEGER: bx AS INTEGER: cx AS INTEGER
 dx AS INTEGER: bp AS INTEGER: si AS INTEGER
 di AS INTEGER: flags AS INTEGER: ds AS INTEGER
 es AS INTEGER
END TYPE


'--- Menu system
DIM SHARED Menus(1 TO 15) AS MenuType                  'Max 15 menus.
DIM SHARED MenuItems(1 TO 15, 1 TO 30) AS MenuItemType 'Max 30 menuitems in
                                                       'each menu.
InitMenus  'Read data into the variables above.


CLS : WIDTH 80, 25
Rows = 25

Restart:

 DEF SEG = &HB800
  FOR I = 0 TO 7999 STEP 6
   POKE I, 65
    POKE I + 1, 16 + 9
   POKE I + 2, 66
    POKE I + 3, 16
   POKE I + 4, 67
    POKE I + 5, 16
  NEXT

 DrawMenuBar 0, 0
 COLOR 10, 5
  LOCATE Rows \ 2 - 1, 20: PRINT " You selected: "

DO

 'Call the menuing system and get menuchoice & key presses
 MenuChoice = MenuItemSelected(Keys$)

 IF LEN(Keys$) THEN
   COLOR 14, 1
   LOCATE Rows \ 2, 21
   PRINT " Keypress: "; Keys$; SPACE$(30 - LEN(Keys$))
 END IF

 SELECT CASE MenuChoice     ' Format is easy!  -   Menu number * 100 + Menu item
                            ' (If you select item 10 from menu 5 that's 510!)
  CASE 301 TO 303     ' Menu 3 choice 1
   EnableMenuItem 3, 1: EnableMenuItem 3, 2: EnableMenuItem 3, 3
   DisableMenuItem 3, MenuChoice - 300
   IF MenuChoice - 300 = 1 THEN
    Rows = 25
   ELSEIF MenuChoice - 300 = 2 THEN
    Rows = 43
   ELSEIF MenuChoice - 300 = 3 THEN
    Rows = 50
   END IF
    WIDTH 80, Rows: GOTO Restart
 
  CASE IS > 0   ' Other choice
   COLOR 14, 1
   LOCATE Rows \ 2, 41 - LEN(MenuItems(MenuChoice \ 100, MenuChoice MOD 100).Item) \ 2
   PRINT " ";
   FOR I = 1 TO LEN(MenuItems(MenuChoice \ 100, MenuChoice MOD 100).Item)
    IF MID$(MenuItems(MenuChoice \ 100, MenuChoice MOD 100).Item, I, 1) <> "^" THEN PRINT MID$(MenuItems(MenuChoice \ 100, MenuChoice MOD 100).Item, I, 1);
   NEXT
 END SELECT

LOOP UNTIL MenuChoice = 109

REM $STATIC
SUB AddMenuItem (MenuNum, MenuItem$)
Menus(MenuNum).NumItems = Menus(MenuNum).NumItems + 1
MenuItems(MenuNum, Menus(MenuNum).NumItems).Item = MenuItem$
MenuItems(MenuNum, Menus(MenuNum).NumItems).Disabled = 0
MenuItems(MenuNum, Menus(MenuNum).NumItems).ForeColor = 0
MenuItems(MenuNum, Menus(MenuNum).NumItems).BackColor = 7
END SUB

FUNCTION AltKey$ (KB$)
'This function returns the key that was pressed together with alt.
IF LEN(KB$) <> 2 THEN EXIT FUNCTION
AltTable$ = SPACE$(15) + "QWERTYUIOP    ASDFGHJKL     ZXCVBNM" + SPACE$(69) + "1234567890"
AltKey$ = MID$(AltTable$, ASC(RIGHT$(UCASE$(KB$), 1)), 1)
END FUNCTION

SUB DisableMenuItem (Menu, Item)
MenuItems(Menu, Item).Disabled = -1
END SUB

SUB DrawMenuBar (HotKeys, SelectedItem)

IF SelectedItem = 0 THEN

 FOR X = 1 TO UBOUND(Menus)
  IF Menus(X).MenuLen = 0 AND X > 1 THEN MaxMenus = X - 1: EXIT FOR
 NEXT
 COLOR 0, 7: LOCATE 1, 1: PRINT SPACE$(80)

 FOR X = 1 TO MaxMenus
  IF Menus(X).MenuLen THEN
   IF HotKeys = 0 THEN
    LOCATE 1, Menus(X).Col: COLOR Menus(X).ForeColor, Menus(X).BackColor
    FOR Z = 1 TO Menus(X).MenuLen
     IF MID$(Menus(X).MenuName, Z, 1) <> "^" THEN PRINT MID$(Menus(X).MenuName, Z, 1);
    NEXT
   ELSE
    LOCATE 1, Menus(X).Col: COLOR Menus(X).ForeColor, Menus(X).BackColor
    FOR Z = 1 TO Menus(X).MenuLen
     IF MID$(Menus(X).MenuName, Z, 1) = "^" THEN
      COLOR Menus(X).HighlightColor, Menus(X).BackColor
     ELSE
      PRINT MID$(Menus(X).MenuName, Z, 1);
      COLOR Menus(X).ForeColor, Menus(X).BackColor
     END IF
    NEXT
   END IF
  END IF
 NEXT

ELSE

 COLOR Menus(SelectedItem).BackColor, Menus(SelectedItem).ForeColor
  IF HotKeys = 0 THEN
    LOCATE 1, Menus(SelectedItem).Col
    FOR Z = 1 TO Menus(SelectedItem).MenuLen
     IF MID$(Menus(SelectedItem).MenuName, Z, 1) <> "^" THEN PRINT MID$(Menus(SelectedItem).MenuName, Z, 1);
    NEXT
  ELSE
    LOCATE 1, Menus(SelectedItem).Col
    FOR Z = 1 TO Menus(SelectedItem).MenuLen
     IF MID$(Menus(SelectedItem).MenuName, Z, 1) = "^" THEN
      COLOR Menus(SelectedItem).HighlightColor, Menus(SelectedItem).ForeColor
     ELSE
      PRINT MID$(Menus(SelectedItem).MenuName, Z, 1);
      COLOR Menus(SelectedItem).BackColor, Menus(SelectedItem).ForeColor
     END IF
    NEXT
  END IF
END IF

END SUB

SUB EnableMenuItem (Menu, Item)
MenuItems(Menu, Item).Disabled = 0
END SUB

SUB InitMenus

'--------------------
      'Menu number
      '  
MakeMenu 1, 3, " ^File "

'--------------------
      ' Menu start column
      '     
MakeMenu 2, 9, " ^Edit "
    
'--------------------
               'Name (^ highlights the "O")
               '     
MakeMenu 3, 15, " ^Options "
MakeMenu 4, 24, " ^Help "
MakeMenu 5, 30, " ^Info "
MakeMenu 6, 36, " ^Colors "

'-------- Add the menuitems

AddMenuItem 1, "^New document"
AddMenuItem 1, "^Open document..."
AddMenuItem 1, "^Save"
AddMenuItem 1, "Save ^as..."
AddMenuItem 1, "~"                '~ = Dividing line
AddMenuItem 1, "^Print..."
AddMenuItem 1, "Disabled item!"
DisableMenuItem 1, 7
AddMenuItem 1, "~"
AddMenuItem 1, "E^xit"
SetMenuItemColor 1, 9, 4, 7     'Set exit menu-item color

AddMenuItem 2, "^Undo"
AddMenuItem 2, "Cu^t"
AddMenuItem 2, "^Copy"
AddMenuItem 2, "^Paste"
DisableMenuItem 2, 2: DisableMenuItem 2, 3
AddMenuItem 2, "~"
AddMenuItem 2, "^Find..."
AddMenuItem 2, "^Repeat last find..."
AddMenuItem 2, "Find ^next..."
AddMenuItem 2, "^Replace..."


AddMenuItem 3, "^Set screen resolution to 25 Rows"
AddMenuItem 3, "S^et screen resolution to 43 Rows"
AddMenuItem 3, "Se^t screen resolution to 50 Rows"

DisableMenuItem 3, 1 'Disable 25 Rows resolution choice - since it is used
                     'as default in the startup...

AddMenuItem 4, "^Help..."
AddMenuItem 4, "^Ab^ou^t.^.."

AddMenuItem 5, "Hot keys are optional"
AddMenuItem 5, "Use them ^on^ly if you w^an^t!"
SetMenuItemColor 5, 2, 10, 7

AddMenuItem 6, "^Colors!"
AddMenuItem 6, "C ^o l o r s!"
AddMenuItem 6, "Co^lors!"
AddMenuItem 6, "~"
AddMenuItem 6, "C o l ^o r s!"
AddMenuItem 6, "Colo^rs!"
AddMenuItem 6, "C o l o r ^s!"
AddMenuItem 6, "~"
AddMenuItem 6, "^Colors!"
AddMenuItem 6, "C o ^l o r s!"
AddMenuItem 6, "Color^s!"
AddMenuItem 6, "~"
AddMenuItem 6, "C o l o r ^s!"
AddMenuItem 6, "Co^lors!"
AddMenuItem 6, "^C o l o r s!"

Menus(6).BackColor = 3: Menus(6).ForeColor = 4

FOR I = 1 TO 3
SetMenuItemColor 6, I, 10, 0
SetMenuItemColor 6, I + 4, 3, 11
SetMenuItemColor 6, I + 8, 9, 2
SetMenuItemColor 6, I + 12, 2, 5
NEXT

END SUB

SUB MakeMenu (MenuNum, Col, MenuName$)
 Menus(MenuNum).Col = Col
 Menus(MenuNum).ForeColor = 0: Menus(MenuNum).BackColor = 7
 Menus(MenuNum).HighlightColor = 15: Menus(MenuNum).MenuName = MenuName$
 Menus(MenuNum).CurrentItem = 1: Menus(MenuNum).MenuLen = LEN(MenuName$)
 Menus(MenuNum).DisabledColor = 8
END SUB

FUNCTION MenuItemSelected (Keyboard$)
DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0: Keyboard$ = INKEY$
IF AltPressed = 0 THEN EXIT FUNCTION

LOCATE , , 0: DrawMenuBar 1, 0: CurrentMenu = 1: CurrentItem = 1

'Find out number of menus...
FOR X = 1 TO UBOUND(Menus)
 IF Menus(X).MenuLen = 0 AND X > 1 THEN MaxMenus = X - 1: EXIT FOR
NEXT

DIM HotKeys$(1 TO MaxMenus, 0 TO UBOUND(MenuItems, 2))

FOR X = 1 TO MaxMenus
 IF INSTR(Menus(X).MenuName, "^") THEN HotKeys$(X, 0) = UCASE$(MID$(Menus(X).MenuName, INSTR(Menus(X).MenuName, "^") + 1, 1))
 FOR Y = 1 TO Menus(X).NumItems
  IF INSTR(MenuItems(X, Y).Item, "^") THEN HotKeys$(X, Y) = UCASE$(MID$(MenuItems(X, Y).Item, INSTR(MenuItems(X, Y).Item, "^") + 1, 1))
 NEXT
NEXT

DO
DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0
IF AltPressed = 0 THEN EXIT DO
K$ = INKEY$: Keyboard$ = K$: K$ = UCASE$(K$)
IF LEN(K$) = 2 THEN
 KCode$ = AltKey$(K$)
 FOR X = 1 TO MaxMenus
  IF LEN(HotKeys$(X, 0)) AND HotKeys$(X, 0) = KCode$ THEN
    CurrentMenu = X
    GOTO GetMenuDone
  END IF
 NEXT
END IF
IF LEN(K$) THEN EXIT FUNCTION
LOOP

GetMenuChoice:
DrawMenuBar 1, 0
DrawMenuBar 1, CurrentMenu

DO
K$ = UCASE$(INKEY$)
IF K$ = CHR$(0) + CHR$(80) OR K$ = CHR$(0) + CHR$(72) OR K$ = CHR$(13) THEN EXIT DO
IF K$ = CHR$(0) + CHR$(75) THEN
 CurrentMenu = CurrentMenu - 1: IF CurrentMenu < LBOUND(Menus) THEN CurrentMenu = MaxMenus
 DrawMenuBar 1, 0: DrawMenuBar 1, CurrentMenu: K$ = ""
ELSEIF K$ = CHR$(0) + CHR$(77) THEN
 CurrentMenu = (CurrentMenu MOD MaxMenus) + 1
 DrawMenuBar 1, 0: DrawMenuBar 1, CurrentMenu: K$ = ""
END IF
IF LEN(K$) THEN
 FOR X = 1 TO MaxMenus
  IF K$ = HotKeys$(X, 0) THEN CurrentMenu = X: EXIT DO
 NEXT
END IF
DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0
IF AltPressed THEN AltWasPressed = -1
IF AltPressed = 0 AND AltWasPressed = 1 THEN
 DrawMenuBar 0, 0
 EXIT FUNCTION
END IF
IF AltWasPressed = -1 THEN AltWasPressed = 1
LOOP


GetMenuDone:
DrawMenuBar 0, 0
SCREEN 0, , 2, 0: PCOPY 0, 1: PCOPY 0, 2
GOSUB DrawCurrentMenu
DO: DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0: LOOP UNTIL AltPressed = 0


DO

DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0
IF AltPressed THEN
 DO: DEF SEG = &H40: AltPressed = (PEEK(&H17) AND 8) <> 0: LOOP UNTIL AltPressed = 0
 PCOPY 1, 0: SCREEN 0, , 0, 0
 GOTO GetMenuChoice
END IF

Key$ = UCASE$(INKEY$)

  SELECT CASE Key$
   CASE CHR$(0) + CHR$(77)  'Right
     CurrentMenu = (CurrentMenu MOD MaxMenus) + 1
     GOSUB DrawCurrentMenu
   CASE CHR$(0) + CHR$(75)  'Left
     CurrentMenu = CurrentMenu - 1: IF CurrentMenu < LBOUND(Menus) THEN CurrentMenu = MaxMenus
     GOSUB DrawCurrentMenu
   CASE CHR$(0) + CHR$(72)  'Up
     DO
      Menus(CurrentMenu).CurrentItem = Menus(CurrentMenu).CurrentItem - 1
      IF Menus(CurrentMenu).CurrentItem < 1 THEN Menus(CurrentMenu).CurrentItem = Menus(CurrentMenu).NumItems
     LOOP UNTIL LEFT$(MenuItems(CurrentMenu, Menus(CurrentMenu).CurrentItem).Item, 1) <> "~"
     GOSUB DrawCurrentMenu
   CASE CHR$(0) + CHR$(80)  'Down
     DO
      Menus(CurrentMenu).CurrentItem = (Menus(CurrentMenu).CurrentItem MOD Menus(CurrentMenu).NumItems) + 1
     LOOP UNTIL LEFT$(MenuItems(CurrentMenu, Menus(CurrentMenu).CurrentItem).Item, 1) <> "~"
     GOSUB DrawCurrentMenu
   CASE CHR$(13)
     IF MenuItems(CurrentMenu, Menus(CurrentMenu).CurrentItem).Disabled = 0 THEN
      SelectedItem = CurrentMenu * 100 + Menus(CurrentMenu).CurrentItem
      EXIT DO
     ELSE
      SOUND 200, .1
     END IF
   CASE CHR$(27)
    EXIT DO
   CASE IS <> ""
     FOR I = 1 TO Menus(CurrentMenu).NumItems
      IF Key$ = HotKeys$(CurrentMenu, I) THEN
       SelectedItem = CurrentMenu * 100 + I
       EXIT DO
      END IF
     NEXT
  END SELECT
LOOP

 SCREEN 0, , 0, 0: PCOPY 1, 0: PCOPY 0, 2
 MenuItemSelected = SelectedItem

EXIT FUNCTION

DrawCurrentMenu:
PCOPY 1, 2
DrawMenuBar 0, CurrentMenu

 MaxLen = 0
 FOR I = 1 TO Menus(CurrentMenu).NumItems
  IF INSTR(MenuItems(CurrentMenu, I).Item, "^") THEN
   CurrentLen = LEN(RTRIM$(MenuItems(CurrentMenu, I).Item)) + 3
   FOR L = 1 TO LEN(RTRIM$(MenuItems(CurrentMenu, I).Item))
    IF MID$(MenuItems(CurrentMenu, I).Item, L, 1) = "^" THEN CurrentLen = CurrentLen - 1
   NEXT
  ELSE
   CurrentLen = LEN(RTRIM$(MenuItems(CurrentMenu, I).Item)) + 2
  END IF
  IF CurrentLen > MaxLen THEN MaxLen = CurrentLen
 NEXT

 COLOR Menus(CurrentMenu).ForeColor, Menus(CurrentMenu).BackColor
  LOCATE 2, Menus(CurrentMenu).Col - 1: PRINT CHR$(218) + STRING$(MaxLen, 196) + CHR$(191);

  LOCATE Menus(CurrentMenu).NumItems + 3, Menus(CurrentMenu).Col - 1: PRINT CHR$(192) + STRING$(MaxLen, 196) + CHR$(217);
   CH$ = CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
   COLOR 8, 0: PRINT CH$;
  LOCATE Menus(CurrentMenu).NumItems + 4, Menus(CurrentMenu).Col
   FOR R = 1 TO MaxLen + 3
    CH$ = CHR$(SCREEN(CSRLIN, POS(0)))
    COLOR 8, 0: PRINT CH$;
   NEXT

 FOR R = 3 TO Menus(CurrentMenu).NumItems + 2
  LOCATE R, Menus(CurrentMenu).Col - 1
  IF LEFT$(MenuItems(CurrentMenu, R - 2).Item, 1) <> "~" THEN
   COLOR Menus(CurrentMenu).ForeColor, Menus(CurrentMenu).BackColor
   PRINT CHR$(179);
   MenuTextFore = MenuItems(CurrentMenu, R - 2).ForeColor
   MenuTextBack = MenuItems(CurrentMenu, R - 2).BackColor
   IF MenuItems(CurrentMenu, R - 2).Disabled THEN MenuTextFore = Menus(CurrentMenu).DisabledColor
   IF R - 2 = Menus(CurrentMenu).CurrentItem THEN SWAP MenuTextFore, MenuTextBack
    COLOR MenuTextFore, MenuTextBack
    CurrentMenuText$ = " " + MenuItems(CurrentMenu, R - 2).Item: CurrentLen = MaxLen
    FOR L = 1 TO MaxLen
     IF MID$(CurrentMenuText$, L, 1) = "^" THEN CurrentLen = CurrentLen + 1
    NEXT
    FOR L = 1 TO CurrentLen
     IF MID$(CurrentMenuText$, L, 1) <> "^" THEN
      PRINT MID$(CurrentMenuText$, L, 1);
      COLOR MenuTextFore, MenuTextBack
     ELSE
      IF MenuItems(CurrentMenu, R - 2).Disabled = 0 THEN COLOR Menus(CurrentMenu).HighlightColor, MenuTextBack
     END IF
    NEXT
   COLOR Menus(CurrentMenu).ForeColor, Menus(CurrentMenu).BackColor
     PRINT CHR$(179);
   CH$ = CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
   COLOR 8, 0: PRINT CH$;
  ELSE
   COLOR Menus(CurrentMenu).ForeColor, Menus(CurrentMenu).BackColor
   PRINT CHR$(195) + STRING$(MaxLen, 196) + CHR$(180);
   CH$ = CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
   COLOR 8, 0: PRINT CH$;
  END IF
 NEXT

 PCOPY 2, 0
RETURN
END FUNCTION

SUB SetMenuItemColor (Menu, Item, ForeColor, BackColor)
MenuItems(Menu, Item).ForeColor = ForeColor
MenuItems(Menu, Item).BackColor = BackColor
END SUB