11-25-2022, 07:22 AM
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:
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