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]](https://i.ibb.co/h1gc4vwB/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
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
|