CONST Visible
= 1, Minimized
= 2, Hortizontal
= 4, SubMenu
= 8
CONST True
= -1, False
= 0
REDIM SHARED Menu
(10) AS Menu_Type
'default for no more than 10 menus in a program, but resizable
MainMenu = CreateMenu("Main Menu", Visible + Hortizontal, True)
SetMenuPos MainMenu, 0, 0 'postion menu top left at 0,0
AddMenuItem MainMenu, "@File{File Menu}" 'The {} tells the menu that we're linking it to a sub menu called "File Menu", as defined below.
AddMenuItem MainMenu, "@Edit"
AddMenuItem MainMenu, "@View"
FileMenu = CreateMenu("File Menu", SubMenu, False)
AddMenuItem FileMenu, "É"
AddMenuItem FileMenu, "º@New"
AddMenuItem FileMenu, "º#FF0000@Open"
AddMenuItem FileMenu, "ºSa@ve"
AddMenuItem FileMenu, "Ì"
AddMenuItem FileMenu, "º@Print"
AddMenuItem FileMenu, "È"
Choice$ = ProcessMenu(k&, active%)
SELECT CASE k&
'Only when there's an active menu do we intercept those keystrokes 'If no menus are active, we'll just fall through and preserve our keys as usual
CASE 27 'ESC in the menu will close the menus. ESC outside of it will exit our program. 'I put it here just to use to showcase that we only intercept keystrokes when the menus are active.
CASE 100307, 100308 'I chose ALT as a simple means to make my menu actives. Feel free to choose your own. Menu(MainMenu).Active = 1
IF Choice$
<> "" THEN LastChoice$
= Choice$
DisplayMenus
'k is for the keyboard
'active is a return code for which menu we got the result from, in case someone makes multiple menus
' with the same options listed in the sub menus, such as PAINT -- Circle as one menu/submenu
' and then DRAW -- Circle as another menu/submenu.
' Both would just return "Circle" as our final choice, so we'd need to know which menu was active
' and where the command came from.
STATIC oldmouse
AS INTEGER 'the old status of our left mouse button (up or down) mb
= _MOUSEBUTTON(1) 'shortcut key so I don't have to type _mousebutton(1) multiple times.
IF mb
AND NOT oldmouse
THEN 'we only need to check the menu IF we clicked the mouse button oldmouse = mb 'placed here in case we exit early (which we can)
FOR i
= 1 TO UBOUND(menu
) 'check for mouse interactions IF Menu
(i
).Layout
AND Visible
THEN 'only if a menu is visible do we check to see if we can do something with it. x = Menu(i).Left: y = Menu(i).Top 'top and left
w = Menu(i).Wide: h = Menu(i).High
r = x + w: b = y + h 'bottom and right
IF mx
>= x
AND mx
<= r
AND my
>= y
AND my
<= b
THEN 'the mouse in over a visible menu IF Menu
(i
).Active
THEN 'if that window is active, return a result Menu
(i
).Layout
= Menu
(i
).Layout
AND NOT Minimized
Menu(i).Active = 0
HideSubMenus
FOR j
= 1 TO Menu
(i
).Options
oldpx = px
Caption = SCC(Captions(i, j))
IF mx
>= oldpx
AND mx
<= px
THEN 'we clicked on an item Menu(i).Active = j
ELSE 'It's a vertical menu ELSE 'if the menu we're over isn't active, then make it the active menu Menu(i).Active = 1
IF j
<> i
THEN 'close all the other (non-main) menus. IF Menu
(j
).Layout
AND SubMenu
THEN Menu
(j
).Layout
= Menu
(j
).Layout
AND NOT Visible
Menu(j).Active = 0
oldmouse = mb 'placed here in case we don't go into the mouse checking loop
IF GCC
(Captions
(i
, Menu
(i
).Active
), "É", p%
) <> "" THEN Menu(i).Active = Menu(i).Active + 1
ELSEIF GCC
(Captions
(i
, Menu
(i
).Active
), "È", p%
) <> "" THEN Menu(i).Active = Menu(i).Active - 1
itemselected:
IF Captions
(i
, Menu
(i
).Active
) = "ð" THEN Menu
(i
).Layout
= Menu
(i
).Layout
AND NOT Minimized
Menu
(i
).Layout
= Menu
(i
).Layout
OR Minimized
active = i
ProcessMenu$ = SCC(Captions(i, Menu(i).Active)) 'Strip the command code for the return name
CC$ = GCC(Captions(i, Menu(i).Active), "{", p%) 'but process the command code, if it's available
OpenSubMenu i, CC$
'we clicked on something without a command code
'hide all the submenus which are open from the screen
'HideSubMenus
Menu(i).Active = 0
k = 0 'keyboard process has been handled internally
Menu(i).Active = 0
HideSubMenus 'and hide them
k = 0 'don't return a keycode back to the main program itself
Menu(i).Active = Menu(i).Active - 1
IF Menu
(i
).Active
< 1 THEN Menu
(i
).Active
= Menu
(i
).Options
k = 0 'keyboard process has been handled internally
Menu(i).Active = Menu(i).Active + 1
IF Menu
(i
).Active
> Menu
(i
).Options
THEN Menu
(i
).Active
= 1 k = 0 'keyboard process has been handled internally
Menu(i).Active = Menu(i).Active - 1
IF Menu
(i
).Active
< 1 THEN Menu
(i
).Active
= Menu
(i
).Options
recheckup:
IF GCC
(Captions
(i
, Menu
(i
).Active
), "É", p%
) <> "" THEN Menu(i).Active = Menu(i).Active - 1
IF Menu
(i
).Active
< 1 THEN Menu
(i
).Active
= Menu
(i
).Options:
GOTO recheckup
ELSEIF GCC
(Captions
(i
, Menu
(i
).Active
), "È", p%
) <> "" THEN Menu(i).Active = Menu(i).Active - 1
IF Menu
(i
).Active
< 1 THEN Menu
(i
).Active
= Menu
(i
).Options:
GOTO recheckup
ELSEIF GCC
(Captions
(i
, Menu
(i
).Active
), "Ì", p%
) <> "" THEN Menu(i).Active = Menu(i).Active - 1
IF Menu
(i
).Active
< 1 THEN Menu
(i
).Active
= Menu
(i
).Options:
GOTO recheckup
k = 0 'keyboard process has been handled internally
Menu(i).Active = Menu(i).Active + 1
IF Menu
(i
).Active
> Menu
(i
).Options
THEN Menu
(i
).Active
= 1 recheckdown:
IF GCC
(Captions
(i
, Menu
(i
).Active
), "É", p%
) <> "" THEN Menu(i).Active = Menu(i).Active + 1
IF Menu
(i
).Active
> Menu
(i
).Options
THEN Menu
(i
).Active
= 1:
GOTO recheckdown
ELSEIF GCC
(Captions
(i
, Menu
(i
).Active
), "È", p%
) <> "" THEN Menu(i).Active = Menu(i).Active + 1
IF Menu
(i
).Active
> Menu
(i
).Options
THEN Menu
(i
).Active
= 1:
GOTO recheckdown
ELSEIF GCC
(Captions
(i
, Menu
(i
).Active
), "Ì", p%
) <> "" THEN Menu(i).Active = Menu(i).Active + 1
IF Menu
(i
).Active
> Menu
(i
).Options
THEN Menu
(i
).Active
= 1:
GOTO recheckdown
k = 0 'keyboard process has been handled internally
FOR j
= 1 TO Menu
(i
).Options
CC$ = GCC(Captions(i, j), "@", p%)
ProcessMenu$ = SCC(Captions(i, j)) 'Strip the command code for the return name
CC$ = GCC(Captions(i, j), "{", p%) 'but process the command code, if it's available
IF CC$
<> "" THEN OpenSubMenu i
, CC$
ELSE HideSubMenus
Menu(i).Active = 0
k = 0
SUB OpenSubMenu
(calledfrom
AS INTEGER, CC$
) 'calledfrom is the previous menu which called this one Menu(j).Active = 1
Menu
(j
).Layout
= Menu
(j
).Layout
OR Visible
IF Menu
(calledfrom
).Layout
AND Hortizontal
THEN Menu(j).Left = Menu(calledfrom).Left + px
Menu
(j
).Top
= Menu
(calledfrom
).Top
+ _FONTHEIGHT * (Menu
(calledfrom
).Active
- 1) Menu(j).Left = MaxVW(calledfrom)
IF Menu
(j
).Layout
AND SubMenu
THEN Menu
(j
).Layout
= Menu
(j
).Layout
AND NOT Visible
IF Menu
(Which
).Handle
<> 0 AND (Menu
(Which
).Layout
AND Visible
) THEN x = Menu(Which).Left: y = Menu(Which).Top
w = Menu(Which).Wide: h = Menu(Which).High
r = x + w: b = y + h 'right side and bottom side of menu limits
'we have the menu minimized to begin with
Caption
= "ð " + Menu
(Which
).
Name IF Menu
(Which
).Active
THEN 'if the menu is active, highlight the squiggle LINE (x
, y
)-STEP(pw
, h
), Menu
(Which
).HC
, BF
ELSE 'otherwise leave it grayed out and inactive LINE (x
, y
)-STEP(pw
, h
), Menu
(Which
).BGC
, BF
LINE (x
, y
)-(r
, b
), Menu
(Which
).BGC
, BF
FOR i
= 1 TO Menu
(Which
).Options
Caption = SCC(Captions(Which, i))
IF Menu
(Which
).Active
= i
THEN CC$ = GCC(Captions(Which, i), "#", p%)
CC$ = GCC(Captions(Which, i), "@", p%)
ELSE 'It's a vertical menu LINE (x
, y
)-(r
, b
), Menu
(Which
).BGC
, BF
FOR i
= 1 TO Menu
(Which
).Options
Caption = Captions(Which, i)
IF GCC
(Caption
, "É", p%
) <> "" THEN IF Menu
(Which
).Active
= i
THEN LINE (x
+ BorderIndent
, y
+ fh
* (i
- 1))-STEP(Menu
(Which
).Wide
- 2 * BorderIndent
, fh
), Menu
(Which
).HC
, BF
IF Menu
(Which
).Active
= i
THEN LINE (x
+ BorderIndent
, y
+ fh
* (i
- 1))-STEP(Menu
(Which
).Wide
- 2 * BorderIndent
, fh
), Menu
(Which
).HC
, BF
IF Menu
(Which
).Active
= i
THEN LINE (x
+ BorderIndent
, y
+ fh
* (i
- 1))-STEP(Menu
(Which
).Wide
- 2 * BorderIndent
, fh
), Menu
(Which
).HC
, BF
IF Menu
(Which
).Active
= i
THEN LINE (x
+ BorderIndent
, y
+ fh
* (i
- 1))-STEP(Menu
(Which
).Wide
- 2 * BorderIndent
, fh
), Menu
(Which
).HC
, BF
IF Menu
(Which
).Active
= i
THEN LINE (x
, y
+ fh
* (i
- 1))-STEP(Menu
(Which
).Wide
, fh
), Menu
(Which
).HC
, BF
BorderIndent = 0
CC$ = GCC(Caption, "#", p%)
Caption = SCC(Caption)
CC$ = GCC(Captions(Which, i), "@", p%)
SUB AutoSetMenuSize
(Which
AS INTEGER) 'Sub to set the width of a menu FOR i
= 1 TO Menu
(Which
).Options
IF tw
> Menu
(Which
).Wide
THEN Menu
(Which
).Wide
= tw
'if the width is less than that temp width, correct that IF (Menu
(Which
).Layout
AND Hortizontal
) = 0 THEN Menu
(Which
).High
= _FONTHEIGHT * Menu
(Which
).Options
FUNCTION SCC$
(FromWhat$
) 'Strip Command Code 'Strip Off any command codes (such as link to sub menu) and just return the caption itself
ListOfCommand$ = "{@#ɺÈÍÌ"
'@ are used for hotkey creation, such as @File will give us an Alt-F hotkey for File.
'#NNNNNN are used to set 6 character RGB colors.
'{ are used to designate links
SCC$ = FromWhat$
m$
= MID$(ListOfCommand$
, i
, 1) CASE "{" 'remove anything to the right of {, as the link is our last command 'This command should only ever be processed once, as the first time it appears
'it strips off everything to the right of it.
SCC$
= LEFT$(SCC$
, l
- 1) CASE "@", "É", "º", "È", "Í", "Ì" 'just strip out the command code SCC$
= LEFT$(SCC$
, l
- 1) + MID$(SCC$
, l
+ 1) CASE "#" 'need to strip out the command code and the next 6 color characters SCC$
= LEFT$(SCC$
, l
- 1) + MID$(SCC$
, l
+ 7)
FUNCTION SCCL$
(FromWhat$
, ListOfCommand$
) 'Strip Command Code Lite 'Requires specifiication of what commands to strip from the text
'Strip Off any command codes (such as link to sub menu) and just return the caption itself
'@ are used for hotkey creation, such as @File will give us an Alt-F hotkey for File.
'#NNNNNN are used to set 6 character RGB colors.
'{ are used to designate links
SCCL$ = FromWhat$
m$
= MID$(ListOfCommand$
, i
, 1) CASE "{" 'remove anything to the right of {, as the link is our last command 'This command should only ever be processed once, as the first time it appears
'it strips off everything to the right of it.
SCCL$
= LEFT$(SCCL$
, l
- 1) CASE "@", "É", "º", "È", "Í", "Ì" 'just strip out the command code SCCL$
= LEFT$(SCCL$
, l
- 1) + MID$(SCCL$
, l
+ 1) CASE "#" 'need to strip out the command code and the next 6 color characters SCCL$
= LEFT$(SCCL$
, l
- 1) + MID$(SCCL$
, l
+ 7)
cc
= INSTR(FromWhat$
, WhichCommand$
) 'Strip Off any command codes (such as link to sub menu) and just return the caption itself
CASE "{" 'return everything between the brackets IF cc
THEN GCC$
= MID$(FromWhat$
, cc
+ 1) 'return "" if there's no link when requested IF cc1
THEN GCC$
= LEFT$(GCC$
, cc1
- 1) 'Remove anything after the link CASE "@" 'Return the character after cc
= INSTR(SCCL
(FromWhat$
, "#{ɺÈÍÌ"), "@") 'find the position without any other command codes throwing off the location CASE "#" 'return the 6 characters after CASE "É", "º", "È", "Í", "Ì" 'just return the code as verification that it's there. IF cc
THEN GCC$
= WhichCommand$
FromPosition = cc
CheckHandle Which
o = Menu(Which).Options + 1
Menu(Which).Options = o
Captions(Which, o) = What$
IF Menu
(Which
).Layout
AND NOT Hortizontal
THEN AutoSetMenuSize
(Which
)
CheckHandle Which
IF IsActive
THEN Menu
(Which
).Active
= 1 ELSE Menu
(Which
).Active
= 0
Menu(i).Handle = i
Menu(i).Layout = fLayout
Menu(i).Closeable = fCloseable
Menu(i).Top = 0: Menu(i).Left = 0
Menu(i).Options = 1 'make the collapse button our first option
Captions(i, 1) = "ð"
Menu(i).Options = 0 'no options yet
Menu(i).Active = 0
Menu(i).BGC = DarkGray
Menu(i).HC = LightGray
Menu(i).FC = Black
Menu(i).LC = White
CreateMenu = i
CheckHandle Which
Menu(Which).Top = WhereY
Menu(Which).Left = WhereX
CheckHandle Which
Menu(Which).Wide = Wide
Menu(Which).High = High
