Well, we already have one called a mouse wheel. I know how much bplus loves them so I thought I'd put a mouse highlighting "wheel" function into a menu routine I am morphing into a library.
Now this works as a roughed out 'Demo' but I'd appreciate some critique before I keep working on it.
Am I missing anything? The wheel choices can be activated with Enter, left or middle mouse click. There is no need to put the pointer in the menu to use the mouse. I thought about having the wheel initiate highlighting from the bottom up if the first roll if negative, upwards, but maybe that's too corny.... Steve would know.
Also line 103 to 147.... these....
... determine the behavior of using arrow up/down keys, wheel, and mouse pointer with the routine. If anyone sees some optimization that can be applied to these 44 lines, I'm all ears. No Steve, not corn ears. Now that would be corny.
Pete
Now this works as a roughed out 'Demo' but I'd appreciate some critique before I keep working on it.
Code: (Select All)
_ScreenMove _Middle
_Font 16
Dim Shared MenuBdrFg, MenubrdBg, MenuSdwFg, MenuSdwBg, MenuFg, MenuBg, MenuHlFg, MenuHlBg
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
CurStyle = 1
MenuWidth = 0
bgc1 = 9: bgc2 = 1 ' Background appearance.
While -1
Color MenuHlFg, MenuHlBg
Cls
Color 14, 1
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 14, 1
Locate 1
text$ = "Menu Options"
Print center$(text$);
Locate _Height
text$ = "[F1] Help [Esc] Quit"
Print center$(text$);
Restore menu_data: dcnt = 0: mhl = 0
Do
Read dta$
If dta$ = "eof" Then Exit Do
If _Height \ 2 <= (dcnt * (spacing + 1) + 1) \ 2 + pop Then Exit Do ' Data exceeds window max menu height.
dcnt = dcnt + 1
ReDim _Preserve a$(dcnt)
If Len(dta$) > MenuWidth - 4 Then
MenuWidth = Len(dta$) + 4
MenuLeft = _Width \ 2 - Len(dta$) \ 2 - 2 + 1
End If
Loop
Restore menu_data
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 = _Height \ 2 - MenuHeight \ 2 + 1
action$ = ""
Color MenuBdrFg, MenubrdBg
center_menu pop, a$(), dcnt, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing
Do
_Limit 60
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$
Select Case b$
Case Chr$(0) + "H"
mw = -1: b$ = ""
Case Chr$(0) + "P"
mw = 1: b$ = ""
Case Chr$(13)
b$ = LTrim$(Str$(mhl))
End Select
If my = _Height Then ' Special to footer menu.
If FooterMap$ = "" Then
For i = 1 To _Width
FooterMap$ = FooterMap$ + Chr$(Screen(_Height, i))
Next
End If
j = _InStrRev(Mid$(FooterMap$, 1, mx), "[") + 1
If j Then
temp$ = RTrim$(Mid$(FooterMap$, j, InStr(Mid$(FooterMap$, j) + "[", "[") - 1))
If mx < j + Len(temp$) Then
If CurStyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
If lb = 2 Then
b$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)
End If
Else
If CurStyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
Else
If CurStyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
Else ' Main or popup menu.
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
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 lb = 2 Then b$ = LTrim$(Str$(j))
If CurStyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
Case "wheel", "key"
If mb = 2 Or lb = 2 Then b$ = LTrim$(Str$(j))
If CurStyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End Select
End If
End If
Select Case b$
Case "1": spacing = 0
Case "2": spacing = 1
Case "3": spacing = 2
Case "4": style = 1 - style
Case "5"
Select Case bgc2
Case 0: bgc2 = 1
Case 1: bgc2 = 0
End Select
Case "6": CurStyle = 1 - CurStyle
Case "7"
pop = 1 - pop
Case Chr$(0) + Chr$(59), "F1"
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 Chr$(27), "Esc": Exit While
End Select
If Len(b$) Then Exit Do
oldmy = my: oldmx = mx
Loop
Wend
System
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
menu_data:
Data "1) Single-Space Display Menu"
Data "2) Double-Space Display Menu"
Data "3) Triple-Space Display Menu"
Data "4) Toggle Block/Center Style"
Data "5) Toggle Background"
Data "6) Toggle Link Cursor On/Off"
Data "7) Toggle Flat/Popup Window"
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
Function center$ (text$)
Locate , _Width \ 2 - Len(text$) \ 2 + 1
center$ = text$
End Function
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
Am I missing anything? The wheel choices can be activated with Enter, left or middle mouse click. There is no need to put the pointer in the menu to use the mouse. I thought about having the wheel initiate highlighting from the bottom up if the first roll if negative, upwards, but maybe that's too corny.... Steve would know.
Also line 103 to 147.... these....
Code: (Select All)
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
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 lb = 2 Then b$ = LTrim$(Str$(j))
If CurStyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
Case "wheel", "key"
If mb = 2 Or lb = 2 Then b$ = LTrim$(Str$(j))
If CurStyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End Select
End If... determine the behavior of using arrow up/down keys, wheel, and mouse pointer with the routine. If anyone sees some optimization that can be applied to these 44 lines, I'm all ears. No Steve, not corn ears. Now that would be corny.
Pete
