11-30-2022, 06:15 AM
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.
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:
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