11-25-2022, 05:21 AM
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 FunctionWe 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!