Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
Something I'm playing around with:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), 0)
Do
Cls
While _MouseInput: Wend
If _MouseButton(2) And Not omb2 Then
showIt = Not showIt
ShowMenu mainmenu, showIt
If showIt = 0 Then
style = Not style
Menu(1).inUse = 0 'a hack so we can watch the menu change styles
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), style)
End If
SetMenuPos mainmenu, _MouseX, _MouseY
End If
Drawmenus
omb2 = _MouseButton(2)
_Limit 30
_Display
Loop
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub ShowMenu (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
At the moment, this just demos defining a menu, clicking a button, and popping it onto the screen. There's no actual "select a choice" function in this yet (hence why it's in the Works in Progress area), so don't think you can actually use this for much yet.
To test this out so far, just run it and right click your mouse a few times. It should pop up our little menu wherever the mouse is at (or hide the menu on a second click). Multiple clicks will cycle through the two options which we can set for our menus.
Does this look more-or-less presentable to everyone? Is there some secret menu layout that I'm missing with this simple set up? Test it out. Offer a suggestion or opinion. And remember -- this is a work in progress and is liable to be changed (or even dropped) without any notice. 
Posts: 456
Threads: 63
Joined: Apr 2022
Reputation:
10
11-24-2022, 11:32 PM
(This post was last modified: 11-24-2022, 11:34 PM by PhilOfPerth.)
(11-24-2022, 10:55 PM)SMcNeill Wrote: Something I'm playing around with:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), 0)
Do
Cls
While _MouseInput: Wend
If _MouseButton(2) And Not omb2 Then
showIt = Not showIt
ShowMenu mainmenu, showIt
If showIt = 0 Then
style = Not style
Menu(1).inUse = 0 'a hack so we can watch the menu change styles
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), style)
End If
SetMenuPos mainmenu, _MouseX, _MouseY
End If
Drawmenus
omb2 = _MouseButton(2)
_Limit 30
_Display
Loop
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub ShowMenu (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
At the moment, this just demos defining a menu, clicking a button, and popping it onto the screen. There's no actual "select a choice" function in this yet (hence why it's in the Works in Progress area), so don't think you can actually use this for much yet.
To test this out so far, just run it and right click your mouse a few times. It should pop up our little menu wherever the mouse is at (or hide the menu on a second click). Multiple clicks will cycle through the two options which we can set for our menus.
Does this look more-or-less presentable to everyone? Is there some secret menu layout that I'm missing with this simple set up? Test it out. Offer a suggestion or opinion. And remember -- this is a work in progress and is liable to be changed (or even dropped) without any notice. I don't see anything on screen, just your screen. Left-clicking has no effect, right-clicking works as you described, showing small menu. Seems like all going to plan so far!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) 
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
We can now start checking for user responses:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0
Do
Cls
While _MouseInput: Wend
k = _KeyHit
mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)
If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If Menu(ActiveMenu).Active Then SetMenuActive ActiveMenu, 0 Else SetMenuActive ActiveMenu, -1
End Select
End If
If k = 27 Then System
Drawmenus
result = CheckMenu(k)
If result Then
Locate 10, 1: Print "You clicked menu choice:"; MenuChoice(ActiveMenu, result).Name
Print "Press <ANY KEY> to continue."
_Display
Sleep
End If
_Limit 30
_Display
omb = mb: omb2 = mb2 'store old mouse values
Loop
Sub SetMenuActive (whichmenu, state)
For i = 1 To 100: Menu(i).Active = 0: Next
If whichmenu Then
Menu(whichmenu).Active = state
If state Then MenuHover = 1 Else MenuHover = 0
ActiveMenu = whichmenu
End If
End Sub
Function MouseOverActiveMenu
If Menu(ActiveMenu).Visible = 0 Then Exit Function
'the mouse can only be counted as being over the active menu, if the active menu is visible
mx = _MouseX: my = _MouseY
If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
MouseOverActiveMenu = -1
End If
End If
End Function
Function CheckMenu (k) 'pass this your current keyhit value.
'Checkmenu doesn't actually update or pull info from any buffers itself. You'll need to get your keystate values elsewhere.
'as well as have your While _MouseInput: Wend routine elsewhere in your code.
Static omb, omb2
mb = _MouseButton(1): mb2 = _MouseButton(2)
mx = _MouseX: my = _MouseY
If MouseOverActiveMenu Then
If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
If mb And Not omb Then SetMenuActive ActiveMenu, -1
Else 'the menu is already active. Check to see if we clicked on something
If Menu(ActiveMenu).layout Then
If mb And Not omb Then CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
Else
Print "WORK IN PROGRESS"
End If
End If
If Menu(ActiveMenu).layout Then
If Menu(ActiveMenu).Active Then MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1 Else MenuHover = 0
Else
End If
Else
If mb And Not omb Then 'clicked outside the active menu
MenuHover = 0: SetMenuActive ActiveMenu, 0
End If
End If
omb = mb: omb2 = mb2
End Function
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
If j = MenuHover Then Color LightGray, Black Else Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h <> 0 And Menu(i).Active = -1 Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub SetMenuVisibility (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
Note: I've always enjoyed Terry Ritchie's menu library, but it does one thing which doesn't always play nice with my code: It monopolizes the keyboard and mouse while active. This menu system is being built upon the base principal of NOT doing that, so you're going to have to pass it keycodes and update your mouse buffers elsewhere in your code for this to work properly. (Or at all, honestly.  )
Alt-M has now been added to the demo as a way to turn our menu active or inactive.
Mouse click on the inactive menu to make it active.
Move mouse up or down to watch our highlighted choice change to stay current with the mouse.
Click the mouse with the pointer in the menu, and with the menu active, and get a selection!
Click the mouse outside the menu, and the menu goes inactive without a selection.
Keyboard support is still forthcoming. (So far, ALT-M is the only stroke keyed into the program.)
Horizontal layout is still forthcoming. (We can draw them, but we can't interact with them yet.)
Still definitely a work-in-progress, but it's inching forward into something usable every so slowly!
Posts: 593
Threads: 44
Joined: Apr 2022
Reputation:
43
(11-25-2022, 04:43 AM)SMcNeill Wrote: Note: I've always enjoyed Terry Ritchie's menu library, but it does one thing which doesn't always play nice with my code: It monopolizes the keyboard and mouse while active.
Yeah, that's one of the reasons I rarely used it with a lot of my own software over the years. It was a LOT of work incorporating it into Minesweeper. Looking forward to seeing your approach.
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
CaseSensitive As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0
SetMenuSensitive mainmenu, 0 'we're not a case sensitive menu (F = f, T = t, as far as we're concerned here.)
Do
Cls
While _MouseInput: Wend
k = _KeyHit
mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)
If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If Menu(ActiveMenu).Active Then SetMenuActive ActiveMenu, 0 Else SetMenuActive ActiveMenu, -1
End Select
End If
Drawmenus
result = CheckMenu(k)
If result Then
Locate 10, 1: Print "You clicked menu choice:"; MenuChoice(ActiveMenu, result).Name
Print "Press <ANY KEY> to continue."
_Display
Sleep
End If
If result = 4 Then System 'You did click "QUIT" after all!
_Limit 30
_Display
omb = mb: omb2 = mb2 'store old mouse values
Loop
Sub SetMenuSensitive (whichmenu, state)
Menu(whichmenu).CaseSensitive = state
End Sub
Sub SetMenuActive (whichmenu, state)
For i = 1 To 100: Menu(i).Active = 0: Next
If whichmenu Then
Menu(whichmenu).Active = state
If state Then MenuHover = 1 Else MenuHover = 0
ActiveMenu = whichmenu
End If
End Sub
Function MouseOverActiveMenu
If Menu(ActiveMenu).Visible = 0 Then Exit Function
'the mouse can only be counted as being over the active menu, if the active menu is visible
mx = _MouseX: my = _MouseY
If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
MouseOverActiveMenu = -1
End If
End If
End Function
Function CheckMenu (tempK As Long) 'pass this your current keyhit value.
'Checkmenu doesn't actually update or pull info from any buffers itself. You'll need to get your keystate values elsewhere.
'as well as have your While _MouseInput: Wend routine elsewhere in your code.
Static omb, omb2, omx, omy
mb = _MouseButton(1): mb2 = _MouseButton(2)
mx = _MouseX: my = _MouseY
k = tempK
If Menu(ActiveMenu).CaseSensitive = 0 Then k = k And Not 32
If Menu(ActiveMenu).Visible = 0 Then Exit Function 'We don't check anything for hidden menus
If Menu(ActiveMenu).Active Then
If k > 0 Then 'process keyhits sent to the checkmenu
If _KeyDown(100308) Or _KeyDown(100307) Then 'we're dealing with an ALT + keypress
For i = 1 To Menu(ActiveMenu).totalChoices
H = MenuChoice(ActiveMenu, i).HighLight
If H Then
a = Asc(MenuChoice(ActiveMenu, i).Name, H)
If Menu(ActiveMenu).CaseSensitive = 0 Then a = a And Not 32
If a = k Then CheckMenu = i: SetMenuActive ActiveMenu, 0: Exit Function
End If
Next
End If
If Menu(ActiveMenu).layout Then
Select Case k 'normal keystrokes
Case 18432
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 20480
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
Case 13
CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
End Select
Else
Select Case k
End Select
End If
End If
End If
If MouseOverActiveMenu Then
If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
If mb And Not omb Then SetMenuActive ActiveMenu, -1
Else 'the menu is already active. Check to see if we clicked on something
If Menu(ActiveMenu).layout Then
If mb And Not omb Then CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
Else
Print "WORK IN PROGRESS"
End If
End If
If mx <> omx Or my <> omy Then 'if the mouse x/y position changed, update the menu hover choice
If Menu(ActiveMenu).layout Then
If Menu(ActiveMenu).Active Then MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1 Else MenuHover = 0
Else
End If
End If
Else
If mb And Not omb Then 'clicked outside the active menu
MenuHover = 0: SetMenuActive ActiveMenu, 0
End If
End If
omb = mb: omb2 = mb2
omx = mx: omy = my
End Function
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
If j = MenuHover Then Color LightGray, Black Else Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h <> 0 And Menu(i).Active = -1 Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub SetMenuVisibility (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
Menu(MIU).CaseSensitive = -1
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
We now have keyboard support! (Well for vertical menus... The horizontal menus are still very much a WIP. )
We also now offer an option for case sensitive menus. "#File", sets up a hotkey for "Alt + F" to quick choose that menu option. With a single toggle now to SetMenuSensitive, we can now set if we want to check for case sensitivity characters. Is "F" the same as "f", as far as we're concerned with the menu? Set the toggle and decide for yourself!
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
(11-25-2022, 04:58 AM)TerryRitchie Wrote: (11-25-2022, 04:43 AM)SMcNeill Wrote: Note: I've always enjoyed Terry Ritchie's menu library, but it does one thing which doesn't always play nice with my code: It monopolizes the keyboard and mouse while active.
Yeah, that's one of the reasons I rarely used it with a lot of my own software over the years. It was a LOT of work incorporating it into Minesweeper. Looking forward to seeing your approach.
The basic concept here breaks down to this logic:
Code: (Select All) While _MouseInput: Wend
k = _KeyHit
result = CheckMenu(k)
You have to manually update your mouse buffers yourself -- the check menu routine doesn't do that at all for you -- and you have to send it whatever keypress you want it to check against. (And even then, it only does those things if the menu is VISIBLE and ACTIVE.)
Note that the menu doesn't have any hotkey configured to automatically make it active, so by default, it won't ever interfere with any of your program's configured keystrokes. You have to manually make the menu active yourself:
Code: (Select All) If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If Menu(ActiveMenu).Active Then SetMenuActive ActiveMenu, 0 Else SetMenuActive ActiveMenu, -1
End Select
End If
(If the menu is visible, and ACTIVE, but basically in stand-by mode, you can click the mouse on it to make it fully active. Otherwise, the menu does nothing at all until it's set active and ready for interaction.)
Another base concept here is that I'm not worrying about trying to support multi-level menus. Everything is just a single level branch...
For example, what we have in the demo here is just a single menu with "File, Edit, Help, and Quit". My basic idea here is that we'd start with the mainmenu and set it visible and active. The user chooses one of those options (or cancels/ clicks outside the menu), and if they choose "File", for example, then we simply pull up a different menu, display its choices (Open, Save, Recent Files, ect), and process things as normal there.
Multiple windows can be visible (such as MainMenu, FileMenu), but only one can ever be active at a time (FileMenu), which is the one we're actually interacting with. The rest are just there for past reference, and whatnot, so the user can know how they navigated to where they are now. (Provided we keep them visible, that is. After all, it's just a toggle to change visible state for us.)
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
A demo where we're actually doing something in the background (only printing "Hello World", but it's still doing something), so you can see how our menu would interact with the main program. Notice that the whole time the menu is up and going here, the main program doesn't stop doing its thing until we actually select a choice, and then it pauses because that's what we chose to have it do with our result:
Code: (Select All) If result Then
Print
Print
Print "You clicked menu choice:"; MenuChoice(ActiveMenu, result).Name
Print "Press <ANY KEY> to continue."
_Display
Sleep
End If
It's that Sleep statement in there that tells us to stop and take a pause so you can read what choice you made. 
And here's the "Run stuff in the background with the menu" demo:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
CaseSensitive As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0
SetMenuSensitive mainmenu, 0 'we're not a case sensitive menu (F = f, T = t, as far as we're concerned here.)
Do
Print "Hello World";
While _MouseInput: Wend
k = _KeyHit
mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)
If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If IsMenuActive(mainmenu) Then SetMenuActive mainmenu, 0 Else SetMenuActive mainmenu, -1
End Select
End If
Drawmenus
result = CheckMenu(k)
If result Then
Print
Print
Print "You clicked menu choice:"; MenuChoice(ActiveMenu, result).Name
Print "Press <ANY KEY> to continue."
_Display
Sleep
End If
If result = 4 Then System 'You did click "QUIT" after all!
_Limit 30
_Display
omb = mb: omb2 = mb2 'store old mouse values
Loop
Sub SetMenuSensitive (whichmenu, state)
Menu(whichmenu).CaseSensitive = state
End Sub
Sub SetMenuActive (whichmenu, state)
For i = 1 To 100: Menu(i).Active = 0: Next
If whichmenu Then
Menu(whichmenu).Active = state
If state Then MenuHover = 1 Else MenuHover = 0
ActiveMenu = whichmenu
End If
End Sub
Function IsMenuActive% (whichmenu)
IsMenuActive% = Menu(whichmenu).Active
End Function
Function MouseOverActiveMenu
If Menu(ActiveMenu).Visible = 0 Then Exit Function
'the mouse can only be counted as being over the active menu, if the active menu is visible
mx = _MouseX: my = _MouseY
If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
MouseOverActiveMenu = -1
End If
End If
End Function
Function CheckMenu (tempK As Long) 'pass this your current keyhit value.
'Checkmenu doesn't actually update or pull info from any buffers itself. You'll need to get your keystate values elsewhere.
'as well as have your While _MouseInput: Wend routine elsewhere in your code.
Static omb, omb2, omx, omy
mb = _MouseButton(1): mb2 = _MouseButton(2)
mx = _MouseX: my = _MouseY
k = tempK
If Menu(ActiveMenu).CaseSensitive = 0 Then k = k And Not 32
If Menu(ActiveMenu).Visible = 0 Then Exit Function 'We don't check anything for hidden menus
If Menu(ActiveMenu).Active Then
If k > 0 Then 'process keyhits sent to the checkmenu
If _KeyDown(100308) Or _KeyDown(100307) Then 'we're dealing with an ALT + keypress
For i = 1 To Menu(ActiveMenu).totalChoices
H = MenuChoice(ActiveMenu, i).HighLight
If H Then
a = Asc(MenuChoice(ActiveMenu, i).Name, H)
If Menu(ActiveMenu).CaseSensitive = 0 Then a = a And Not 32
If a = k Then CheckMenu = i: SetMenuActive ActiveMenu, 0: Exit Function
End If
Next
End If
If Menu(ActiveMenu).layout Then
Select Case k 'normal keystrokes
Case 18432
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 20480
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
Case 13
CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
Case 27
MenuHover = 0: SetMenuActive ActiveMenu, 0 'close the menu without a result
End Select
Else
Select Case k
End Select
End If
End If
End If
If MouseOverActiveMenu Then
If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
If mb And Not omb Then SetMenuActive ActiveMenu, -1
Else 'the menu is already active. Check to see if we clicked on something
If Menu(ActiveMenu).layout Then
If mb And Not omb Then CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
Else
Print "WORK IN PROGRESS"
End If
End If
If mx <> omx Or my <> omy Then 'if the mouse x/y position changed, update the menu hover choice
If Menu(ActiveMenu).layout Then
If Menu(ActiveMenu).Active Then MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1 Else MenuHover = 0
Else
End If
End If
Else
If mb And Not omb Then 'clicked outside the active menu
MenuHover = 0: SetMenuActive ActiveMenu, 0
End If
End If
omb = mb: omb2 = mb2
omx = mx: omy = my
End Function
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
If j = MenuHover Then Color LightGray, Black Else Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h <> 0 And Menu(i).Active = -1 Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub SetMenuVisibility (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
Menu(MIU).CaseSensitive = -1
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
Horizontal and vertical menus both work now.
We now can use multiple menus in the same program.
The demo has expanded to showcase this functionality:
Code: (Select All) Screen _NewImage(800, 600, 32)
$Color:32
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
CaseSensitive As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help" + Chr$(0) + "Qui#t" + Chr$(0), 0)
filemenu = DefineMenu("#Open" + Chr$(0) + "#Save" + Chr$(0) + "#Print" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0
SetMenuSensitive mainmenu, 0 'we're not a case sensitive menu (F = f, T = t, as far as we're concerned here.)
SetMenuSensitive filemenu, 0
SetMenuPos filemenu, 0, _FontHeight
Do
Print "Hello World";
While _MouseInput: Wend
k = _KeyHit
mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)
If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If IsMenuActive(mainmenu) Then SetMenuActive mainmenu, 0 Else SetMenuActive mainmenu, -1
End Select
End If
Line (0, 0)-(_Width, 4 * _FontHeight), &HFF000000, BF 'just a black screen to draw under our menus
If IsMenuActive(filemenu) = 0 Then SetMenuVisibility filemenu, 0
Drawmenus
result = CheckMenu(k)
Select Case _Trim$(MenuChoice(ActiveMenu, result).Name)
Case "File"
SetMenuVisibility filemenu, -1
SetMenuActive filemenu, -1
Case "Edit"
Print
Print "There is no code for EDIT! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
Case "Help"
Print
Print "There is no code for HELP! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
Case "Quit"
System
Case "Open"
file$ = _OpenFileDialog$("Open File", _StartDir$ + "\", "*.*", "Any File", 0)
_MessageBox "Information", "You selected " + file$
Case "Save"
file$ = _SaveFileDialog$("Save File", "", "*.txt|*.doc", "Text files")
_MessageBox "Information", "File did not get saved to " + file$ + ". THIS IS JUST A DEMO!"
Case "Print"
Print
Print "There is no code for PRINT! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
End Select
_Limit 30
_Display
omb = mb: omb2 = mb2 'store old mouse values
Loop
Sub SetMenuSensitive (whichmenu, state)
Menu(whichmenu).CaseSensitive = state
End Sub
Sub SetMenuActive (whichmenu, state)
For i = 1 To 100: Menu(i).Active = 0: Next
If whichmenu Then
Menu(whichmenu).Active = state
If state Then MenuHover = 1 Else MenuHover = 0
ActiveMenu = whichmenu
End If
End Sub
Function IsMenuActive% (whichmenu)
IsMenuActive% = Menu(whichmenu).Active
End Function
Function MouseOverActiveMenu
If Menu(ActiveMenu).Visible = 0 Then Exit Function
'the mouse can only be counted as being over the active menu, if the active menu is visible
mx = _MouseX: my = _MouseY
If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
MouseOverActiveMenu = -1
End If
End If
End Function
Function CheckMenu (tempK As Long) 'pass this your current keyhit value.
'Checkmenu doesn't actually update or pull info from any buffers itself. You'll need to get your keystate values elsewhere.
'as well as have your While _MouseInput: Wend routine elsewhere in your code.
Static omb, omb2, omx, omy
mb = _MouseButton(1): mb2 = _MouseButton(2)
mx = _MouseX: my = _MouseY
k = tempK
If Menu(ActiveMenu).CaseSensitive = 0 Then k = k And Not 32
If Menu(ActiveMenu).Visible = 0 Then Exit Function 'We don't check anything for hidden menus
If Menu(ActiveMenu).Active Then
If k > 0 Then 'process keyhits sent to the checkmenu
If _KeyDown(100308) Or _KeyDown(100307) Then 'we're dealing with an ALT + keypress
For i = 1 To Menu(ActiveMenu).totalChoices
H = MenuChoice(ActiveMenu, i).HighLight
If H Then
a = Asc(MenuChoice(ActiveMenu, i).Name, H)
If Menu(ActiveMenu).CaseSensitive = 0 Then a = a And Not 32
If a = k Then CheckMenu = i: SetMenuActive ActiveMenu, 0: Exit Function
End If
Next
End If
Select Case k 'normal keystrokes that apply to all layouts
Case 13
CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
Case 27
MenuHover = 0: SetMenuActive ActiveMenu, 0 'close the menu without a result
End Select
If Menu(ActiveMenu).layout Then
Select Case k 'normal keystrokes
Case 18432
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 20480
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
End Select
Else
Select Case k
Case 19200
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 19712
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
End Select
End If
End If
End If
If MouseOverActiveMenu Then
If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
If mb And Not omb Then
SetMenuActive ActiveMenu, -1
If Menu(ActiveMenu).layout Then
MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1
Else
For i = 1 To Menu(ActiveMenu).totalChoices
xPos = Menu(ActiveMenu).xPos + MenuChoice(ActiveMenu, i).xOffset
If mx >= xPos And mx <= xPos + MenuChoice(ActiveMenu, i).width Then MenuHover = i: Exit For
Next
End If
End If
Else 'the menu is already active. Check to see if we clicked on something
If mb And Not omb Then omb = mb: CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
If mx <> omx Or my <> omy Then 'if our mouse position moved, see if we need to update our hover selection
If Menu(ActiveMenu).layout Then
MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1
Else
For i = 1 To Menu(ActiveMenu).totalChoices
xPos = Menu(ActiveMenu).xPos + MenuChoice(ActiveMenu, i).xOffset
If mx >= xPos And mx <= xPos + MenuChoice(ActiveMenu, i).width Then MenuHover = i: Exit For
Next
End If
End If
End If
Else
If mb And Not omb Then 'clicked outside the active menu
MenuHover = 0: SetMenuActive ActiveMenu, 0
End If
End If
omb = mb: omb2 = mb2
omx = mx: omy = my
End Function
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color Black, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
For j = 1 To Menu(i).totalChoices
If j = MenuHover And Menu(i).Active Then Color LightGray, Black Else Color Black, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h <> 0 And Menu(i).Active = -1 Then
Color White, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub SetMenuVisibility (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
Menu(MIU).CaseSensitive = -1
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation:
116
An update to tweak a few things to make them a little more user friendly and interactive.
One important change is the call to CheckMenu -- it now expects you to use two LONG type variables when you call it, so it can pass values back to you via those parameters.
Code: (Select All) result = CheckMenu(k, mla) 'IMPORTANT NOTE: THESE TWO VARIABLES NEED TO BE LONG TO PASS VALUES BACK AND FORTH PROPERLY!!
k is the variable for whatever you use with your _KEYHIT routine, so you can pass the user's keyboard input to the function.
mla is the Menu Last Active, and you'll probably need it to know which menu the user was interacting with when they generated a result. (Of course, if you only have a single menu in your program, you can probably forget about this, as it really won't apply so much for you.)
The newest version of this code is now: Code: (Select All) Screen _NewImage(800, 600, 32)
Type Menu_Entries
Name As String
HighLight As Integer
Active As Integer
xOffset As Integer
yOffset As Integer
width As Integer
height As Integer
End Type
Type Menu_Metadata
inUse As Integer
totalChoices As Integer
xPos As Integer
yPos As Integer
width As Integer
height As Integer
layout As Integer '0 for left-right, anything else for up-down
Active As Integer
Visible As Integer
CaseSensitive As Integer
End Type
Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu
Dim As Long k, mla
mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help" + Chr$(0) + "Qui#t" + Chr$(0), 0)
filemenu = DefineMenu("#Open" + Chr$(0) + "#Save" + Chr$(0) + "#Print" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0
SetMenuSensitive mainmenu, 0 'we're not a case sensitive menu (F = f, T = t, as far as we're concerned here.)
SetMenuSensitive filemenu, 0
SetMenuPos filemenu, 0, _FontHeight
Do
Print "Hello World";
While _MouseInput: Wend
k = _KeyHit
mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)
If _KeyDown(100308) Or _KeyDown(100307) Then
Select Case k
Case 109, 77 'alt-m will toggle my menu here to set it active or not
If IsMenuActive(mainmenu) Then SetMenuActive mainmenu, 0 Else SetMenuActive mainmenu, -1
End Select
End If
Line (0, 0)-(_Width, 4 * _FontHeight), &HFF000000&&, BF 'just a black screen to draw under our menus
If IsMenuActive(filemenu) = 0 Then SetMenuVisibility filemenu, 0 'If our filemenu isn't active, then it doesn't need to be visible.
If CheckActiveMenu = 0 Then SetMenuActive mainmenu, 0 'If there' no menus active, I want to default back to the mainmenu being the active one
Drawmenus
result = CheckMenu(k, mla) 'IMPORTANT NOTE: THESE TWO VARIABLES NEED TO BE LONG TO PASS VALUES BACK AND FORTH PROPERLY!!
If result Then
Select Case mla 'menu last active
Case mainmenu
Select Case _Trim$(MenuChoice(mainmenu, result).Name)
Case "File"
SetMenuVisibility filemenu, -1 'this makes the filemenu visible
SetMenuActive filemenu, -1 'and this makes it the active menu that we're interacting with.
Case "Edit"
Print
Print "There is no code for EDIT! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
Case "Help"
Print
Print "There is no code for HELP! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
Case "Quit"
System
End Select
Case filemenu
Select Case _Trim$(MenuChoice(filemenu, result).Name)
Case "Open"
file$ = _OpenFileDialog$("Open File", _StartDir$ + "\", "*.*", "Any File", 0)
_MessageBox "Information", "You selected " + file$ + ". Too bad this is just a demo and we're not really loading anything."
Case "Save"
file$ = _SaveFileDialog$("Save File", "", "*.txt|*.doc", "Text files")
_MessageBox "Information", "File did not get saved to " + file$ + ". THIS IS JUST A DEMO!"
Case "Print"
Print
Print "There is no code for PRINT! Sorry."
Print "Press <ANY KEY> to resume."
_Display
Sleep
End Select
End Select
End If
_Limit 30
_Display
omb = mb: omb2 = mb2 'store old mouse values
Loop
Sub SetMenuSensitive (whichmenu, state)
Menu(whichmenu).CaseSensitive = state
End Sub
Sub SetMenuActive (whichmenu, state)
For i = 1 To 100: Menu(i).Active = 0: Next
If whichmenu Then
Menu(whichmenu).Active = state
If state Then MenuHover = 1 Else MenuHover = 0
ActiveMenu = whichmenu
Else
ActiveMenu = 0
MenuHover = 0
End If
End Sub
Function CheckActiveMenu%
CheckActiveMenu = ActiveMenu
End Function
Function IsMenuActive% (whichmenu)
IsMenuActive% = Menu(whichmenu).Active
End Function
Function MouseOverActiveMenu
If Menu(ActiveMenu).Visible = 0 Then Exit Function
'the mouse can only be counted as being over the active menu, if the active menu is visible
mx = _MouseX: my = _MouseY
If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
MouseOverActiveMenu = -1
End If
End If
End Function
Function CheckMenu (tempK As Long, LastActiveMenu As Long) 'pass this your current keyhit value.
'Checkmenu doesn't actually update or pull info from any buffers itself. You'll need to get your keystate values elsewhere.
'as well as have your While _MouseInput: Wend routine elsewhere in your code.
Static omb, omb2, omx, omy
mb = _MouseButton(1): mb2 = _MouseButton(2)
mx = _MouseX: my = _MouseY
k = tempK
If ActiveMenu = 0 Then Exit Function
If Menu(ActiveMenu).CaseSensitive = 0 Then k = k And Not 32
If Menu(ActiveMenu).Visible = 0 Then Exit Function 'We don't check anything for hidden menus
LastActiveMenu = ActiveMenu
If Menu(ActiveMenu).Active Then
If k > 0 Then 'process keyhits sent to the checkmenu
If _KeyDown(100308) Or _KeyDown(100307) Then 'we're dealing with an ALT + keypress
For i = 1 To Menu(ActiveMenu).totalChoices
H = MenuChoice(ActiveMenu, i).HighLight
If H Then
a = Asc(MenuChoice(ActiveMenu, i).Name, H)
If Menu(ActiveMenu).CaseSensitive = 0 Then a = a And Not 32
If a = k Then CheckMenu = i: SetMenuActive 0, 0: Exit Function
End If
Next
End If
Select Case k 'normal keystrokes that apply to all layouts
Case 13
CheckMenu = MenuHover: SetMenuActive 0, 0: Exit Function
Case 27
MenuHover = 0: SetMenuActive 0, 0 'close the menu without a result
End Select
If Menu(ActiveMenu).layout Then
Select Case k 'normal keystrokes
Case 18432
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 20480
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
End Select
Else
Select Case k
Case 19200
MenuHover = MenuHover - 1
If MenuHover < 1 Then MenuHover = Menu(ActiveMenu).totalChoices
Case 19712
MenuHover = MenuHover + 1
If MenuHover > Menu(ActiveMenu).totalChoices Then MenuHover = 1
End Select
End If
End If
End If
If MouseOverActiveMenu Then
If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
If mb And Not omb Then
SetMenuActive ActiveMenu, -1
If Menu(ActiveMenu).layout Then
MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1
Else
For i = 1 To Menu(ActiveMenu).totalChoices
xPos = Menu(ActiveMenu).xPos + MenuChoice(ActiveMenu, i).xOffset
If mx >= xPos And mx <= xPos + MenuChoice(ActiveMenu, i).width Then MenuHover = i: Exit For
Next
End If
End If
Else 'the menu is already active. Check to see if we clicked on something
If mb And Not omb Then omb = mb: CheckMenu = MenuHover: SetMenuActive 0, 0: Exit Function
If mx <> omx Or my <> omy Then 'if our mouse position moved, see if we need to update our hover selection
If Menu(ActiveMenu).layout Then
MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1
Else
For i = 1 To Menu(ActiveMenu).totalChoices
xPos = Menu(ActiveMenu).xPos + MenuChoice(ActiveMenu, i).xOffset
If mx >= xPos And mx <= xPos + MenuChoice(ActiveMenu, i).width Then MenuHover = i: Exit For
Next
End If
End If
End If
Else
If mb And Not omb Then 'clicked outside the active menu
MenuHover = 0: SetMenuActive 0, 0
End If
End If
omb = mb: omb2 = mb2
omx = mx: omy = my
End Function
Sub Drawmenus
DC&& = _DefaultColor: BG&& = _BackgroundColor
Color &HFF000000&&, 0
For i = 1 To 100
If Menu(i).inUse And Menu(i).Visible Then
xp = Menu(i).xPos: yp = Menu(i).yPos
Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &HFFBBBBBB&&, BF
For j = 1 To Menu(i).totalChoices
If j = MenuHover And Menu(i).Active Then Color &HFFBBBBBB&&, &HFF000000&& Else Color &HFF000000&&, 0
_PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
h = MenuChoice(i, j).HighLight
If h <> 0 And Menu(i).Active = -1 Then
Color &HFFFFFFFF&&, 0
_PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
End If
Next
If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
End If
Next
Color DC&&, BG&&
End Sub
Sub SetMenuPos (whichMenu, xPos, yPos)
Menu(whichMenu).xPos = xPos
Menu(whichMenu).yPos = yPos
End Sub
Sub SetMenuVisibility (whichMenu, visible)
Menu(whichMenu).Visible = visible
End Sub
Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
'first, check for a free menu handle
For i = 1 To 100
If Menu(i).inUse = 0 Then Exit For
Next
If i > 100 Then Exit Function 'return a value of 0 as we have no available menus
MIU = i 'Menu in Use
'parse choices$
Dim item(1000) As String
c$ = choices$
maxWidth = 0
Do
count = count + 1
i = InStr(c$, Chr$(0))
If i Then
item(count) = " " + Left$(c$, i - 1) + " "
c$ = Mid$(c$, i + 1)
Else
item(count) = " " + c$ + " "
End If
L = Len(item(count))
If InStr(item(count), "#") Then L = L - 1
If L > maxWidth Then maxWidth = L
Loop Until i = 0 Or c$ = ""
Menu(MIU).inUse = -1
Menu(MIU).totalChoices = count
Menu(MIU).xPos = 0 'can set these later
Menu(MIU).yPos = 0
If layout Then 'vertical menu
Menu(MIU).layout = -1
Menu(MIU).width = maxWidth * _FontWidth
Menu(MIU).height = count * _FontHeight
Else 'hortizontal menu
Menu(MIU).layout = 0
Menu(MIU).height = _FontHeight
End If
Menu(MIU).Active = 0
Menu(MIU).Visible = 0
Menu(MIU).CaseSensitive = -1
For i = 1 To count
L = InStr(item(i), "#")
If L Then
MenuChoice(MIU, i).HighLight = L
item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
End If
MenuChoice(MIU, i).Name = item(i)
MenuChoice(MIU, i).Active = -1
If layout Then 'vertical
MenuChoice(MIU, i).xOffset = 0
MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Else 'hortizontal
MenuChoice(MIU, i).xOffset = wide
MenuChoice(MIU, i).yOffset = 0
wide = wide + Len(item(i)) * _FontWidth
MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
Menu(MIU).width = wide
End If
MenuChoice(MIU, i).height = _FontHeight
Next
DefineMenu = MIU
End Function
|
