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, "@New"
AddMenuItem FileMenu, "#FF0000@Open"
AddMenuItem FileMenu, "Sa@ve"
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
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 (which right now is just submenu links)
'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
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
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 r = MaxVW(Which)
b = fh * Menu(Which).Options
LINE (x
, y
)-STEP(r
, b
), Menu
(Which
).BGC
, BF
FOR i
= 1 TO Menu
(Which
).Options
IF Menu
(Which
).Active
= i
THEN LINE (x
, y
+ fh
* (i
- 1))-STEP(r
, fh
), Menu
(Which
).HC
, BF
CC$ = GCC(Captions(Which, i), "#", p%)
CC$ = GCC(Captions(Which, i), "@", p%)
FOR i
= 1 TO Menu
(Which
).Options
IF tw
> MaxVW
THEN MaxVW
= tw
'if the width is less than that temp width, correct that
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 FromPosition = cc
CheckHandle Which
o = Menu(Which).Options + 1
Menu(Which).Options = o
Captions(Which, o) = What$
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
