QB64 Phoenix Edition
My little menu - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: My little menu (/showthread.php?tid=4271)

Pages: 1 2


My little menu - Mad Axeman - 12-29-2025

I've been playing around with my menu. Got this far. Okay, it needs a bit of a tidy up and could be optimised here and there but it works :-)
It uses either the UP/DOWN arrow keys or the mouse. I'm open to comments.

Code: (Select All)

'
' My little menu routine
'
' Can be used with up/down arrow keys or mouse
'
' Okay, it could be tidied up quite a lot but it works :-)
'
'
'

Screen 0

Dim z$(20)

defc1 = 0
defc2 = 7
Color defc1, defc2
Cls


' z$(x) holds the info for the menu1
' Option chosen in returned in the variable 'menu'


z$(1) = " Seaward SuperNova (including Plus and Elite) "
z$(2) = " Seaward Primetest                            "
z$(3) = " Metrel BetaPat / OmegaPAT                    "
z$(4) = " Robin 5500                                  "
z$(5) = " MetroTest MPAT 60 / Martindale MicroPat      "
z$(6) = " Megger 420                                  "
z$(7) = " KewTech KT74 (via RS-232)                    "
z$(8) = " Kewtech KT74 (Via USB)                      "
z$(9) = " Kewtech KT77 (via RS-232)                    "
z$(10) = " Kewtech KT77 (via USB)                      "
z$(11) = " Seaward Europa                              "
z$(12) = " Seaward Primetest                            "
z$(13) = " Yet another option                          "
z$(14) = " Option 14                                    "
z$(15) = " And finally Cyril                            "

' pt = number of menu entries
pt = 15

' mr = right most column for mouse to work.
' usualy the length of longest menu entry
mr = 46

' menu colours
' c1 & c2 non highlighted
' c3 & c4 highlighted
c1 = 0
c2 = 7
c3 = 7
c4 = 0

' px & py screen locations for top left of menu
' px row
' py column
px = 4
py = 3

' border on/off
' pb = 1 border on
' pb = 0 border off

pb = 1

' border colour

c5 = 1

GoSub Menu

Cls
Locate 2, 2
Print "Option "; menu; " chosen"

End


' ******************
'  OKAY, Lets do it
' ******************

Menu:

' draw the border if needed

If pb = 1 Then

    Color c5, c2
    pb = 0

    Locate py, px
    Print "Õ";
    For i = 1 To mr
        Print "Í";
    Next
    Print "¸"

    For i = 1 To pt
        Locate py + i, px
        Print "³"; String$(mr, 32); "³"
    Next

    Locate py + pt + 1, px
    Print "Ô";
    For i = 1 To mr
        Print "Í";
    Next
    Print "¾"

    py = py + 1
    px = px + 1

End If

' Border finished

' Lets display the menu
z1 = 0

reprint:
If z1 <= 0 Then z1 = 0
If z1 >= (pt - 1) Then z1 = pt - 1

Color c1, c2
For i = 1 To pt
    Locate py + (i - 1), px
    Print z$(i)
Next

Locate py + z1, px
Color c3, c4
Print z$(z1 + 1)

' do the mouse and cursor key inputs
mousein:
Do
    Do While _MouseInput '      Check the mouse status
        mx = _MouseX
        my = _MouseY
        mb1 = _MouseButton(1)
        '      mb2 = _MOUSEBUTTON(2)
        '      mw = _MOUSEWHEEL


        If mb1 = -1 Then
            menu = z1 + 1
            Color defc1, defc2
            Return
        End If


        If omy <> my Then
            If mx >= px And mx < (mr + px) And my >= py And my < pt + py Then
                z1 = my - py
                omy = my
                GoTo reprint
            End If
        End If

    Loop

    x$ = InKey$

Loop Until x$ <> ""
lx = Asc(x$)

' Down Arrow
If x$ = Chr$(0) + Chr$(80) Then
    z1 = z1 + 1
    GoTo reprint
End If

' Up Arrow
If x$ = Chr$(0) + Chr$(72) Then
    z1 = z1 - 1
    GoTo reprint
End If

' Enter key
If x$ = Chr$(13) Then
    menu = z1 + 1
    Color defc1, defc2
    Return
End If

GoTo mousein


[Image: menu1.jpg]

I really don't like the picture attachment on this forum. It always seems to chop the photo :-(


RE: My little menu - bplus - 12-29-2025

Your menu looks like good start, test it with code you might need a menu for and you will see what you will need to fix-up fast!

For posting snapshots use the file atttachment section at the very bottom of the editor but FIRST open the editor here at forum from REPLY so you have all editor tools not available when open only with Quick reply.

Here use this section to attach snapshots:
   

You also have option after dropping file to insert images into your text.


RE: My little menu - Mad Axeman - 12-29-2025

Hmmm......I've just noticed that the characters that form the border haven't copied over properly :-( In the code block it's showing odd characters. For example :-

  For i = 1 To pt
        Locate py + i, px
        Print "³"; String$(mr, 32); "³"
    Next
  
The "³" should be a vertical line
The "Í" should be a horizontal double line
and there should be top left, top right, bottom left and bottom right charachters :-(


RE: My little menu - bplus - 12-29-2025

   


RE: My little menu - Mad Axeman - 12-29-2025

Is that what you are seeing? All I see is this :-
   


RE: My little menu - Petr - 12-29-2025

@Mad Axeman

This difference in characters is caused by the encoding. I think that if you use [ code ]  and  [  /code ]  (without spaces) instead of [ qb ]  and  [ /qb ]  (without spaces) the problem will disappear.


RE: My little menu - Mad Axeman - 12-29-2025

Ah, I'll try that with the next update once you lot have found all the bugs  Huh Big Grin


RE: My little menu - bplus - 12-29-2025

Quote:Is that what you are seeing? All I see is this :-


Yes when I copy your code (in OP) and paste it into IDE, it works fine even when you see the wrong chars here at PE.

BTW I was going to post what Petr did BUT it did not work so I removed that suggestion and replaced it with the screen shot showing the code working in the IDE.
When I tried Petr's suggestion it was a copy paste from the OP here to [ code ] tags so that suggestiojn still might work copying code from the IDE into the code tags [ code ] [ /code] without the spaces inside the brackets.


RE: My little menu - Mad Axeman - 12-29-2025

Well, made a couple of alterations so I'll post the new version, this time using the [ code] tags and see what happens.

What's new? Well, all variables are now prefixed with 'menu_' so that I know they are for the menu only. Only variable that's not prefixed is the 'menu' variable that returns which line was picked.
I've also added the option for the menu to 'roll over' when it get's to the top or bottom

Code: (Select All)
'
' My little menu routine
'
' Can be used with up/down arrow keys or mouse
'
' Okay, it could be tidied up quite a lot but it works :-)
'
'
' Altered all menu variables by adding prefix 'menu_'
' Added the roll over option at top and bottom of menu
'

Screen 0

menu_defc1 = 0
menu_defc2 = 7
Color menu_defc1, menu_defc2
Cls

' z$(x) holds the info for the menu1
' Option chosen is returned in the variable 'menu'

' info for menu1


z$(1) = " Seaward SuperNova (including Plus and Elite) "
z$(2) = " Seaward Primetest                            "
z$(3) = " Metrel BetaPat / OmegaPAT                    "
z$(4) = " Robin 5500                                  "
z$(5) = " MetroTest MPAT 60 / Martindale MicroPat      "
z$(6) = " Megger 420                                  "
z$(7) = " KewTech KT74 (via RS-232)                    "
z$(8) = " Kewtech KT74 (Via USB)                      "
z$(9) = " Kewtech KT77 (via RS-232)                    "
z$(10) = " Kewtech KT77 (via USB)                      "

' menu_pt = number of menu entries
menu_pt = 10

' menu_mr = right most column for mouse to work.
' usualy the length of longest menu entry
menu_mr = 46

' menu colours
' menu_c1 & menu_c2 non highlighted
' menu_c3 & menu_c4 highlighted
menu_c1 = 0
menu_c2 = 7
menu_c3 = 7
menu_c4 = 0

' menu_px & menu_py screen locations for top left of menu
' menu_px row
' menu_py column
menu_px = 4
menu_py = 3

' border on/off
' menu_pb = 1 border on
' menu_pb = 0 border off

menu_pb = 1

' border colour

menu_c5 = 1

' When top/bottom reached do we stop or roll over
' 0 = stop
' 1 = Roll over

menu_over = 1

GoSub Menu

Cls
Locate 2, 2
Print "Option "; menu; " chosen"

End



' ********************* Menu Section Starts Here *******************

Menu:

' draw the border if needed

If menu_pb = 1 Then

    Color menu_c5, menu_c2
    menu_pb = 0

    Locate menu_py, menu_px
    Print "Õ";
    For i = 1 To menu_mr
        Print "Í";
    Next
    Print "¸"

    For i = 1 To menu_pt
        Locate menu_py + i, menu_px
        Print "³"; String$(menu_mr, 32); "³"
    Next

    Locate menu_py + menu_pt + 1, menu_px
    Print "Ô";
    For i = 1 To menu_mr
        Print "Í";
    Next
    Print "¾"

    menu_py = menu_py + 1
    menu_px = menu_px + 1

End If

' Border finished

' Lets display the menu
menu_z1 = 0

reprint:

If menu_over = 0 Then
    If menu_z1 <= 0 Then menu_z1 = 0
    If menu_z1 >= (menu_pt - 1) Then menu_z1 = menu_pt - 1
Else
    If menu_z1 <= -1 Then menu_z1 = menu_pt - 1 'menu_z1 = 0
    If menu_z1 >= menu_pt Then menu_z1 = 0 'menu_z1 = menu_pt - 1
End If

Color menu_c1, menu_c2
For i = 1 To menu_pt
    Locate menu_py + (i - 1), menu_px
    Print z$(i)
Next

Locate menu_py + menu_z1, menu_px
Color menu_c3, menu_c4
Print z$(menu_z1 + 1)

' do the mouse and cursor key inputs
mousein:
Do
    Do While _MouseInput '      Check the mouse status
        menu_mx = _MouseX
        menu_my = _MouseY
        menu_mb1 = _MouseButton(1)
        '      mb2 = _MOUSEBUTTON(2)
        '      mw = _MOUSEWHEEL

        If menu_mb1 = -1 Then
            menu = menu_z1 + 1
            Color menu_defc1, menu_defc2
            Return
        End If


        If menu_omy <> menu_my Then
            If menu_mx >= menu_px And menu_mx < (menu_mr + menu_px) And menu_my >= menu_py And menu_my < menu_pt + menu_py Then
                menu_z1 = menu_my - menu_py
                menu_omy = menu_my
                GoTo reprint
            End If
        End If

    Loop

    menu_x$ = InKey$

Loop Until menu_x$ <> ""
menu_lx = Asc(menu_x$)

' Down Arrow
If menu_x$ = Chr$(0) + Chr$(80) Then
    menu_z1 = menu_z1 + 1
    GoTo reprint
End If

' Up Arrow
If menu_x$ = Chr$(0) + Chr$(72) Then
    menu_z1 = menu_z1 - 1
    GoTo reprint
End If

' Enter key
If menu_x$ = Chr$(13) Then
    menu = menu_z1 + 1
    Color menu_defc1, menu_defc2
    Return
End If

GoTo mousein
And it looks like the [ code][ /code] still show the wrong characters :-(


RE: My little menu - NakedApe - 12-30-2025

Nice little menu you've got there.  +1   Smile