Posts: 4,021
Threads: 181
Joined: Apr 2022
Reputation:
227
12-22-2024, 02:24 AM
(This post was last modified: 12-22-2024, 02:26 AM by bplus.)
Yeah these are artifacts from some other code. Code that is likely going to share nob and Autokey$ as I can't imagine it very practical to add 2 more parameters to the call.
and I just started digging into Pete's routine...
b = b + ...
Posts: 2,275
Threads: 233
Joined: Apr 2022
Reputation:
114
12-22-2024, 05:16 PM
(This post was last modified: 12-22-2024, 05:59 PM by Pete.)
Steve is correct. This is a nearly all-purpose keyboard / mouse subroutine. Autokey$ is my way of not having to code for what is already present in parts.
Say you need to paste new text into an existing filled text field. We need "Select all" chr$(4) followed by "Paste" chr$(22) to accomplish that. So I just use: autokey$ = "chr$(4),chr$(22)" and send it through the routine.
Example:
Code: (Select All)
autokey$ = "1,2,4" ' Let's print choices 1, 2, and 4.
Do
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1) ' Coded autokey$ + "," to allow us not to have to add a trailing comma to our autokey string.
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Else
b$ = InKey$
End If
Select Case b$
Case "1": Print "Pete is tremendous!"
Case "2": Print "Steve is just amazing."
Case "3": Print "Note to Steve, buy more buckshot."
Case "4": Print "What? Steve was writing code before Pete was in diapers!"
End Select
Loop
Oh, edited in...
@bplus
You asked about the variable 'nob' Number of buttons. My routine allows for mapped button arrays to be recognized. The calling routine then uses the hover variable to highlight or unhighlight the button(s). btl is button top left. btr is button bottom right. I think Steve does something same or similar to map buttons. It sure beats plotting out all four corners with arrays.
Code: (Select All)
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
Exit For
End If
Next
Pete
Posts: 373
Threads: 30
Joined: Jul 2022
Reputation:
27
Here a way to do menulist with mouse selection
Code: (Select All)
Rem demo of menu with mouse selection
DefLng L
lwindow = _NewImage(800, 600, 32)
Screen lwindow
_Font 16
MenuItem$ = "First/Second/Third/Forth/Fifth/Sixth/Seventh/Eighth/Ninenth/"
Do
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
While _MouseInput: _PrintString (300, 300), " X" + Str$(_MouseX) + "/ Y" + Str$(_MouseY) + " ": Wend
Mx% = _MouseX
My% = _MouseY
Mb% = _MouseButton(1)
ShowMenu MenuItem$, 40, 20, Mx%, My%, Mb%
Loop Until _MouseButton(2)
End
Sub ShowMenu (Menu$, X%, Y%, Xm%, Ym%, Bm%)
Start% = 1
Ends% = 0
Nitem% = 0
While InStr(Start%, Menu$, "/")
Ends% = InStr(Start%, Menu$, "/")
item$ = Mid$(Menu$, Start%, Ends% - Start%)
lbase$ = Space$(Int((12 - Len(item$)) / 2))
rbase$ = Space$(12 - (Len(lbase$ + item$)))
If MouseOver(X%, X% + (_FontWidth * 12), Y% + (_FontHeight * Nitem%), Y% + (_FontHeight * (Nitem% + 1)), Xm%, Ym%) Then
Color _RGBA(6, 238, 127, 255), _RGBA(0, 6, 255, 255)
_PrintString (300, 330), "Mouse over item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
If Bm% Then _PrintString (300, 360), "Selected item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
Else
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
End If
_PrintString (X%, Y% + (_FontHeight * Nitem%)), lbase$ + item$ + rbase$
Nitem% = Nitem% + 1
Start% = Ends% + 1
Wend
End Sub
Function MouseOver (X%, X1%, Y%, Y1%, Mx%, My%)
MouseOver = 0
If (Mx% >= X% And Mx% <= X1%) Then
If (My% >= Y% And My% <= Y1%) Then MouseOver = 1
End If
End Function
Posts: 2,275
Threads: 233
Joined: Apr 2022
Reputation:
114
Nice! I really should do a non-screen 0 version. The coordinate work drives me batty.
One thing you might want to address is this: Moving the pointer slowly up from a highlighted selection will result in a shared condition where the adjacent selection becomes highlighted but the former selection remains highlighted. Try highlighting "Ninenth" (misspelled) and then try an get y = 148 as you slowly move the mouse pointer up.
Ninth is the correct English spelling, btw. I guess Nono would be correct in Italian?
Pete
Posts: 4,021
Threads: 181
Joined: Apr 2022
Reputation:
227
Yeah I liked TempodiBasic's ShowMenu routine too.
b = b + ...
Posts: 2,721
Threads: 330
Joined: Apr 2022
Reputation:
223
You guys still have some work to do on being able to set up multiple menus which interact together in a database type format. 
Code: (Select All)
$Color:32
Const True = -1, False = 0
Const Left = 1, Right = 2, Middle = 3, Center = 3
Const None = 0, Alpha = 1, Numeric = 2, NoCase = 4, Reverse = 8
Const LeftClick = 1, RightClick = 2, LeftDown = 4, RightDown = 8, Hover = 16
Type MenuType
Valid As _Byte
Visible As _Byte
ScrollBarHidden As _Byte
Top As Integer
Left As Integer
Width As Integer
Height As Integer
Frame As _Byte
BorderColor As _Unsigned Long
BackgroundColor As _Unsigned Long
Header As _Byte
Caption As String * 255
CC As _Unsigned Long 'caption color
CBG As _Unsigned Long 'caption background color
HighLightColor As _Unsigned Long
Exit As _Byte
Entries As Integer
TopEntry As Integer
ListColor As _Unsigned Long
ListBackground As _Unsigned Long
ListJustify As _Byte
End Type
Dim Shared MenusActive As Long
ReDim Shared Menu(10) As MenuType
ReDim Shared MenuList(32767, 10) As String 'Up to 32,767 items max in our list.
ReDim Shared MenuListDisabled(32767, 10) As _Byte
ReDim Shared MenuDisplayOrder(32767, 10) As Integer
Type LinkType
one As Long
another As Long
End Type
ReDim Shared LinkedTo(1000) As LinkType
Dim Shared ScrollDelay As _Float
Dim Shared MouseScroll As Integer
'Before here goes BI file content
'After here goes working program
DefLng A-Z
Screen _NewImage(800, 600, 32)
_ScreenMove _Middle
MainMenu = GetMenuHandle
SetMenuSize MainMenu, 200, 150
SetMenuPosition MainMenu, 100, 100
SetMenuFrame MainMenu, True, Red, Yellow
SetMenuVisible MainMenu, True
SetMenuCaption MainMenu, True, "Name", Black, White, True
SetMenuListProperties MainMenu, Black, 0, Center 'Right 'Left
SetMenuHighLightColor MainMenu, Red
For i = 1 To 23
Read n$
AddMenuItem MainMenu, n$
Next
Data Steve,Pete,Bob,Joe,Fred
Data Sam,One,Two,Three,Four
Data Five,Six,Seven,Eight,Nine
Data These,are,all,my,names
Data "Aren't",they,grand
SecondMenu = GetMenuHandle
SetMenuSize SecondMenu, 100, 150
SetMenuPosition SecondMenu, 300, 100
SetMenuFrame SecondMenu, True, Red, Yellow
SetMenuVisible SecondMenu, True
SetMenuCaption SecondMenu, True, "Age", Black, White, True
SetMenuListProperties SecondMenu, Black, 0, Left
SetMenuHighLightColor SecondMenu, Red
For i = 1 To 23
Read n$
AddMenuItem SecondMenu, n$
Next
Data 12,23,34,45,56
Data 67,78,89,90,1
Data 9,98,87,76,65
Data 54,43,32,21,10
Data 42,55,12
sortmode = 0: linked = -1: menuon = 1
HideMenuScrollBar MainMenu
LinkMenus MainMenu, SecondMenu
DisableItem MainMenu, 5
ScrollDelay = .25
Do
Cls
Locate 20, 1: Print "Press <H> to hide the menu."
Print "Press <S> to show the menu."
Print "Press <N> for No Sort order."
Print "Press <A> for Alphabetic Sort order."
Print "Press <#> for Numeric Sort order."
Print "Press <C> to toggle case sorting."
Print "Press <R> to toggle reverse sorting."
Print "Press <L> to link the menus."
Print "Press <U> to unlink the menus."
Print "Press <TAB> to swap between menus."
Print "<ESC> to quit"
Print
Print "Currently: ";
If sortmode And 1 Then
Print "ALPHA SORT";
If kase Then Print ", CASE-SENSITIVE";
If reversed Then Print ", REVERSE-ORDER" Else Print
ElseIf sortmode And 2 Then
Print "NUMERIC SORT";
If reversed Then Print ", REVERSE-ORDER" Else Print
Else
Print "NOT SORTING"
End If
Locate 5, 25
If linked Then Print "LINKED LISTS" Else Print "UNLINKED LISTS"
Locate 6, 15: Print "MENU ASSOCIATED WITH KEYBOARD: "; menuon
MouseScroll = 0
While _MouseInput
MouseScroll = MouseScroll + _MouseWheel
Wend
k = _KeyHit
Select Case k
Case Asc("L"), Asc("l"): LinkMenus MainMenu, SecondMenu: linked = -1
Case Asc("U"), Asc("u"): UnLinkMenus MainMenu, SecondMenu: linked = 0
Case Asc("H"), Asc("h"): HideMenu menuon
Case Asc("S"), Asc("s"): ShowMenu menuon
Case Asc("N"), Asc("n"): sortmode = None: changed = -1: reversed = 0: kase = 0
Case Asc("A"), Asc("a"): sortmode = Alpha: changed = -1
Case Asc("#"), Asc("3"): sortmode = Numeric: changed = -1
Case Asc("C"), Asc("c"): kase = Not kase: changed = -1
Case Asc("R"), Asc("r"): reversed = Not reversed: changed = -1
Case 9: menuon = menuon + 1: If menuon = 3 Then menuon = 1
Case 27: System
End Select
If changed Then
If sortmode <> 0 Then
If kase Then sortmode = sortmode Or NoCase Else sortmode = sortmode And Not NoCase
If reversed Then sortmode = sortmode Or Reverse Else sortmode = sortmode And Not Reverse
End If
MenuDisplaySort menuon, sortmode
changed = 0
End If
DisplayMenus
CheckMenus MouseStatus, MenuSelected, OptionSelected
If MouseStatus <> 0 And MenuSelected <> 0 Then
If MouseStatus And LeftClick Then
Locate 1, 1
Print "You LEFT CLICKED Option #"; OptionSelected; " in Menu #"; MenuSelected
Print "Which was: "; GetListItem(MenuSelected, OptionSelected)
Print
If linked Then
Print "Since our lists are linked, we get the following items:"; GetListItem(1, OptionSelected), GetListItem(2, OptionSelected)
Else
Print "Since our lists are unlinked, we get the following items:"; GetListItem(MenuSelected, OptionSelected)
End If
_Display
_Delay 2 'give it time to pop up
ElseIf MouseStatus And RightClick Then
Locate 1, 1
Print "You RIGHT CLICKED Option #"; OptionSelected; " in Menu #"; MenuSelected
Print "Which was: "; GetListItem(MenuSelected, OptionSelected)
Print
If linked Then
Print "Since our lists are linked, we get the following items:"; GetListItem(1, OptionSelected), GetListItem(2, OptionSelected)
Else
Print "Since our lists are unlinked, we get the following items:"; GetListItem(MenuSelected, OptionSelected)
End If
_Display
_Delay 2 'give it time to pop up
End If
Color Yellow
If MouseStatus And LeftDown Then Locate 35, 1: Print "LEFT MOUSE DOWN over Option #"; OptionSelected; " in Menu #"; MenuSelected
If MouseStatus And RightDown Then Locate 35, 1: Print "RIGHT MOUSE DOWN over Option #"; OptionSelected; " in Menu #"; MenuSelected
Color Purple
If MouseStatus And Hover Then Locate 36, 1: Print "HOVERING over Option #"; OptionSelected; " in Menu #"; MenuSelected;
Color White
End If
_Limit 30
_Display
Loop
'And here goes the BM routines
Sub LinkMenus (handle1, handle2)
If handle1 = 0 Or handle2 = 0 Then Error 5: Exit Sub
If handle1 = handle2 Then Exit Sub 'Why the heck are we linking one list to itself?!
If Menu(handle1).Valid And Menu(handle2).Valid Then
LinkMax = LinkedTo(0).one 'I'm using the very first entry into my array to store the number of link entries I have
'First check to see if the two menus are already linked
For i = 1 To LinkMax
found = 0
If handle1 = LinkedTo(i).one Or handle1 = LinkedTo(i).another Then found = found + 1
If handle2 = LinkedTo(i).one Or handle2 = LinkedTo(i).another Then found = found + 1
If found = 2 Then Exit Sub 'the two lists are already linked
If handle1 = 0 And handle2 = 0 And openspot = 0 Then openspot = i 'we found a spot where a link was freed before; let's use it
Next
MenuDisplaySort handle1, None: MenuDisplaySort handle2, None 'unsort the lists to begin with.
Menu(handle1).TopEntry = 1: Menu(handle2).TopEntry = 1 'and then reset them to their topmost position
If openspot Then
LinkedTo(openspot).one = handle1
LinkedTo(openspot).another = handle2
Else
LinkMax = LinkMax + 1: LinkedTo(0).one = LinkMax
LinkedTo(LinkMax).one = handle1
LinkedTo(LinkMax).another = handle2
End If
Else
Error 5
End If
End Sub
Sub UnLinkMenus (handle1, handle2)
If handle1 = 0 Or handle2 = 0 Then Error 5: Exit Sub 'no list should be linked to 0. 0 is nothing... Can't free a link to nothing.
If handle1 = handle2 Then Exit Sub 'We can't unlink a list from itself!
If Menu(handle1).Valid And Menu(handle2).Valid Then
For i = 1 To LinkedTo(0).one
If handle1 = LinkedTo(i).one Or handle1 = LinkedTo(i).another Then found = found + 1
If handle2 = LinkedTo(i).one Or handle2 = LinkedTo(i).another Then found = found + 1
If found = 2 Then LinkedTo(i).one = 0: LinkedTo(i).another = 0 'unlink them!
Next
Else
Error 5
End If
End Sub
Sub DisableItem (handle, item)
If Menu(handle).Valid Then MenuListDisabled(item, handle) = -1 Else Error 5
End Sub
Sub EnableItem (handle, item)
If Menu(handle).Valid Then MenuListDisabled(item, handle) = 0 Else Error 5
End Sub
Sub ShowMenu (Handle)
If Menu(Handle).Valid Then Menu(Handle).Visible = -1 Else Error 5
End Sub
Sub HideMenu (Handle)
If Menu(Handle).Valid Then Menu(Handle).Visible = 0 Else Error 5
End Sub
Sub ShowMenuScrollBar (Handle)
If Menu(Handle).Valid Then Menu(Handle).ScrollBarHidden = 0 Else Error 5
End Sub
Sub HideMenuScrollBar (Handle)
If Menu(Handle).Valid Then Menu(Handle).ScrollBarHidden = -1 Else Error 5
End Sub
Function GetListItem$ (Handle, Item)
If Menu(Handle).Valid Then
If Item < 0 Or Item > Menu(Handle).Entries Then Error 5: Exit Function
GetListItem$ = LTrim$(RTrim$(MenuList(Item, Handle)))
Else
Error 5
End If
End Function
Sub AddMenuItem (Handle, Item$)
If Menu(Handle).Valid Then
Menu(Handle).Entries = Menu(Handle).Entries + 1
MenuList(Menu(Handle).Entries, Handle) = Item$
MenuDisplayOrder(Menu(Handle).Entries, Handle) = Menu(Handle).Entries
Else
Error 5
End If
End Sub
Sub SetMenuListProperties (Handle, ListColor As _Unsigned Long, ListBackground As _Unsigned Long, ListJustify As _Byte)
If Menu(Handle).Valid Then
Menu(Handle).ListColor = ListColor
Menu(Handle).ListBackground = ListBackground
Menu(Handle).ListJustify = ListJustify
Else
Error 5
End If
End Sub
Sub SetMenuHighLightColor (Handle, HighLightColor As _Unsigned Long)
If Menu(Handle).Valid Then
Menu(Handle).HighLightColor = HighLightColor
Else
Error 5
End If
End Sub
Sub SetMenuCaption (Handle, Header, Caption As String * 255, CaptionColor As _Unsigned Long, CaptionBackground As _Unsigned Long, Xit)
If Menu(Handle).Valid Then
Menu(Handle).Header = Header
Menu(Handle).Caption = Caption
Menu(Handle).CC = CaptionColor
Menu(Handle).CBG = CaptionBackground
Menu(Handle).Exit = Xit
Else
Error 5
End If
End Sub
Sub SetMenuFrame (Handle, HaveFrame, FrameColor As _Unsigned Long, FrameBackGround As _Unsigned Long)
If Menu(Handle).Valid Then
Menu(Handle).Frame = HaveFrame
Menu(Handle).BorderColor = FrameColor
Menu(Handle).BackgroundColor = FrameBackGround
Else
Error 5
End If
End Sub
Sub SetMenuPosition (Handle, Left, Top)
If Menu(Handle).Valid Then
'some basic error checking
If Top < 0 Then Error 5: Exit Sub 'Let's try and keep the menu on the screen, why don't we
If Left < 0 Then Error 5: Exit Sub
If Left > _Width Then Error 5: Exit Sub
If Top > _Height Then Error 5: Exit Sub
Menu(Handle).Left = Left
Menu(Handle).Top = Top
Else
Error 5 'toss a generic error if the handle is bad
'I can add a custom error pop up routine later with appropiate messages
End If
End Sub
Sub SetMenuVisible (Handle, Visible)
If Menu(Handle).Valid Then Menu(Handle).Visible = Visible Else Error 5
End Sub
Sub SetMenuSize (Handle, Width, Height)
If Menu(Handle).Valid Then
'some basic error checking
If Width < _FontWidth Then Error 5: Exit Sub 'Can't we at least make a menu which will hold a single character?!
If Height < _FontHeight Then Error 5: Exit Sub
If Width > _Width Then Error 5: Exit Sub 'And let's not make it generally larger than our screen, why don't we?!
If Height > _Height Then Error 5: Exit Sub
Menu(Handle).Width = Width
Menu(Handle).Height = Height
Else
Error 5 'toss a generic error if the handle is bad
'I can add a custom error pop up routine later with appropiate messages
End If
End Sub
Function GetMenuHandle&
For i = 1 To MenusActive
If Menu(i).Valid = 0 Then found = i: Exit For
Next
If Not found Then
MenusActive = MenusActive + 1
found = MenusActive
u = UBound(Menu)
Do Until MenusActive < u
ReDim _Preserve Menu(u + 10) As MenuType
ReDim _Preserve MenuList(32767, u + 10) As String
ReDim _Preserve MenuDisplayOrder(32767, u + 10) As Integer
ReDim _Preserve MenuListDisabled(32767, u + 10) As _Byte
u = UBound(Menu)
Loop
End If
GetMenuHandle& = found
Menu(found).Valid = -1 'and let's make this a valid handle
End Function
Sub CheckMenus (MouseStatus As Long, MenuSelected As Long, OptionSelected As Long)
MenuSelected = 0: OptionSelected = 0
For i = 1 To MenusActive
If Menu(i).Visible And Menu(i).Valid Then
If startnum = 0 Then startnum = i
ProcessMenu i, startnum, MouseStatus, MenuSelected, OptionSelected
If MenuSelected Then Exit Sub
End If
Next
End Sub
Sub DisplayMenus
FC = _DefaultColor: BG = _BackgroundColor
For Whichone = 1 To MenusActive
If Menu(Whichone).Visible Then
'Get the starting limits of where menu/list text can appear
x1 = Menu(Whichone).Left: x2 = x1 + Menu(Whichone).Width
y1 = Menu(Whichone).Top: y2 = Menu(Whichone).Top + Menu(Whichone).Height
caption$ = LTrim$(RTrim$(Menu(Whichone).Caption)) 'strip unneeded spaces from the caption (WhichOnef any)
'clear the background
Line (Menu(Whichone).Left, Menu(Whichone).Top)-Step(Menu(Whichone).Width, Menu(Whichone).Height), Menu(Whichone).BackgroundColor, BF
'draw the frame; adjust text limits
If Menu(Whichone).Frame Then
Line (Menu(Whichone).Left, Menu(Whichone).Top)-Step(Menu(Whichone).Width, Menu(Whichone).Height), Menu(Whichone).BorderColor, B
x1 = x1 + 1: y1 = y1 + 1
x2 = x2 - 1: y2 = y2 - 1
End If
If Menu(Whichone).Header Then
temp = x2 - x1 + 1
Line (x1, y1)-(x2, y1 + _FontHeight), Menu(Whichone).CBG, BF
If Menu(Whichone).Exit Then
temp = temp - _FontWidth * 2
ex1 = x2 - 1 - _FontWidth: ex2 = ex1 + _FontWidth
ey1 = y1 + 1: ey2 = ey1 + _FontHeight - 3
Line (ex1, ey1)-(ex2, ey2), Red, BF
Line (ex1, ey1)-(ex2, ey2), Black
Line (ex1, ey2)-(ex2, ey1), Black
End If
Do Until _PrintWidth(caption$) <= temp
caption$ = Left$(caption$, Len(caption$) - 1)
Loop
Color Menu(Whichone).CC, Menu(Whichone).CBG
_PrintString (x1 + (temp - _PrintWidth(caption$)) \ 2, y1), caption$
y1 = y1 + _FontHeight
If Menu(Whichone).Frame Then
Line (x1, y1)-(x2, y1), Menu(Whichone).BorderColor
y1 = y1 + 2
End If
End If 'end header creation
If Menu(Whichone).Entries > 0 Then 'We have items in our list to display!
If Menu(Whichone).TopEntry < 1 Then Menu(Whichone).TopEntry = 1 'check to make certain we're displaying from the first entry on at least
If Menu(Whichone).TopEntry > Menu(Whichone).Entries Then Menu(Whichone).TopEntry = Menu(Whichone).Entries
printlimit = (x2 - x1 + 1) \ _FontWidth
limitfound = 1 + (y2 - y1 + 1) \ _FontHeight - 1
If limitfound > Menu(Whichone).Entries Then
limitfound = Menu(Whichone).Entries
Else
scrollneeded = -1
printlimit = printlimit - 1
End If
Color Menu(Whichone).ListColor, Menu(Whichone).ListBackground
If Menu(Whichone).ScrollBarHidden = -1 Then scrollneeded = 0
Dim r As _Unsigned _Byte, g As _Unsigned _Byte, b As _Unsigned _Byte
Dim CC As Integer
r = _Red32(Menu(Whichone).BackgroundColor)
g = _Green32(Menu(Whichone).BackgroundColor)
b = _Blue32(Menu(Whichone).BackgroundColor)
Fade& = _RGBA32(r, g, b, 180)
Select Case Menu(Whichone).ListJustify
Case Left
For j = 1 To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(CC, Whichone)))
If MenuListDisabled(CC, Whichone) Then graybox = -1
For ii = 1 To LinkedTo(0).one
If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1
If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1
Next
t$ = Left$(t$, printlimit)
_PrintString (x1, y1 + (j - 1) * _FontHeight), t$
If graybox Then Line (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF
Next
Case Right
For j = 1 To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone), Whichone)))
If MenuListDisabled(CC, Whichone) Then graybox = -1
For ii = 1 To LinkedTo(0).one
If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1
If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1
Next
t$ = LTrim$(Left$(t$, printlimit))
p = _PrintWidth(t$)
If scrollneeded Then
_PrintString (x2 - p - _FontWidth, y1 + (j - 1) * _FontHeight), t$
Else
_PrintString (x2 - p, y1 + (j - 1) * _FontHeight), t$
End If
If graybox Then Line (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF
Next
Case Center
For j = 1 To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = LTrim$(MenuList(MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone), Whichone))
If MenuListDisabled(CC, Whichone) Then graybox = -1
For ii = 1 To LinkedTo(0).one
If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1
If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1
Next
t$ = LTrim$(RTrim$(Left$(t$, printlimit)))
p = _PrintWidth(t$)
_PrintString ((x2 - x1 + 1) - p \ 2, y1 + (j - 1) * _FontHeight), t$
If graybox Then Line (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF
Next
Case Else
For j = 1 To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(CC, Whichone)))
If MenuListDisabled(CC, Whichone) Then graybox = -1
For ii = 1 To LinkedTo(0).one
If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1
If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1
Next
t$ = Left$(t$, printlimit)
_PrintString (x1, y1 + (j - 1) * _FontHeight), t$
If graybox Then Line (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF
Next
Menu(Whichone).ListJustify = Left 'If it's not specified for some reason, let's make it left justified as default
End Select
End If 'end of displaying items
If scrollneeded Then 'then we need a vertical scroll bar
barx1 = x2 - _FontWidth - 1
barx2 = barx1 + _FontWidth
Line (barx1, y1)-(barx2, y2), LightGray, BF
Color Black, DarkGray
_PrintString (barx1, y1), ""
_PrintString (barx1, y2 - _FontHeight), ""
End If
End If
Next
Color FC, BG
End Sub
Sub ProcessMenu (WhichOne As Long, StartNum As Long, MouseStatus As Long, MenuSelected As Long, OptionSelected As Long)
Static OldMouse As _Byte, ElapsedTimer As _Float, Click As _Byte
Static ScrollAble As _Byte, OldMouse2 As _Byte, Click2 As _Byte
MX = _MouseX: MY = _MouseY: MB = _MouseButton(1): MB2 = _MouseButton(2)
If ScrollDelay < 0 Then ScrollDelay = 0
'Get the starting limits of where menu/list text can appear
x1 = Menu(WhichOne).Left: x2 = x1 + Menu(WhichOne).Width
y1 = Menu(WhichOne).Top: y2 = Menu(WhichOne).Top + Menu(WhichOne).Height
If WhichOne = StartNum Then
If OldMouse = 0 And MB = -1 Then Click = -1 Else Click = 0
If OldMouse2 = 0 And MB2 = -1 Then Click2 = -1 Else Click2 = 0
OldMouse = MB: OldMouse2 = MB2
If ElapsedTimer + ScrollDelay < Timer(0.01) Then
ElapsedTimer = Timer(0.01)
ScrollAble = -1
Else
ScrollAble = 0
End If
End If
If Menu(WhichOne).Frame Then
Line (Menu(WhichOne).Left, Menu(WhichOne).Top)-Step(Menu(WhichOne).Width, Menu(WhichOne).Height), Menu(WhichOne).BorderColor, B
x1 = x1 + 1: y1 = y1 + 1
x2 = x2 - 1: y2 = y2 - 1
End If
If Menu(WhichOne).Header Then
temp = x2 - x1 + 1
If Menu(WhichOne).Exit Then
temp = temp - _FontWidth * 2
ex1 = x2 - 1 - _FontWidth: ex2 = ex1 + _FontWidth
ey1 = y1 + 1: ey2 = ey1 + _FontHeight - 3
End If
y1 = y1 + _FontHeight
If Menu(WhichOne).Frame Then y1 = y1 + 2
End If 'end header creation
If Menu(WhichOne).Entries > 0 Then 'We have items in our list to display!
If Menu(WhichOne).TopEntry < 1 Then Menu(WhichOne).TopEntry = 1 'check to make certain we're displaying from the first entry on at least
If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries
printlimit = (x2 - x1 + 1) \ _FontWidth
limitfound = 1 + (y2 - y1 + 1) \ _FontHeight - 1
If limitfound > Menu(WhichOne).Entries Then
limitfound = Menu(WhichOne).Entries
Else
scrollneeded = -1
printlimit = printlimit - 1
End If
End If 'end of displaying items
If Menu(WhichOne).ScrollBarHidden = -1 Then scrollneeded = 0
If scrollneeded Then 'then we need a vertical scroll bar
barx1 = x2 - _FontWidth - 1
barx2 = barx1 + _FontWidth
End If
Select Case MY 'let's determine which line we clicked the mouse on
Case Is < ey1 'do nothing as it's too far up the screen to be a click in this box
Case Is > y2 'do nothing again as it's too far down the screen to be a click in this box
Case ey1 To ey2 'we've clicked on the line where the EXIT button might exist
Case y1 To y2
End Select
Select Case MY 'let's determine which line we clicked the mouse on
Case Is < ey1 'do nothing as it's too far up the screen to be a click in this box
Case Is > y2 'do nothing again as it's too far down the screen to be a click in this box
Case ey1 To ey2 'we've clicked on the line where the EXIT button might exist
If Click And Menu(WhichOne).Exit Then
If MX >= ex1 And MX <= ex2 Then Menu(WhichOne).Visible = False 'If the exit button is available, and we click it, it closes the menu/list
End If
Case y1 To y2
done = 0
If barx1 > 0 Then p2 = barx1 - 1 Else p2 = x2
If MX >= x1 And MX <= p2 Then 'highlight the choice the user is over
yPOS = ((MY - y1 + 1) \ _FontHeight) * _FontHeight + y1
If yPOS + _FontHeight <= y2 Then Line (x1, yPOS)-(p2, yPOS + _FontHeight), Menu(WhichOne).HighLightColor, B
End If
If MouseScroll Then
If MX >= x1 And MX <= x2 Then
Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry + MouseScroll
If Menu(WhichOne).TopEntry < 1 Then Menu(WhichOne).TopEntry = 1
If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries - limitfound + 1 Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries - limitfound + 1
For i = 1 To LinkedTo(0).one
If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry
If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry
Next
End If
End If
If scrollneeded Then
If MY >= y1 And MY <= y1 + _FontHeight And MX >= barx1 And MX <= barx2 And MB <> 0 Then 'it's the top scroll bar
If ScrollAble Then Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry - 1
If Menu(WhichOne).TopEntry < 1 Then Menu(WhichOne).TopEntry = 1
done = -1
For i = 1 To LinkedTo(0).one
If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry
If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry
Next
ElseIf MY >= y2 - _FontHeight And MY <= y2 And MX >= barx1 And MX <= barx2 And MB <> 0 Then 'it's the bottom scroll bar
If ScrollAble Then Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry + 1
If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries - limitfound + 1 Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries - limitfound + 1
done = -1
For i = 1 To LinkedTo(0).one
If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry
If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry
Next
ElseIf MX >= barx1 And MX <= barx2 And MB <> 0 Then
MenuLimit = Menu(WhichOne).Entries - limitfound + 2
ylimit = y2 - y1 - _FontHeight * 2 + 1
yPOS = MY - y1 - _FontHeight + 1
Menu(WhichOne).TopEntry = (MenuLimit - (ylimit - yPOS) / ylimit * MenuLimit)
If Menu(WhichOne).TopEntry >= MenuLimit Then Menu(WhichOne).TopEntry = MenuLimit - 1
done = -1
For i = 1 To LinkedTo(0).one
If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry
If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry
Next
End If
End If
If Not done Then 'if we've processed a scrollbar event, we're finished
If MX >= x1 And MX <= x2 Then
MenuSelected = WhichOne
OptionSelected = MenuDisplayOrder((MY - y1 + 1) \ _FontHeight + Menu(WhichOne).TopEntry, WhichOne)
invalidate = 0
If MenuListDisabled(OptionSelected, WhichOne) Then invalidate = -1
For ii = 1 To LinkedTo(0).one
If WhichOne = LinkedTo(ii).one And MenuListDisabled(OptionSelected, LinkedTo(ii).another) Then invalidate = -1
If WhichOne = LinkedTo(ii).another And MenuListDisabled(OptionSelected, LinkedTo(ii).one) Then invalidate = -1
Next
If barx1 <> 0 And MX > barx1 Then invalidate = -1
If invalidate Then MenuSelected = 0: OptionSelected = 0
End If
End If
End Select
MouseStatus = 0
MouseStatus = MouseStatus Or -Click 'leftclick
MouseStatus = MouseStatus Or Click2 * -2 'rightclick
MouseStatus = MouseStatus Or _MouseButton(1) * -4 'leftdown
MouseStatus = MouseStatus Or _MouseButton(2) * -8 'rightdown
MouseStatus = MouseStatus Or (MenuSelected <> 0) * 16 'If we're over the menu, we're hovering
End Sub
Sub MenuDisplaySort (handle As Long, sortmethod As _Byte)
gap = Menu(handle).Entries
If sortmethod And Alpha Then
If sortmethod And NoCase Then
Do
gap = 10 * gap \ 13
If gap < 1 Then gap = 1
i = 0
swapped = 0
Do
t$ = UCase$(LTrim$(RTrim$(MenuList(MenuDisplayOrder(i, handle), handle))))
t1$ = UCase$(LTrim$(RTrim$(MenuList(MenuDisplayOrder(i + gap, handle), handle))))
If t$ > t1$ Then
Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle)
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then Swap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another)
If handle = LinkedTo(ii).another Then Swap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one)
Next
swapped = -1
End If
i = i + 1
Loop Until i + gap > Menu(handle).Entries
Loop Until gap = 1 And swapped = 0
Else
Do
gap = 10 * gap \ 13
If gap < 1 Then gap = 1
i = 0
swapped = 0
Do
t$ = LTrim$(RTrim$(MenuList(MenuDisplayOrder(i, handle), handle)))
t1$ = LTrim$(RTrim$(MenuList(MenuDisplayOrder(i + gap, handle), handle)))
If t$ > t1$ Then
Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle)
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then Swap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another)
If handle = LinkedTo(ii).another Then Swap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one)
Next
swapped = -1
End If
i = i + 1
Loop Until i + gap > Menu(handle).Entries
Loop Until gap = 1 And swapped = 0
End If
If sortmethod And Reverse Then
For i = 1 To Menu(handle).Entries \ 2
Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(Menu(handle).Entries - i + 1, handle)
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then Swap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).another)
If handle = LinkedTo(ii).another Then Swap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).one)
Next
Next
End If
ElseIf sortmethod And Numeric Then
Do
gap = 10 * gap \ 13
If gap < 1 Then gap = 1
i = 0
swapped = 0
Do
If Val(MenuList(MenuDisplayOrder(i, handle), handle)) > Val(MenuList(MenuDisplayOrder(i + gap, handle), handle)) Then
Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle)
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then Swap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another)
If handle = LinkedTo(ii).another Then Swap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one)
Next
swapped = -1
End If
i = i + 1
Loop Until i + gap > Menu(handle).Entries
Loop Until gap = 1 And swapped = 0
If sortmethod And Reverse Then
For i = 1 To Menu(handle).Entries \ 2
Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(Menu(handle).Entries - i + 1, handle)
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then Swap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).another)
If handle = LinkedTo(ii).another Then Swap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).one)
Next
Next
End If
Else
For i = 1 To Menu(handle).Entries
MenuDisplayOrder(i, handle) = i
For ii = 1 To LinkedTo(0).one
If handle = LinkedTo(ii).one Then MenuDisplayOrder(i, LinkedTo(ii).another) = i
If handle = LinkedTo(ii).another Then MenuDisplayOrder(i, LinkedTo(ii).one) = i
Next
Next
End If
End Sub
This is an old example, but one which I've used for a lot of different things over time. Here we generate a 2-field database (Name and Age), and it displays both of those fields. You can link those fields together and use one of control the other (sort by age and the names change to match your sorting), or you can break them apart and only work in one without regard to what the other displays (for completely independent lists).
As far as most menu type things go for me, this type of routine is one that I tend to plug in and make a use of a *lot* for my personal work. For example, I might have an MP3 player which contains the following information:
Song Name -- Artist -- Length -- Format -- Drive Location
Just zap it into the above and now I can display and sort and scroll by any of those fields as I desire, and click on whatever file/field I want, with just a scroll/click of the button. 
Posts: 373
Threads: 30
Joined: Jul 2022
Reputation:
27
Hi friends
thanks for feedbacks
@Bplus
thank you
@Pete
Yes I got the bug
![[Image: immagine-2024-12-24-104611185.png]](https://i.ibb.co/kD84tY7/immagine-2024-12-24-104611185.png)
you can see a toggle flickering of the 2 texts of menu item highlighted and you can see the 2 menu items highlighted...
the cause is the ovelapping of Y dimension of the mouse
BUUUT if we take away the two = in the control of the position of MouseY we get the opposite mistake/bug , if we point with the mouse on the border between the 2 items no item has been highlighted!
the solution is to delete only one of the 2 = in the control of the position of MouseY.
here the working code:
Code: (Select All)
Rem demo of menu with mouse selection
DefLng L
lwindow = _NewImage(800, 600, 32)
Screen lwindow
_Font 16
MenuItem$ = "First/Second/Third/Forth/Fifth/Sixth/Seventh/Eighth/Ninth/"
Do
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
While _MouseInput: _PrintString (300, 300), " X" + Str$(_MouseX) + "/ Y" + Str$(_MouseY) + " ": Wend
Mx% = _MouseX
My% = _MouseY
Mb% = _MouseButton(1)
ShowMenu MenuItem$, 40, 20, Mx%, My%, Mb%
Loop Until _MouseButton(2)
End
Sub ShowMenu (Menu$, X%, Y%, Xm%, Ym%, Bm%)
Start% = 1
Ends% = 0
Nitem% = 0
While InStr(Start%, Menu$, "/")
Ends% = InStr(Start%, Menu$, "/")
item$ = Mid$(Menu$, Start%, Ends% - Start%)
lbase$ = Space$(Int((12 - Len(item$)) / 2))
rbase$ = Space$(12 - (Len(lbase$ + item$)))
If MouseOver(X%, X% + (_FontWidth * 12), Y% + (_FontHeight * Nitem%), Y% + (_FontHeight * (Nitem% + 1)), Xm%, Ym%) Then
Color _RGBA(6, 238, 127, 255), _RGBA(0, 6, 255, 255)
_PrintString (300, 330), "Mouse over item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
If Bm% Then _PrintString (300, 360), "Selected item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
Else
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
End If
_PrintString (X%, Y% + (_FontHeight * Nitem%)), lbase$ + item$ + rbase$
Nitem% = Nitem% + 1
Start% = Ends% + 1
Wend
End Sub
Function MouseOver (X%, X1%, Y%, Y1%, Mx%, My%)
MouseOver = 0
If (Mx% >= X% And Mx% <= X1%) Then
If (My% > Y% And My% <= Y1%) Then MouseOver = 1
End If
End Function
Postscript:
yeah I mispelled ninth, now it is correct.
Yes nono is ninth in italian but if I press too much on the keyboard I can get with a n more nonno (grandfather)
Posts: 373
Threads: 30
Joined: Jul 2022
Reputation:
27
The monumental example of Steve let me try to use my original code for getting a subMenu..
here is the example
Code: (Select All)
Rem demo of menu with mouse selection
DefLng L
lwindow = _NewImage(800, 600, 32)
Screen lwindow
_Font 16
MenuItem$ = "First/Second/Third/Forth/Fifth/Menu2/Sixth/Seventh/Eighth/Ninth/"
Menu2$ = "1st/2nd/3rd/4th/5th/6th/7th/8th/9th/Back/"
item$ = ""
Do
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
While _MouseInput: _PrintString (580, 300), " X" + Str$(_MouseX) + "/ Y" + Str$(_MouseY) + " ": Wend
Mx% = _MouseX
My% = _MouseY
Mb% = _MouseButton(1)
If item$ = "Menu2" Then
item2$ = ShowMenu$(Menu2$, 40 + (_FontWidth * 12), 20 + (_FontHeight * a%), Mx%, My%, Mb%)
If item2$ = "Back" Then item$ = "": Line (40 + (_FontWidth * 12), 20 + (_FontHeight * a%))-(40 + (_FontWidth * 24), 20 + (_FontHeight * (a% + b%))), _RGBA(0, 0, 0, 255), BF
Else
item$ = ShowMenu$(MenuItem$, 40, 20, Mx%, My%, Mb%)
a% = Mx%
b% = My%
End If
Loop Until _MouseButton(2)
End
Function ShowMenu$ (Menu$, X%, Y%, Xm%, Ym%, Bm%)
Start% = 1
Ends% = 0
Nitem% = 0
item$ = ""
While InStr(Start%, Menu$, "/")
Ends% = InStr(Start%, Menu$, "/")
item$ = Mid$(Menu$, Start%, Ends% - Start%)
lbase$ = Space$(Int((12 - Len(item$)) / 2))
rbase$ = Space$(12 - (Len(lbase$ + item$)))
If MouseOver(X%, X% + (_FontWidth * 12), Y% + (_FontHeight * Nitem%), Y% + (_FontHeight * (Nitem% + 1)), Xm%, Ym%) Then
Color _RGBA(6, 238, 127, 255), _RGBA(0, 6, 255, 255)
_PrintString (580, 330), Space$(20)
_PrintString (580, 330), "Mouse over item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
If Bm% Then
_PrintString (580, 360), Space$(20)
_PrintString (580, 360), "Selected item" + Str$(Nitem% + 1) + lbase$ + item$ + rbase$
ShowMenu$ = item$
Ntemp% = Nitem%
End If
Else
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
End If
_PrintString (X%, Y% + (_FontHeight * Nitem%)), lbase$ + item$ + rbase$
Nitem% = Nitem% + 1
Start% = Ends% + 1
Wend
Xm% = Ntemp%
Ym% = Nitem%
End Function
Function MouseOver (X%, X1%, Y%, Y1%, Mx%, My%)
MouseOver = 0
If (Mx% >= X% And Mx% <= X1%) Then
If (My% > Y% And My% <= Y1%) Then MouseOver = 1
End If
End Function
It is fine to see how a sub can be more util becoming a function!
Posts: 4,021
Threads: 181
Joined: Apr 2022
Reputation:
227
12-24-2024, 02:30 PM
(This post was last modified: 12-24-2024, 02:35 PM by bplus.)
Hmm... what happened to my post? Try again, maybe I will remember to save it this time. 
Awesome Menu system @SMcNeill !
Scanning over code for something like Pete setup for getting mouse/keypress I find nothing like that. A _mouseinput in main for MouseWheel updates and apparently that is enough to get mouse locations for ProcessMenu Routine. Then there is MouseStatus, this could take a week of study 
Can you imagine how boring it would be just getting an exe to play with?
As I recall @Dav had a nice popup too, where is he anyway? probably doing Christmas gigs.
And speaking of MIA where is @TerryRitchie, he must have a menu library or someything.
b = b + ...
Posts: 2,275
Threads: 233
Joined: Apr 2022
Reputation:
114
Well unfinished, but it's Christmas Eve so I have to barbecue.
This code works but lacks some bells and whistles. It's part of a library build I'm making.
Multi drop-down menu demo...
Code: (Select All)
Dim Shared MenuBdrFg, MenubrdBg, MenuSdwFg, MenuSdwBg, MenuFg, MenuBg, MenuHlFg, MenuHlBg, pop
ReDim MapHeading$(1), a$(1): curstyle = 1
pop = 1
setup
a$ = " File Edit View Search": Locate 1, 1
map_heading a$, MapHeading$(), 0
a$ = "[F1] Help [Esc] Quit": Locate _Height, 1
map_heading a$, MapHeading$(), 1
menu_main MapHeading$(), curstyle
Sub User (selection)
Select Case selection
Case 1: Restore data1
Case 2: Restore data2
Case 3: Restore data4
Case 4: Restore data4
End Select
color_palette_data:
' MenuBdrFg, MenubrdBg, MenuSdwFg, MenuSdwBg, MenuFg, MenuBg, MenuHlFg, MenuHlBg
Data 1,-1,2,-1,3,-1,4,-1,5,-1,6,-1,7,63,8,-1,9,-1,10,-1,11,-1,12,-1,13,-1,14,-1,15,-1
Data 1,7,8,1,0,7,15,1
Data eof
data1:
Data New,Open,Save,Export,Exit
Data eof
data2:
Data Undo,Redo,Cut,Copy,Paste,Select All
Data eof
data3:
Data Subs...,Line Numbers,Compiler Warnings
Data eof
data4:
Data Find,Repeat Last Find,Change,Clear Search History,Quick Navigation,Go To Line
Data eof
help_data:
Data This demo includes this
Data handy dandy help window
Data where we simply add data
Data statements to produce
Data then help text displayed
Data in this pop-up window.
Data eof
End Sub
Sub setup
Restore color_palette_data
For i = 1 To 15
Read j, k
If k <> -1 Then Palette j, k
Next
For i = 1 To 8
Read j
Select Case i
Case 1: MenuBdrFg = j
Case 2: MenubrdBg = j
Case 3: MenuSdwFg = j
Case 4: MenuSdwBg = j
Case 5: MenuFg = j
Case 6: MenuBg = j
Case 7: MenuHlFg = j
Case 8: MenuHlBg = j
End Select
Next
bgc1 = 9: bgc2 = 1 ' Background appearance.
Color MenuHlFg, MenuHlBg
Cls
Color 14
Locate 2, 1: Print String$(80, 196);
Locate _Height - 1, 1: Print String$(80, 196);
Color bgc1, bgc2
For i = 3 To _Height - 2
Locate i, 1: Print String$(80, 176);
Next
Color 15, 1
End Sub
Sub menu_main (MapHeading$(), curstyle)
Do
_Limit 30
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$
menu_selection selection, curstyle, my, mx, lb, mb, mw, b$, MapHeading$(), a$()
Loop
End Sub
Sub map_heading (MapHeading$, MapHeading$(), centering)
y = CsrLin
Select Case centering
Case 0: Print MapHeading$;
Case Else
Locate , _Width \ 2 - Len(MapHeading$) \ 2 + 1
Print MapHeading$;
End Select
f$ = "": Locate y, 1
For i = 1 To _Width
f$ = f$ + Chr$(Screen(y, i))
Next
temp$ = " ": j = 0
If InStr(f$, "[") Then ' Bracket format.
For i = 1 To Len(f$) ' Map mouse hot zones.
x$ = Mid$(f$, i, 1)
If hot Then
If Left$(LTrim$(Mid$(f$, i) + "["), 1) = "[" Then
hot = 1 - hot: temp$ = " "
End If
End If
If x$ <> Chr$(32) And hot = 0 Then
hot = 1 - hot: j = j + 1: temp$ = Chr$(96 + j)
End If
map$ = map$ + temp$
Next
Else ' Two-space format.
For i = 1 To Len(f$) ' Map mouse hot zones.
x$ = Mid$(f$, i, 1)
If hot Then
If Mid$(f$ + " ", i, 2) = " " Then
hot = 1 - hot: temp$ = " "
End If
End If
If x$ <> Chr$(32) And hot = 0 Then
hot = 1 - hot: j = j + 1: temp$ = Chr$(96 + j)
End If
map$ = map$ + temp$
Next
End If
If y > UBound(MapHeading$) Then ReDim _Preserve MapHeading$(y)
MapHeading$(y) = map$
End Sub
Sub menu_selection (selection, curstyle, my, mx, lb, mb, mw, b$, MapHeading$(), a$())
Static MenuOpen, oldmy, oldmx, mshow$, action$, dcnt, MenuWidth, MenuHeight, MenuTop, menuleft, spacing, mhl
Select Case MenuOpen
Case 0
j = 0: selection = 0
If Len(MapHeading$(my)) And MenuOpen = 0 Then
j = Asc(Mid$(MapHeading$(my), mx, 1)) - 96
If j > 0 Then
If curstyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
If lb = 2 Then selection = j
Else
j = 0
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
End If
If selection Then
Select Case my
Case 1
dcnt = 0: MenuWidth = 0
User selection
Do
Read dta$
If dta$ = "eof" Then Exit Do
If (_Height - 6 + pop) \ 2 <= (dcnt * (spacing + 1) + 1) \ 2 + pop Then Exit Do ' Data exceeds window max menu height.
dcnt = dcnt + 1
If Len(dta$) > MenuWidth - 4 Then
MenuWidth = Len(dta$) + 4
Rem MenuLeft = _Width \ 2 - Len(dta$) \ 2 - 2 + 1
End If
Loop
ReDim a$(dcnt)
User selection
For i = 1 To dcnt
Read dta$
a$(i) = Space$(MenuWidth - 4)
Select Case style
Case 0: j = 1
Case 1: j = (MenuWidth - 4) \ 2 - Len(dta$) \ 2 + 1
End Select
Mid$(a$(i), j) = dta$
Next
MenuHeight = dcnt * (spacing + 1) - spacing + 2
MenuTop = my + 1 + pop: Rem To center is _Height \ 2 - MenuHeight \ 2 + 1
menuleft = _InStrRev(" " + Mid$(MapHeading$(my), 1, mx), " ")
action$ = "": mhl = 0
MenuOpen = 1: PCopy 0, 1
center_menu pop, a$(), dcnt, MenuWidth, MenuHeight, MenuTop, menuleft, spacing
Case _Height
Select Case selection
Case 1
Restore help_data
help$ = ""
Do
Read d$
If d$ = "eof" Then Exit Do
help$ = help$ + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + d$
Loop
_MessageBox " App Help", help$, ""
Case 2: System
End Select
End Select
End If
Case 1
If Len(b$) Then
action$ = "key"
ElseIf mw Then
action$ = "wheel"
ElseIf oldmy And my <> oldmy Or oldmy And mx <> oldmx Then
If my > MenuTop - pop And my < MenuTop - pop + MenuHeight - 1 And mx > menuleft - pop + 1 And mx < menuleft - pop + MenuWidth - 2 Then
action$ = "mouse-in"
Else
If action$ <> "wheel" And action$ <> "key" Then
action$ = "mouse-out"
End If
End If
End If
j = 0
Select Case action$
Case "wheel", "key"
If mhl + mw > 0 And mhl + mw <= UBound(a$) Then
j = mhl + mw
End If
Case "mouse-in"
j = (my - MenuTop + pop + spacing) / (spacing + 1)
Case "mouse-out"
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
If mhl Then
s1 = CsrLin: s2 = Pos(0): c1 = _DefaultColor: c2 = _BackgroundColor
Locate MenuTop - pop + mhl + (mhl - 1) * spacing, menuleft - pop + 2 - 1: Color MenuFg, MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
If lb = 2 Then PCopy 1, 0: MenuOpen = 0: If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End Select
If j And Int(j) = j Then
If j <> mhl Then
s1 = CsrLin: s2 = Pos(0): c1 = _DefaultColor: c2 = _BackgroundColor
If mhl Then Locate MenuTop - pop + mhl + (mhl - 1) * spacing, menuleft - pop + 2 - 1: Color MenuFg, MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight former.
Locate MenuTop - pop + j + (j - 1) * spacing, menuleft - pop + 2 - 1: Color MenuHlFg, MenuHlBg: Print " " + a$(j) + " ";: Locate s1, s2: Color c1, c2: mhl = j ' Highlight current.
End If
Select Case action$
Case "mouse-in"
If curstyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
If lb = 2 Then
b$ = LTrim$(Str$(j))
PCopy 1, 0: MenuOpen = 0: If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
_Title a$(j)
End If
Case "wheel", "key"
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
If mb = 2 Or lb = 2 Then
b$ = LTrim$(Str$(j))
PCopy 1, 0: MenuOpen = 0: If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
_Title a$(j)
End If
End Select
End If
oldmy = my: oldmx = mx
End Select
End Sub
Sub center_menu (pop, a$(), dcnt, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing)
' Centers height evenly for odd window heights and 1-space towards top for even.
Locate MenuTop - pop, MenuLeft - pop
For h = 1 To dcnt
If h = 1 Then
Color MenuBdrFg, MenubrdBg
Print Chr$(218) + String$(MenuWidth - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To MenuHeight - 2
If CsrLin < _Height Then Locate j, MenuLeft - pop Else Locate , MenuLeft - pop
Color MenuBdrFg, MenubrdBg: Print Chr$(179);
Color MenuBdrFg, MenubrdBg: Print Space$(MenuWidth - 2);
Color MenuBdrFg, MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, MenuLeft - pop
Color MenuBdrFg, MenubrdBg: Print Chr$(192) + String$(MenuWidth - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color MenuSdwFg, MenuSdwBg ' Shadow below.
Locate CsrLin + 1, MenuLeft - pop + 2
For i = 1 To MenuWidth
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate MenuTop - pop + 1 ' Shadow to the right.
For i = 1 To MenuHeight - 1
Locate , MenuLeft - pop + MenuWidth
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color MenuFg, MenuBg
Locate MenuTop - pop + h + (h - 1) * spacing, MenuLeft - pop + 2
Print a$(h);
Next h
End Sub
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$)
Static oldmy, oldmx, z1, hover, mwy, oldmwy
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Else
b$ = InKey$
End If
If z1 Then If Abs(Timer - z1) > .3 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
b_hover = 0
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
Exit For
End If
Next
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 Else If shift% Then shift% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1
If z1 = 0 Then
z1 = Timer ' Let first click go through.
Else
clkcnt = clkcnt + 1
End If
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
oldmy = my: oldmx = mx
End Sub
So I also need to get caught up on these posts, but I did see Steve posted something about multi-menus. I'm guessing it is what I made here in graphics mode, but I'll hopefully get a chance to catch up Christmas morning when the rest of the family is sleeping in. We are waaaaaay past the getting up at dawn to unwrap presents. I do miss those days.
So Merry Christmas to all!
Pete
|
What do you guys like to use for mouse mapping?
