EVMS -- Easy Versatile Menu System

[PhilOfPerth]

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!