Login

***Pete*** · (This post was last modified: 04-03-2025, 10:25 PM by Pete.)

SCREEN 0 with hardware generated dragable popup menu.

To drag: Hold left button down whit mouse cursor at, or slightly avove the first menu item, "cut".

Code: (Select All)

 Dim Shared PopDrg
ReDim Shared text$(0)
Type fields_and_buttons
    ' Input Types
    InputField As Integer
    mvar As Integer
    mwidth As Integer
    mheight As Integer
    ' Popup Colors
    cp2 As Integer ' Popup background.
    cp4 As Integer ' Popup shadow.
    cp1 As Integer ' Available menu item.
    cp3 As Integer ' Unavailable menu item.
End Type
Dim fb As fields_and_buttons
 
fb_palette fb
 
Cls , 7
For i = 1 To _Width * (_Height - 1)
    j = Int(Rnd * 14) + 1
    k = Int(Rnd * 25) + 1
    Color j, 7
    Print Chr$(k + 96);
Next
Color 0, 7: Locate _Height, 2: Print "Right click to display popup menu.";
ReDim menu$(0)
Do
    MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
 
    If rb = 2 Then popit = -1
    If PopDrg Then If drag = 0 Then PopDrg = -1: popit = -1 Else popit = -1
    If popit Then
 
        fb_input_popup fb, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$
 
    End If
    _Display
Loop
 
Sub fb_input_popup (fb As fields_and_buttons, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$)
    Static initiate, h, nomi, oldmy, oldmx
    Static menu_restrict()
    Static menu_variety, MenuHL, MenuT, MenuR, MenuB, MenuL, shadowM, hwpop&
    menu_variety = 1
    y = CsrLin: x = Pos(0)
    restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
    Rem fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
    If fb.mvar Then
        _PutImage ((MenuL - 1) * _FontWidth, (MenuT - 1) * _FontHeight), hwpop&
        If MenuHL Then _PutImage (MenuL * _FontWidth, (MenuHL - 1) * _FontHeight), shadowM
    End If
    If PopDrg > 0 And oldmx = mx And oldmy = my Then Exit Sub
    If initiate = 0 Then
        initiate = 1
        h = 5 ' Variable to determine margin spaces from the right of menu.
        Restore PopupMenuData
 
        PopupMenuData: ' eof must be lowercase.
        Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
        Data Close..........Esc,eof
 
        nomi = 0
        Do
            Read tmp$
            If tmp$ = "eof" Then Exit Do
            nomi = nomi + 1
            ReDim _Preserve menu$(nomi)
            menu$(nomi) = tmp$
        Loop
        If nomi > _Height - 2 Or Len(menu$(1)) > _Width - 4 Then nomi = 0: initiate = 0: Exit Sub ' Not enough room to open popup.
        For i = 1 To nomi ' Determine menu width by largest menu item.
            j = Len(menu$(i))
            If j > k Then k = j
        Next
        fb.mwidth = k + h
        fb.mheight = nomi * 2 + 1 ' Add one for the separate border element.
    End If
    Do
        If PopDrg < 0 Then
            PopDrg = -MenuL
            fb.mvar = 0: MenuHL = 0
            popit = -1
        Else
            If drag And oldmx <> mx Or drag And oldmy <> my Then
                If my > MenuT - 2 And my < MenuT + 2 And mx >= MenuL And mx <= MenuR Or PopDrg Then
                    PopDrg = MenuL - (oldmx - mx):
                    If PopDrg < 1 Then PopDrg = 1 ' Prevents going over left page margin.
                    fb.mvar = 0
                    MenuHL = 0
                    popit = -1 ' Reopens popup in next cycle.
                End If
            End If
        End If
        Select Case fb.mvar
            Case 0 ' Open popup menu.
                fb.mvar = -1 ' Identifies the menu is open.
                If PopDrg = 0 Then
                    ReDim menu_restrict(nomi) ' Restrictions.
                    If text$(fb.InputField) = "" Then
                        For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
                    Else
                        If hl = 0 Then
                            For i = 1 To 4: menu_restrict(i) = 1: Next
                        End If
                    End If
                    If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' End Restrictions.
                    MenuT = 1: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
                    t& = _NewImage((fb.mwidth - 1) * _FontWidth, _FontHeight, 32)
                    _Dest t&
                    Line (0, 0)-((fb.mwidth - 2) * _FontWidth, _FontHeight), _RGB32(128, 128, 128, 190), BF
                    shadowM = _CopyImage(t&, 33)
                    _FreeImage t&
                    t& = _NewImage((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight, 32)
                    _Dest t&
                    Line (0, fb.mheight * _FontHeight)-(fb.mwidth * _FontWidth, fb.mheight * _FontHeight), _RGB32(240, 240.240), BF
                    Line ((fb.mwidth) * _FontWidth, _FontHeight)-((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
                    Line (_FontWidth * 2, (fb.mheight) * _FontHeight)-(fb.mwidth * _FontWidth - 1, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
                    Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
                    Locate MenuT, MenuL
                    Print Chr$(218) + String$(fb.mwidth - 2, 196) + Chr$(191) ' Menu top border.
                    For i = 1 To fb.mheight - 2
                        Locate , MenuL
                        Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
                        Print Chr$(179); Space$(fb.mwidth - 2) + Chr$(179)
                    Next
                    Locate , MenuL
                    Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
                    Print Chr$(192) + String$(fb.mwidth - 2, 196) + Chr$(217); ' Menu bottom border.
                    For i = 0 To nomi - 1 ' Show menu items.
                        Locate MenuT + 1 + i * 2, MenuL + 2
                        If menu_restrict(i + 1) Then
                            Color _RGB32(128, 128, 128), _RGB32(255, 255, 255)
                        Else
                            Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
                        End If
                        Print menu$(i + 1)
                        Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
                        Locate , MenuL
                        If i + 1 < nomi Then Print "Ã" + String$(fb.mwidth - 2, Chr$(196)) + "´";
                    Next
                    hwpop& = _CopyImage(t&, 33)
                    _FreeImage t&
                    _Dest 0
                End If
                MenuHL = 0 ' Removes any menu highlighting when using a right click to move menu.
                Select Case menu_variety
                    Case 0 ' Fixed menu to left.
                        MenuT = 3: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
                    Case 1 ' Movable menu.
                        Select Case PopDrg
                            Case Is < 0
                                MenuL = Abs(PopDrg)
                                PopDrg = 0 ' Drag cycle completed.
                            Case Is > 0
                                MenuT = my
                                MenuL = PopDrg
                            Case 0
                                MenuT = my
                                MenuL = mx
                        End Select
                        If MenuT + fb.mheight > _Height Then MenuT = _Height - fb.mheight ' -1 for shadow.
                        If MenuL + fb.mwidth >= _Width Then MenuL = _Width - fb.mwidth - 1 ' -1 for shadow.
                        MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
                End Select
            Case -1 ' Hover or menu actions.
                If b$ = Chr$(0) + "H" Or mw = -1 Then ' Keyboard ---------------
                    If (MenuHL - MenuT + 1) \ 2 > 1 Then
                        MenuHL = MenuHL - 2
                        b$ = ""
                    End If
                ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
                    If MenuHL = 0 Then
                        MenuHL = MenuT + 1
                    Else
                        If (MenuHL - MenuT + 1) \ 2 < nomi Then
                            MenuHL = MenuHL + 2
                        End If
                    End If
                    b$ = ""
                ElseIf b$ = Chr$(13) And MenuHL Or mb = 2 And MenuHL Then
                    b$ = ""
                    If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
                        fb.mvar = (MenuHL - MenuT + 1) \ 2
                        popit = 0
                        Exit Do
                    End If ' ----------------------------------------------------
                ElseIf Len(b$) Then ' Menu selections by key.
                    Select Case b$
                        Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): popit = 0: Exit Do
                        Case Chr$(27): b$ = "": fb.mvar = 0: popit = 0: Exit Do ' Simply close popup.
                        Case Else: b$ = "" ' Prevents a non-menu response from getting into the input line routine.
                    End Select ' ------------------------------------------------
                Else ' Mouse input.
                    i = my >= MenuT And my < MenuB And mx > MenuL And mx < MenuR
                    If my <> oldmy Or mx <> oldmx Or lb = 2 And drag = 0 Or rb = 2 Then
                        If i Then
                            hot` = (my - MenuT) \ 2 <> (my - MenuT) / 2 ' Local variable to determine if click is on a menu item or space between.
                            If hot` Then
                                If lb = 2 And MenuHL <> my Or rb = 2 And MenuHL <> my Then hot` = 0
                                MenuHL = my
                            End If
                        Else
                            hot` = 0
                        End If
                    End If
                End If
                If rb = 2 And MenuHL <> my Then
                    If Not hot` Then ' If inside menu it will go to next condition.
                        If my <> MenuT Or mx <> MenuL Then ' Reopen only if mouse position has changed.
                            If Not i Then
                                fb.mvar = 0: Exit Do ' Right click to close menu and reopen in new location.
                            End If
                        End If
                    End If
                End If
                If lb = 2 Or rb = 2 Then ' Left mouse click.
                    If hot` Then ' Get selection if non-restricted.
                        If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
                            fb.mvar = (MenuHL - MenuT + 1) \ 2
                            popit = 0
                        End If
                        Exit Do
                    Else ' Close popup if click was outside the menu; otherwise click is ignored.
                        If Not i And rb <> 2 Then ' Never close the popup with a right click.
                            popit = 0
                            fb.mvar = 0
                        End If
                        Exit Do
                    End If
                End If ' --------------------------------------------------------
        End Select
        Exit Do
    Loop
    oldmy = my: oldmx = mx
    If popit = 0 Then MenuHL = 0
    Color restore_color1, restore_color2
    Locate y, x
    _KeyClear
    Select Case fb.mvar
        Case 1: b$ = Chr$(24) ' Cut
        Case 2: b$ = Chr$(3) ' Copy
        Case 3: b$ = Chr$(22) ' Paste
        Case 4: b$ = Chr$(0) + "S" ' Delete
        Case 5: b$ = Chr$(1) ' Select All
        Case 6 ' Close
    End Select
    If fb.mvar > 0 Or Len(b$) Then fb.mvar = 0 ' A selection was reported above or by keyboard shortcut.
End Sub
 
Sub fb_palette (fb As fields_and_buttons)
    ' Reserved colors 3, 5, 6.
    Palette 6, 63 ' Bright white for background uses.
    ' Popup Colors
    fb.cp2 = 6 ' Popup background.
    fb.cp4 = 3 ' Popup shadow.
    fb.cp1 = 0 ' Available menu item.
    fb.cp3 = 7 ' Unavailable menu item.
End Sub
 
Sub MyMouse_and_Keyboard (act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)
    Dim As Integer oldmw
    Static As Integer oldmy, oldmx, mwy, oldmwy
    Static z1 As Single
    Do
        _Limit 60
        act = 0
        If AltStatus% Then AltStatus% = 0
        If Len(autokey$) Then ' Note: Do not exit as mouse buttons may also be going through a cycle when mouse clicks are converted to key entries.
            b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
            autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
            act = 1
        Else
            k& = _KeyHit
            If k& = 100307 Or k& = 100308 Then
                AltStatus% = -1
                AltToggle% = 1 - AltToggle%
                act = 1
                Exit Do
            End If
            If k& > 0 Then
                b$ = MKI$(k&)
                If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
                If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
                act = 3
            Else
                b$ = ""
            End If
        End If
        If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
        If lb > 0 Then If lb = 1 Then lb = -1: act = 1 Else lb = 0: act = -1
        If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0: act = -1
        If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0: act = -1
        While _MouseInput
            mwy = mwy + _MouseWheel: act = 1
        Wend
        my = _MouseY
        mx = _MouseX
        If lb = -1 Then
            If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
                If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
            End If
        End If
        If drag = 0 Then
            If mwy <> oldmw Then
                mw = Sgn(mwy - oldmwy): mwy = 0
            Else
                mw = 0
            End If
            oldmwy = mwy
            If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1: act = 1 Else If shift% Then shift% = 0
            If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1: act = 1 Else If ctrl% Then ctrl% = 0
            If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1: act = 1 Else If alt% Then alt% = 0
            If ctrl% Then ' Convert select all, cut, copy, paste.
                Select Case LCase$(b$)
                    Case "a": b$ = Chr$(1)
                    Case "x": b$ = Chr$(24)
                    Case "c": b$ = Chr$(3)
                    Case "v": b$ = Chr$(22)
                    Case Chr$(0) + "k": b$ = Chr$(0) + "s"
                    Case Chr$(0) + "m": b$ = Chr$(0) + "t"
                End Select
            End If
        End If
        If lb = -1 And _MouseButton(1) = 0 Then
            lb = 2: drag = 0: hover = 0: act = 1
        ElseIf rb = -1 And _MouseButton(2) = 0 Then
            rb = 2: act = 1
        ElseIf mb = -1 And _MouseButton(3) = 0 Then
            mb = 2: act = 1
        End If
        If _MouseButton(1) Then
            If lb = 0 Then
                lb = 1: z1 = Timer: act = 1
                clkcnt = clkcnt + 1
            End If
        ElseIf _MouseButton(2) And rb = 0 Then
            rb = 1: act = 1
        ElseIf _MouseButton(3) And mb = 0 Then
            mb = 1: act = 1
        End If
        If my <> oldmy Or mx <> oldmx Then act = 2
        oldmy = my: oldmx = mx
        Exit Do
    Loop
End Sub

What's neat is the 3-D shadow. It is a proper shadow effect, instead of an approximated simulated effect, which was the best we could do in SCREEN 0, before QB64 evolved into what it is, today.

Right click to open or reopen popup menu.
Use the mouse, wheel, left or middle button, keys, including shortcut keys, etc.

The demo DOES NOT INCLUDE any actions selected.

Edit: Added right click extras to reopen popup at different location or to act as a left click if on a menu item.

Pete

TempodiBasic · 04-02-2025, 10:40 PM

(04-02-2025, 08:47 PM)Pete Wrote: SCREEN 0 with hardware generated dragable popup menu.

To drag: Hold left button down whit mouse cursor at, or slightly avove the first menu item, "cut".

Code: (Select All)

 Dim Shared PopDrg
ReDim Shared text$(0)
Type fields_and_buttons
    ' Input Types
    InputField As Integer
    mvar As Integer
    mwidth As Integer
    mheight As Integer
    ' Popup Colors
    cp2 As Integer ' Popup background.
    cp4 As Integer ' Popup shadow.
    cp1 As Integer ' Available menu item.
    cp3 As Integer ' Unavailable menu item.
End Type
Dim fb As fields_and_buttons
 
fb_palette fb
 
Cls , 7
For i = 1 To _Width * (_Height - 1)
    j = Int(Rnd * 14) + 1
    k = Int(Rnd * 25) + 1
    Color j, 7
    Print Chr$(k + 96);
Next
Color 0, 7: Locate _Height, 2: Print "Right click to display popup menu.";
ReDim menu$(0)
Do
    MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
 
    If rb = 2 Then popit = -1
    If PopDrg Then If drag = 0 Then PopDrg = -1: popit = -1 Else popit = -1
    If popit Then
 
        fb_input_popup fb, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$
 
    End If
    _Display
Loop
 
Sub fb_input_popup (fb As fields_and_buttons, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$)
    Static initiate, nomi, oldmy, oldmx
    Static menu_restrict()
    Static MenuHL, MenuT, MenuR, MenuB, MenuL, shadowM, hwpop&
    menu_variety = 1
    y = CsrLin: x = Pos(0)
    restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
    Rem fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
    If fb.mvar Then
        _PutImage ((MenuL - 1) * _FontWidth, (MenuT - 1) * _FontHeight), hwpop&
        If MenuHL Then _PutImage (MenuL * _FontWidth, (MenuHL - 1) * _FontHeight), shadowM
    End If
    If PopDrg > 0 And oldmx = mx And oldmy = my Then Exit Sub
    If initiate = 0 Then
        initiate = 1
        menu_variety = 1 ' Non-fixed menu.
        h = 5 ' Variable to determine margin spaces from the right of menu.
        Restore PopupMenuData
 
        PopupMenuData: ' eof must be lowercase.
        Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
        Data Close..........Esc,eof
 
        nomi = 0
        Do
            Read tmp$
            If tmp$ = "eof" Then Exit Do
            nomi = nomi + 1
            ReDim _Preserve menu$(nomi)
            menu$(nomi) = tmp$
        Loop
        If nomi > _Height - 2 Or Len(menu$(1)) > _Width - 4 Then nomi = 0: initiate = 0: Exit Sub ' Not enough room to open popup.
        ReDim menu_restrict(nomi) ' Restrictions.
        If text$(fb.InputField) = "" Then
            For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
        Else
            If hl = 0 Then
                For i = 1 To 4: menu_restrict(i) = 1: Next
            End If
        End If
        If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' End Restrictions.
        For i = 1 To nomi ' Determine menu width by largest menu item.
            j = Len(menu$(i))
            If j > k Then k = j
        Next
        fb.mwidth = k + h
        fb.mheight = nomi * 2 + 1 ' Add one for the separate border element.
        MenuT = 1
        MenuL = 1
        MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
        t& = _NewImage((fb.mwidth - 1) * _FontWidth, _FontHeight, 32)
        _Dest t&
        Line (0, 0)-((fb.mwidth - 2) * _FontWidth, _FontHeight), _RGB32(128, 128, 128, 190), BF
        shadowM = _CopyImage(t&, 33)
        _FreeImage t&
        t& = _NewImage((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight, 32)
        _Dest t&
        Line (0, fb.mheight * _FontHeight)-(fb.mwidth * _FontWidth, fb.mheight * _FontHeight), _RGB32(240, 240.240), BF
        Line ((fb.mwidth) * _FontWidth, _FontHeight)-((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
        Line (_FontWidth * 2, (fb.mheight) * _FontHeight)-(fb.mwidth * _FontWidth - 1, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
        Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        Locate MenuT, MenuL
        Print Chr$(218) + String$(fb.mwidth - 2, 196) + Chr$(191) ' Menu top border.
        For i = 1 To fb.mheight - 2
            Locate , MenuL
            Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
            Print Chr$(179); Space$(fb.mwidth - 2) + Chr$(179)
        Next
        Locate , MenuL
        Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        Print Chr$(192) + String$(fb.mwidth - 2, 196) + Chr$(217); ' Menu bottom border.
        For i = 0 To nomi - 1 ' Show menu items.
            Locate MenuT + 1 + i * 2, MenuL + 2
            If menu_restrict(i + 1) Then
                Color _RGB32(128, 128, 128), _RGB32(255, 255, 255)
            Else
                Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
            End If
            Print menu$(i + 1)
            Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
            Locate , MenuL
            If i + 1 < nomi Then Print "Ã" + String$(fb.mwidth - 2, Chr$(196)) + "´";
        Next
        hwpop& = _CopyImage(t&, 33)
        _FreeImage t&
        _Dest 0
    End If
    Do
        If PopDrg < 0 Then
            PopDrg = -MenuL
            fb.mvar = 0: MenuHL = 0
            popit = -1
            Rem PCopy 1, 0 ' Use without hardware background.
        Else
            If drag And oldmx <> mx Or drag And oldmy <> my Then
                If my > MenuT - 2 And my < MenuT + 2 And mx >= MenuL And mx <= MenuR Or PopDrg Then
                    PopDrg = MenuL - (oldmx - mx):
                    If PopDrg < 1 Then PopDrg = 1 ' Prevents going over left page margin.
                    fb.mvar = 0
                    MenuHL = 0
                    Rem PCopy 1, 0 ' Removes current popup. Use instead of CLS without hardware background.
                    popit = -1 ' Reopens popup in next cycle.
                End If
            End If
        End If
        Select Case fb.mvar
            Case 0 ' Open popup menu.
                fb.mvar = -1 ' Identifies the menu is open.
                MenuHL = 0 ' Removes any menu highlighting when using a right click to move menu.
                Select Case menu_variety
                    Case 0 ' Fixed menu to left.
                        MenuT = 3: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
                    Case 1 ' Movable menu.
                        Select Case PopDrg
                            Case Is < 0
                                MenuL = Abs(PopDrg)
                                PopDrg = 0 ' Drag cycle completed.
                            Case Is > 0
                                MenuT = my
                                MenuL = PopDrg
                            Case 0
                                MenuT = my
                                MenuL = mx
                        End Select
                        If MenuT + fb.mheight > _Height Then MenuT = _Height - fb.mheight ' -1 for shadow.
                        If MenuL + fb.mwidth >= _Width Then MenuL = _Width - fb.mwidth - 1 ' -1 for shadow.
                        MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
                End Select
            Case -1 ' Hover or menu actions.
                If b$ = Chr$(0) + "H" Or mw = -1 Then ' Keyboard ---------------
                    If (MenuHL - MenuT + 1) \ 2 > 1 Then
                        MenuHL = MenuHL - 2
                    End If
                ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
                    If MenuHL = 0 Then
                        MenuHL = MenuT + 1
                    Else
                        If (MenuHL - MenuT + 1) \ 2 < nomi Then
                            MenuHL = MenuHL + 2
                        End If
                    End If
                ElseIf b$ = Chr$(13) And MenuHL Or mb = 2 And MenuHL Then
                    If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
                        fb.mvar = (MenuHL - MenuT + 1) \ 2
                        popit = 0
                        Exit Do
                    End If ' ----------------------------------------------------
                ElseIf Len(b$) Then ' Menu selections by key.
                    Select Case b$
                        Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): popit = 0: Exit Do
                        Case Chr$(27): b$ = "": fb.mvar = 0: popit = 0: Exit Do ' Simply close popup.
                    End Select ' ------------------------------------------------
                Else ' Mouse input.
                    i = my >= MenuT And my < MenuB And mx > MenuL And mx < MenuR
                    If my <> oldmy Or mx <> oldmx Or lb = 2 And drag = 0 Then
                        If i Then
                            hot` = (my - MenuT) \ 2 <> (my - MenuT) / 2 ' Local variable to determine if click is on a menu item or space between.
                            If hot` Then
                                If lb = 2 And MenuHL <> my Then hot` = 0
                                MenuHL = my
                            End If
                        Else
                            hot` = 0
                        End If
                    End If
                End If
                If rb = 2 Then
                    If Not hot` Then ' If inside menu it will go to next condition.
                        If my <> MenuT Or mx <> MenuL Then ' Reopen only if mouse position has changed.
                            If Not i Then
                                fb.mvar = 0: Exit Do ' Right click to close menu and reopen in new location.
                            End If
                        End If
                    End If
                End If
                If lb = 2 Or rb = 2 Then ' Left mouse click.
                    If hot` Then ' Get selection if non-restricted.
                        If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
                            fb.mvar = (MenuHL - MenuT + 1) \ 2
                            popit = 0
                        End If
                        Exit Do
                    Else ' Close popup if click was outside the menu; otherwise click is ignored.
                        If Not i And rb <> 2 Then ' Never close the popup with a right click.
                            popit = 0
                            fb.mvar = 0
                        End If
                        Exit Do
                    End If
                End If ' --------------------------------------------------------
        End Select
        Exit Do
    Loop
    oldmy = my: oldmx = mx
    If popit = 0 Then MenuHL = 0
    Color restore_color1, restore_color2
    Locate y, x
    _KeyClear
    Select Case fb.mvar
        Case 1: b$ = Chr$(24) ' Cut
        Case 2: b$ = Chr$(3) ' Copy
        Case 3: b$ = Chr$(22) ' Paste
        Case 4: b$ = Chr$(0) + "S" ' Delete
        Case 5: b$ = Chr$(1) ' Select All
        Case 6 ' Do nothing. (Close Menu).
    End Select
    If fb.mvar > 0 Then fb.mvar = 0
End Sub
 
Sub fb_palette (fb As fields_and_buttons)
    ' Reserved colors 3, 5, 6.
    Palette 6, 63 ' Bright white for background uses.
    ' Popup Colors
    fb.cp2 = 6 ' Popup background.
    fb.cp4 = 3 ' Popup shadow.
    fb.cp1 = 0 ' Available menu item.
    fb.cp3 = 7 ' Unavailable menu item.
End Sub
 
Sub MyMouse_and_Keyboard (act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)
    Dim As Integer oldmw
    Static As Integer oldmy, oldmx, mwy, oldmwy
    Static z1 As Single
    Do
        _Limit 60
        act = 0
        If AltStatus% Then AltStatus% = 0
        If Len(autokey$) Then
            b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
            autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
            act = 1
            Exit Do
        Else
            k& = _KeyHit
            If k& = 100307 Or k& = 100308 Then
                AltStatus% = -1
                AltToggle% = 1 - AltToggle%
                act = 1
                Exit Do
            End If
            If k& > 0 Then
                b$ = MKI$(k&)
                If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
                If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
                act = 3
            Else
                b$ = ""
            End If
        End If
        If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
        If lb > 0 Then
            If lb = 1 Then
                lb = -1: act = 1
            Else
                lb = 0: act = -1
            End If
        End If
        If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0
        If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0
        While _MouseInput
            mwy = mwy + _MouseWheel: act = 1
        Wend
        my = _MouseY
        mx = _MouseX
        If lb = -1 Then
            If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
                If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
            End If
        End If
        If drag = 0 Then
            If mwy <> oldmw Then
                mw = Sgn(mwy - oldmwy): mwy = 0
            Else
                mw = 0
            End If
            oldmwy = mwy
            If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1: act = 1 Else If shift% Then shift% = 0
            If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1: act = 1 Else If ctrl% Then ctrl% = 0
            If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1: act = 1 Else If alt% Then alt% = 0
            If ctrl% Then ' Convert select all, cut, copy, paste.
                Select Case LCase$(b$)
                    Case "a": b$ = Chr$(1)
                    Case "x": b$ = Chr$(24)
                    Case "c": b$ = Chr$(3)
                    Case "v": b$ = Chr$(22)
                    Case Chr$(0) + "k": b$ = Chr$(0) + "s"
                    Case Chr$(0) + "m": b$ = Chr$(0) + "t"
                End Select
            End If
        End If
        If lb = -1 And _MouseButton(1) = 0 Then
            lb = 2: drag = 0: hover = 0: act = 1
        ElseIf rb = -1 And _MouseButton(2) = 0 Then
            rb = 2: act = 1
        ElseIf mb = -1 And _MouseButton(3) = 0 Then
            mb = 2: act = 1
        End If
        If _MouseButton(1) Then
            If lb = 0 Then
                lb = 1: z1 = Timer: act = 1
                clkcnt = clkcnt + 1
            End If
        ElseIf _MouseButton(2) And rb = 0 Then
            rb = 1: act = 1
        ElseIf _MouseButton(3) And mb = 0 Then
            mb = 1: act = 1
        End If
        If my <> oldmy Or mx <> oldmx Then act = 2
        oldmy = my: oldmx = mx
        Exit Do
    Loop
End Sub

What's neat is the 3-D shadow. It is a proper shadow effect, instead of an approximated simulated effect, which was the best we could do in SCREEN 0, before QB64 evolved into what it is, today.

Right click to open or reopen popup menu.
Use the mouse, wheel, left or middle button, keys, including shortcut keys, etc.

The demo DOES NOT INCLUDE any actions selected.

Edit: Added right click extras to reopen popup at different location or to act as a left click if on a menu item.

Pete

Hi Pete
Good stuff!

here output:

[Image: immagine-2025-04-03-002432916.png]

As you can see the copy from this forum and paste into editor (both QB64pe both VSCode) gains a strange error:
the line 122 has 2 characters more then the original on the left after "Ã" (chr$(195)) follows "†" (chr$(134)), and on the right side of the line of code before "´" (chr$(180)) there is "Ò" (chr$(210)).
Also now when I copy charachters from QB64pe editor and I paste them in this post on the forum the characters are changed!
Maybe a different conversion between ASCII and Unicode.

Ps: do you see my redlight theme of QB64pe exported into Visual Studio Code editor?
That is my tool!

***Pete*** · 04-03-2025, 12:15 AM

I just did a copy of the code in the post, pasted it into the IDE, and did not see any of the transposed characters. I have experienced this before, maybe copying from the wiki, and can't recall right now.

There is always the export code to as forum code box available in the IDE file menu. I have had some issues using it with large projects, as it takes up too much memory on my teeny tiny system.

Glad you like it.

I don't really have a comment on the Visual Studios mention. Never tried it.

Pete

Login
Username/Email:
Password:	Lost Password?
	Remember me