b+ Beginners Corner

[bplus]

OK @Dimster and @OldMoses I think I have it roughed out:

Code: (Select All)

Option _Explicit
_Title "Drop Menu function test" 'b+ 2023-06-25
' Instigated by Dimster here:
' https://staging.qb64phoenix.com/showthread.php?tid=1693&pid=17117#pid17117

Const ButtonW = 200, ButtonH = 20, Spacer = 2
Type BoxType ' to be used for mouse click checking
    As String Label
    As Long LeftX, TopY, BoxW, BoxH ' left most = x, top most = y, box width = w, box height = h
End Type
Dim Shared As Integer NBoxes
NBoxes = 72
Dim Shared Boxes(1 To NBoxes) As BoxType
Dim As Integer i, x, y, mz, mx, my, nItems, choice
ReDim menu$(1 To 1)
Dim s$
Screen _NewImage(806, 600, 32)
_ScreenMove 250, 50
_PrintMode _KeepBackground
Cls ' so
' set up boxes
x = 0: y = 0
For i = 1 To NBoxes
    Boxes(i).Label = "Box" + Str$(i)
    Boxes(i).LeftX = x: Boxes(i).TopY = y
    Boxes(i).BoxW = ButtonW
    Boxes(i).BoxH = ButtonH
    If (x + 2 * ButtonW + Spacer) > _Width Then
        x = 0: y = y + ButtonH + Spacer
    Else
        x = x + ButtonW + Spacer
    End If
    DrawTitleBox i
Next
Do
    mz = MouseZone%(mx, my)
    'If mz Then _MessageBox "Mouse Click Detected", "Box" + Str$(mz) + " @" + Str$(mx) + Str$(my), "info"
    If mz Then
        ' quick make up a menu of items for box mz
        nItems = Int(Rnd * 10) + 1
        ' nItems = 10 ' for testing
        ReDim menu$(1 To nItems)
        For i = 1 To nItems
            menu$(i) = "Box" + Str$(mz) + " Menu Item:" + Str$(i)
        Next
        choice = getButtonNumberChoice%(Boxes(mz).LeftX, Boxes(mz).TopY, menu$())
        If choice = 0 Then s$ = "You quit menu." Else s$ = menu$(choice)
        _MessageBox "Drop Menu Test", "Your Menu Choice was: " + s$, "info"
    End If
    _Limit 30
Loop Until _KeyDown(27)
Sub DrawTitleBox (i)
    Line (Boxes(i).LeftX, Boxes(i).TopY)-Step(ButtonW, ButtonH), &HFFFF0000, BF
    Color &HFFFFFFFF
    _PrintString (Boxes(i).LeftX + (ButtonW - _PrintWidth(Boxes(i).Label)) / 2, Boxes(i).TopY + ButtonH / 2 - 8), Boxes(i).Label
End Sub
Sub DrawChoiceBox (leftX, topY, S$)
    Line (leftX, topY)-Step(ButtonW, ButtonH), &HFFAABBFF, BF
    Line (leftX, topY)-Step(ButtonW, ButtonH), &HFF000000, B
    Color &HFF000088
    _PrintString (leftX + (ButtonW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
End Sub
Function MouseZone% (mx%, my%) ' returns the boxes index clicked or 0 and
    ' Set the following up in your Main code of app
    'Type BoxType ' to be used for mouse click checking
    '   As Long LeftX, TopY, BoxW, BoxH ' left most = x, top most = y, box width = w, box height = h
    'End Type
    'Dim Shared As Integer NBoxes
    'Dim Shared Boxes(1 To NBoxes) As BoxType
    ' If function detects a mouse click inside a box mx and my will be adjusted to top left
    'corner of box and box index returned by function name
    Dim As Integer i, mb
    mx% = -1: my% = -1 ' not valid zone signal
    While _MouseInput: Wend ' poll mouse
    mb = _MouseButton(1)
    If mb Then
        _Delay .25
        mx% = _MouseX: my% = _MouseY
        For i = 1 To NBoxes
            If mx% > Boxes(i).LeftX And mx% < Boxes(i).LeftX + Boxes(i).BoxW Then
                If my% > Boxes(i).TopY And my% < Boxes(i).TopY + Boxes(i).BoxH Then
                    mx% = mx% - Boxes(i).LeftX: my% = my% - Boxes(i).TopY
                    MouseZone% = i: Exit Function
                End If
            End If
        Next
    End If
End Function
Function getButtonNumberChoice% (BoxX As Integer, BoxY As Integer, choice$())
    Dim As Integer ub, lb, b, mx, my, mb
    Dim As Long SaveSection
    'this sub uses drwBtn
    ub = UBound(choice$)
    lb = LBound(choice$)
    SaveSection = _NewImage(ButtonW, ButtonH * (ub - lb + 1), 32)
    _PutImage , 0, SaveSection, (BoxX, BoxY + ButtonH)-Step(ButtonW, ButtonH * (ub - lb + 1))
    For b = lb To ub '   drawing a column of buttons at _width - 210 starting at y = 10
        DrawChoiceBox BoxX, BoxY + b * ButtonH, choice$(b)
    Next
    Do
        While _MouseInput: Wend
        mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
        If mb Then
            If mx > BoxX And mx <= BoxX + ButtonW Then
                For b = lb To ub
                    If my >= BoxY + b * ButtonH And my <= BoxY + b * ButtonH + ButtonH Then
                        ' put image back
                        _PutImage (BoxX, BoxY + ButtonH)-Step(ButtonW, ButtonH * (ub - lb + 1)), SaveSection, 0
                        ' delay before exit to give user time to release mouse button
                        _FreeImage SaveSection
                        getButtonNumberChoice% = b: _Delay .25: Exit Function
                    End If
                Next
                Beep
            Else
                Beep
            End If
        End If
        _Limit 60
    Loop
End Function

   

Oops! Forgot if click outside menu while down that is cancel or a quit menu not a beep.

I'll add that and clean up code next.