Posts: 4,138
Threads: 190
Joined: Apr 2022
Reputation:
261
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,574
Threads: 264
Joined: Apr 2022
Reputation:
140
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" | | Do | | If Len(autokey$) Then | | b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1) | | 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 | | 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: 442
Threads: 45
Joined: Jul 2022
Reputation:
43
Here a way to do menulist with mouse selection
Code: (Select All)
| | | | | | | 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,574
Threads: 264
Joined: Apr 2022
Reputation:
140
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,138
Threads: 190
Joined: Apr 2022
Reputation:
261
Yeah I liked TempodiBasic's ShowMenu routine too.
b = b + ...
Posts: 3,017
Threads: 357
Joined: Apr 2022
Reputation:
282
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: 442
Threads: 45
Joined: Jul 2022
Reputation:
43
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)
| | | | | | | 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: 442
Threads: 45
Joined: Jul 2022
Reputation:
43
The monumental example of Steve let me try to use my original code for getting a subMenu..
here is the example
Code: (Select All)
| | | | | | | 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,138
Threads: 190
Joined: Apr 2022
Reputation:
261
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,574
Threads: 264
Joined: Apr 2022
Reputation:
140
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: | | | | 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 | | 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 | | For i = 1 To Len(f$) | | 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 | | For i = 1 To Len(f$) | | 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 | | dcnt = dcnt + 1 | | If Len(dta$) > MenuWidth - 4 Then | | MenuWidth = Len(dta$) + 4 | | | | 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: | | 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) + " "; | | 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) + " "; | | 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 | | 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) | | | | 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 | | Color MenuSdwFg, MenuSdwBg | | Locate CsrLin + 1, MenuLeft - pop + 2 | | For i = 1 To MenuWidth | | j = Screen(CsrLin, Pos(0)) | | Print Chr$(j); | | Next | | Locate MenuTop - pop + 1 | | 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 | | 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) | | 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 | | 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?
