Posts: 4,085
Threads: 181
Joined: Apr 2022
Reputation:
232
12-25-2024, 04:29 AM
(This post was last modified: 12-25-2024, 04:41 AM by bplus.)
From Prolific Programmers >> bplus >> b+ Beginners Corner page 6 reply #51
Code: (Select All)
Option _Explicit ' no typos for variables if you please
_Title "Drop Menu more 2 function test" ' b+ 2023-06-27
' Instigated by Dimster here:
' https://qb64phoenix.com/forum/showthread...7#pid17117
' More! = 1. Highlite mouse overs 2. Handle extra long menu descriptions up to .5 screen width
' So sorry Ultraman, no tool tips but extra long descriptions is better than nutt'n.
Const ButtonW = 100, ButtonH = 20 ' basic rectangle size for title of menu panel
Type BoxType ' to be used for MouseZone click checking
As String Label ' menu title
As Long LeftX, TopY, BoxW, BoxH ' left most, top most , box width, box height
End Type
Dim Shared As Integer NBoxes ' setting up a demo in main
NBoxes = 72 ' exorbinant amount of menu titles
Dim Shared Boxes(1 To NBoxes) As BoxType ' data array for positions and labels
Dim As Integer i, x, y, mz, nItems, choice ' index, positions, menu count, choice selected
ReDim menu$(1 To 1) ' dynamic array to store quick menu's into
Dim s$ ' a string variable
Screen _NewImage(800, 600, 32) ' screen stuff
_ScreenMove 250, 50 ' somewhere in middle of my laptop, you may prefer to change for your screen
_PrintMode _KeepBackground ' preserve background when printing stuff
Cls ' so we have solid black background for image saving
x = 0: y = 0 ' set up boxes x, y for top left box corner
For i = 1 To NBoxes
Boxes(i).Label = "Box" + Str$(i) ' quick menu title
Boxes(i).LeftX = x: Boxes(i).TopY = y ' top left corner
Boxes(i).BoxW = ButtonW ' width to constant set for all
Boxes(i).BoxH = ButtonH ' height to constant set for all
If (x + 2 * ButtonW) > _Width Then ' spread out the menu titles left right, top down
x = 0: y = y + ButtonH ' next title didn't fit across so start new row
Else
x = x + ButtonW ' fits going across
End If
DrawTitleBox i ' draw the menu title panel
Next
Do
mz = MouseZone% ' reports which menu panel has been clicked and mouse
If mz Then ' quick make up a list of items for the menu title box
nItems = Int(Rnd * 10) + 1 ' pick random 1 to 10 inclusive
ReDim menu$(1 To nItems) ' resize menu$ by nItems
For i = 1 To nItems ' menu option and description
s$ = "Box" + Str$(mz) + " Menu Item:" + Str$(i) ' still needs to be less
s$ = s$ + " with extra, extra, long description." ' than .5 screen width
menu$(i) = s$ ' item is described with fairly good width to it
Next ' his was alternate to tool tips
choice = getButtonNumberChoice%(Boxes(mz).LeftX, Boxes(mz).TopY, menu$())
If choice = 0 Then s$ = "You quit menu by clicking outside of it." Else s$ = menu$(choice)
_MessageBox "Drop Menu Test", "Your Menu Choice was: " + s$, "info"
End If
_Limit 30
Loop Until _KeyDown(27)
Sub DrawTitleBox (i) ' draw a box according to shared Boxes array then print label
Line (Boxes(i).LeftX + 1, Boxes(i).TopY + 1)-Step(ButtonW - 2, ButtonH - 2), &HFF550088, BF
Color &HFFFFFFFF
_PrintString (Boxes(i).LeftX + (ButtonW - _PrintWidth(Boxes(i).Label)) / 2, _
Boxes(i).TopY + ButtonH / 2 - 8), Boxes(i).Label
End Sub
Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$) ' draw menu items for menu title
If highliteTF% Then ' reverse colors as mouse is over this item
Line (leftX, topY)-Step(BoxW, ButtonH), &HFFAAAAAA, BF
Color &HFF333333
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
Else
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF333333, BF
Color &HFFAAAAAA
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
End If
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF000000, B ' draw black box around item
End Sub
Function MouseZone% ' returns the Shared Boxes() index clicked or 0 none clicked
' Set the following up in your Main code of app
'Type BoxType ' to be used for mouse click checking
' As Long LeftX, TopY, BoxW, BoxH ' left most, top most, box width, box height
'End Type
'Dim Shared As Integer NBoxes
'Dim Shared Boxes(1 To NBoxes) As BoxType
Dim As Integer i, mb, mx, my
While _MouseInput: Wend ' poll mouse
mb = _MouseButton(1) ' looking for left click
If mb Then
_Delay .25
mx = _MouseX: my = _MouseY ' get the mouse position
For i = 1 To NBoxes ' see if its in a menu tile box from data in Shared Boxes array
If mx > Boxes(i).LeftX And mx < Boxes(i).LeftX + Boxes(i).BoxW Then
If my > Boxes(i).TopY And my < Boxes(i).TopY + Boxes(i).BoxH Then
MouseZone% = i: Exit Function ' yes a click in this box index
End If
End If
Next
End If
End Function
Function getButtonNumberChoice% (BoxX As Integer, BoxY As Integer, choice$())
' This fucion uses Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$)
' BoxX, BoxY are top left corner from the Menu Title Panel
' We will be drawing our Menu Items below that panel
Dim As Integer ub, lb, b ' choice$() boundaries and an index, b, to run through items
Dim As Integer longest ' find the longest string length in choices
Dim As Integer menuW, menuX ' use menuWidth and menuX start box side so long menu strings fit
Dim As Integer mx, my, mb ' mouse status of position and left button
Dim As Long save ' we are saving the whole screen before drop down to redraw after click
Dim As Long drawerDown ' save drawer down after animate dropping drawers for Dimster
ub = UBound(choice$): lb = LBound(choice$) ' array boundaries
For b = lb To ub ' find longest string in choice
If Len(choice$(b)) > longest Then longest = Len(choice$(b))
Next
If (longest + 2) * 8 > ButtonW Then ' don't use default button Width string too long
menuW = (longest + 2) * 8 ' calculate the needed width, up to half screen fits
If BoxX < _Width / 2 - 3 Then ' -3 ?? wouldn't work right until took 3 off middle
menuX = BoxX ' use the same left side of box to start
Else
menuX = BoxX + ButtonW - menuW ' right side box align minus menu width = x start box
End If
Else
menuW = ButtonW ' use default sizes that fit nicely under menu title panel
menuX = BoxX
End If
save = _NewImage(_Width, _Height, 32) ' save our beautiful screen before dropping menu
_PutImage , 0, save
' Animate dropping drawers for Dimster
For b = lb To ub ' clear any previous highlites
DrawChoiceBox 0, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
_Limit 5
Next
drawerDown = _NewImage(_Width, _Height, 32) ' save our beautiful screen after dropping menu
_PutImage , 0, drawerDown
Do ' until a mouse click occurs
_PutImage , drawerDown, 0 ' actually this is better to clear screen with image
While _MouseInput: Wend ' poll mouse
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
For b = lb To ub ' scan through the box dimension to see if mouse is in one
If mx > menuX And mx <= menuX + menuW Then
If my >= BoxY + b * ButtonH And my <= BoxY + b * ButtonH + ButtonH Then
If mb Then ' item is clicked!
_PutImage , save, 0 ' put image of screen back
_FreeImage save ' throw out screen image so no memory leak
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = b: _Delay .25: _AutoDisplay: Exit Function
Else
' indicate mouse over this menu item! draw highlight in box = -1
DrawChoiceBox -1, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
End If
End If
End If
Next
If mb Then ' there was a click outside the menu = cancel
_PutImage , save, 0 ' put image before dropdown draw back up
_FreeImage save ' leaving sub avoid memory leak, dump image
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = 0: _Delay .25: _AutoDisplay: Exit Function
End If
_Display ' display was needed here to avoid blinking when redrawing the highlited item
'_Limit 60
Loop ' until a mouse click occurs
End Function
b = b + ...
Posts: 2,328
Threads: 239
Joined: Apr 2022
Reputation:
120
12-25-2024, 06:45 PM
(This post was last modified: 12-25-2024, 06:46 PM by Pete.)
@bplus
I like unwrapping presents Christmas morning!
Nice effects, even though it's not SCREEN 0.
Want to bullet proof it? What I mean is, as coded, it fails if you pick a box like 46 but hold the left mouse button down for a few seconds. It will issue a message you clicked outside the box because it thinks you are clicking still on box 46. When you click OK, all subsequent clicks will be met with repeated looping outside the box error messages.
Check out the slight mouse revisions (see ----) dashes and the (2) remarked 'REMOVE' statements needed to fix the mouse held down issue.
Triggers on left mouse button depressed. Change mb value to = 2 for trigger on left mouse click released.
Code: (Select All)
Option _Explicit ' no typos for variables if you please
_Title "Drop Menu more 2 function test" ' b+ 2023-06-27
' Instigated by Dimster here:
' https://qb64phoenix.com/forum/showthread...7#pid17117
' More! = 1. Highlite mouse overs 2. Handle extra long menu descriptions up to .5 screen width
' So sorry Ultraman, no tool tips but extra long descriptions is better than nutt'n.
Const ButtonW = 100, ButtonH = 20 ' basic rectangle size for title of menu panel
Type BoxType ' to be used for MouseZone click checking
As String Label ' menu title
As Long LeftX, TopY, BoxW, BoxH ' left most, top most , box width, box height
End Type
Dim Shared As Integer NBoxes ' setting up a demo in main
NBoxes = 72 ' exorbinant amount of menu titles
Dim Shared Boxes(1 To NBoxes) As BoxType ' data array for positions and labels
Dim As Integer i, x, y, mz, nItems, choice ' index, positions, menu count, choice selected
ReDim menu$(1 To 1) ' dynamic array to store quick menu's into
Dim s$ ' a string variable
Screen _NewImage(800, 600, 32) ' screen stuff
_ScreenMove 250, 50 ' somewhere in middle of my laptop, you may prefer to change for your screen
_PrintMode _KeepBackground ' preserve background when printing stuff
Cls ' so we have solid black background for image saving
x = 0: y = 0 ' set up boxes x, y for top left box corner
For i = 1 To NBoxes
Boxes(i).Label = "Box" + Str$(i) ' quick menu title
Boxes(i).LeftX = x: Boxes(i).TopY = y ' top left corner
Boxes(i).BoxW = ButtonW ' width to constant set for all
Boxes(i).BoxH = ButtonH ' height to constant set for all
If (x + 2 * ButtonW) > _Width Then ' spread out the menu titles left right, top down
x = 0: y = y + ButtonH ' next title didn't fit across so start new row
Else
x = x + ButtonW ' fits going across
End If
DrawTitleBox i ' draw the menu title panel
Next
Do
mz = MouseZone% ' reports which menu panel has been clicked and mouse
If mz Then ' quick make up a list of items for the menu title box
nItems = Int(Rnd * 10) + 1 ' pick random 1 to 10 inclusive
ReDim menu$(1 To nItems) ' resize menu$ by nItems
For i = 1 To nItems ' menu option and description
s$ = "Box" + Str$(mz) + " Menu Item:" + Str$(i) ' still needs to be less
s$ = s$ + " with extra, extra, long description." ' than .5 screen width
menu$(i) = s$ ' item is described with fairly good width to it
Next ' his was alternate to tool tips
choice = getButtonNumberChoice%(Boxes(mz).LeftX, Boxes(mz).TopY, menu$())
If choice = 0 Then s$ = "You quit menu by clicking outside of it." Else s$ = menu$(choice)
_MessageBox "Drop Menu Test", "Your Menu Choice was: " + s$, "info"
End If
_Limit 30
Loop Until _KeyDown(27)
Sub DrawTitleBox (i) ' draw a box according to shared Boxes array then print label
Line (Boxes(i).LeftX + 1, Boxes(i).TopY + 1)-Step(ButtonW - 2, ButtonH - 2), &HFF550088, BF
Color &HFFFFFFFF
_PrintString (Boxes(i).LeftX + (ButtonW - _PrintWidth(Boxes(i).Label)) / 2, _
Boxes(i).TopY + ButtonH / 2 - 8), Boxes(i).Label
End Sub
Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$) ' draw menu items for menu title
If highliteTF% Then ' reverse colors as mouse is over this item
Line (leftX, topY)-Step(BoxW, ButtonH), &HFFAAAAAA, BF
Color &HFF333333
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
Else
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF333333, BF
Color &HFFAAAAAA
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
End If
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF000000, B ' draw black box around item
End Sub
Function MouseZone% ' returns the Shared Boxes() index clicked or 0 none clicked
' Set the following up in your Main code of app
'Type BoxType ' to be used for mouse click checking
' As Long LeftX, TopY, BoxW, BoxH ' left most, top most, box width, box height
'End Type
'Dim Shared As Integer NBoxes
'Dim Shared Boxes(1 To NBoxes) As BoxType
Dim As Integer i, mb, mx, my
'------------------------
Do '<------
If mb > 0 Then
If mb = 1 Then
mb = -1
Else
mb = 0: Exit Do ' Mouse button cycle completed.
End If
End If
'------------------------
While _MouseInput: Wend ' poll mouse
' REMOVE mb = _MouseButton(1) ' looking for left click
'------------------------
If mb = -1 And _MouseButton(1) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If mb = 0 Then
mb = 1
End If
End If
If mb = 1 Then
'------------------------
mx = _MouseX: my = _MouseY ' get the mouse position
For i = 1 To NBoxes ' see if its in a menu tile box from data in Shared Boxes array
If mx > Boxes(i).LeftX And mx < Boxes(i).LeftX + Boxes(i).BoxW Then
If my > Boxes(i).TopY And my < Boxes(i).TopY + Boxes(i).BoxH Then
MouseZone% = i ' REMOVE Exit Function ' yes a click in this box index
End If
End If
Next
End If
Loop '<------
End Function
Function getButtonNumberChoice% (BoxX As Integer, BoxY As Integer, choice$())
' This fucion uses Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$)
' BoxX, BoxY are top left corner from the Menu Title Panel
' We will be drawing our Menu Items below that panel
Dim As Integer ub, lb, b ' choice$() boundaries and an index, b, to run through items
Dim As Integer longest ' find the longest string length in choices
Dim As Integer menuW, menuX ' use menuWidth and menuX start box side so long menu strings fit
Dim As Integer mx, my, mb ' mouse status of position and left button
Dim As Long save ' we are saving the whole screen before drop down to redraw after click
Dim As Long drawerDown ' save drawer down after animate dropping drawers for Dimster
ub = UBound(choice$): lb = LBound(choice$) ' array boundaries
For b = lb To ub ' find longest string in choice
If Len(choice$(b)) > longest Then longest = Len(choice$(b))
Next
If (longest + 2) * 8 > ButtonW Then ' don't use default button Width string too long
menuW = (longest + 2) * 8 ' calculate the needed width, up to half screen fits
If BoxX < _Width / 2 - 3 Then ' -3 ?? wouldn't work right until took 3 off middle
menuX = BoxX ' use the same left side of box to start
Else
menuX = BoxX + ButtonW - menuW ' right side box align minus menu width = x start box
End If
Else
menuW = ButtonW ' use default sizes that fit nicely under menu title panel
menuX = BoxX
End If
save = _NewImage(_Width, _Height, 32) ' save our beautiful screen before dropping menu
_PutImage , 0, save
' Animate dropping drawers for Dimster
For b = lb To ub ' clear any previous highlites
DrawChoiceBox 0, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
_Limit 5
Next
drawerDown = _NewImage(_Width, _Height, 32) ' save our beautiful screen after dropping menu
_PutImage , 0, drawerDown
Do ' until a mouse click occurs
_PutImage , drawerDown, 0 ' actually this is better to clear screen with image
While _MouseInput: Wend ' poll mouse
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
For b = lb To ub ' scan through the box dimension to see if mouse is in one
If mx > menuX And mx <= menuX + menuW Then
If my >= BoxY + b * ButtonH And my <= BoxY + b * ButtonH + ButtonH Then
If mb Then ' item is clicked!
_PutImage , save, 0 ' put image of screen back
_FreeImage save ' throw out screen image so no memory leak
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = b: _Delay .25: _AutoDisplay: Exit Function
Else
' indicate mouse over this menu item! draw highlight in box = -1
DrawChoiceBox -1, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
End If
End If
End If
Next
If mb Then ' there was a click outside the menu = cancel
_PutImage , save, 0 ' put image before dropdown draw back up
_FreeImage save ' leaving sub avoid memory leak, dump image
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = 0: _Delay .25: _AutoDisplay: Exit Function
End If
_Display ' display was needed here to avoid blinking when redrawing the highlited item
'_Limit 60
Loop ' until a mouse click occurs
End Function
Pete
Posts: 4,085
Threads: 181
Joined: Apr 2022
Reputation:
232
+1 @Pete
Wow! I never saw that happen before! If you click that like a normal person it worked fine BUT if for some reason you are extra slow on the release (and I guess we do get that way eventually) that becomes an app from HELL! After a long click the first message is correct BUT it just thinks you selected and clicked and selected and clicked over and over again, yikes!
So all that was changed was the MouseZone% Routine, you have to add a loop to that? I have to study that change, seems like there would be something simpler to fix that.
Thankyou for alerting me to this and providing a solution.
b = b + ...
Posts: 2,328
Threads: 239
Joined: Apr 2022
Reputation:
120
@TempoidBasic
@bplus
@SMcNeill
My friend ftom Italy made a graphics demo of what is known in HTML circles as a 'suckerfish' menu. I have used this in SCREEN 0 for 2 apps I created. Now reinventing that wheel in this 'libray to be' app.
Pete's SCREEN 0 Menus with suckerfish menus in the works. (Open 'File" menu and click on "Export" for example).
Code: (Select All)
Dim Shared MenuBdrFg, MenubrdBg, MenuSdwFg, MenuSdwBg, MenuFg, MenuBg, MenuHlFg, MenuHlBg, pop
ReDim MapHeading$(1), a$(1): curstyle = 1
pop = 1
setup
Color 1, 7
a$ = " File Edit View Search": Locate 1, 1
map_heading a$, MapHeading$(), 0
Color 7, 1
a$ = "[F1] Help [Esc] Quit": Locate _Height, 1
map_heading a$, MapHeading$(), 1
menu_main MapHeading$(), curstyle
End
erhandler_data:
Cls
Print "Sucker ="; sucker: Print
Print "Error: " + LTrim$(Str$(Err)) + " at line " + LTrim$(Str$(Erl)) + ". Incorrectly aligned data statements is the most likely cause."
End
Sub User (selection, sucker)
If sucker > 0 Then
Select Case sucker
Case 1: Restore suckerfish1
End Select
Else
Select Case selection
Case 1: Restore data1
Case 2: Restore data2
Case 3: Restore data4
Case 4: Restore data4
End Select
End If
color_palette_data:
' MenuBdrFg, MenubrdBg, MenuSdwFg, MenuSdwBg, MenuFg, MenuBg, MenuHlFg, MenuHlBg
Data 1,-1,2,-1,3,-1,4,-1,5,-1,6,63,7,-1,8,-1,9,-1,10,-1,11,-1,12,-1,13,-1,14,-1,15,-1
Data 1,6,8,1,0,6,15,1
Data eof
data1:
Data New,N,0,Open,O,0,Save,S,0,,Export,E,1,,Exit,x,0
Data eof
data2:
Data Undo,U,0,Redo,R,0,Cut,0,0,Copy,0,0,Paste,0,0,Select All,0,0
Data eof
data3:
Data Subs...,S,0,Line Numbers,L,0,Compiler Warnings,C,0
Data eof
data4:
Data Find,F,0,Repeat Last Find,R,0,Change,F,0,Clear Search History,C,0,Quick Navigation,Q,0,Go To Line,G,0
Data eof
suckerfish1:
Data Hypertext,H,Rich Text,R,Code Block,C
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
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: Locate y, 1: Print Space$(_Width);
Select Case centering
Case 0: Locate y, 1
Case Else: Locate y, _Width \ 2 - Len(MapHeading$) \ 2 + 1
End Select
Print MapHeading$;
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, abr$(), sf(), sucker, oldmy, oldmx, mshow$, action$, dcnt, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing, mhl
Static oldmhl, oldmenutop, oldMenuLeft, oldselection
If MenuOpen = 0 Then selection = 0
Select Case MenuOpen
Case 0
j = 0
If Len(MapHeading$(my)) And selection = 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 ' The menu selected to be opened.
MenuOpen = my ' The row the selected menu occupies.
End If
Else
j = 0
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
101
If selection Then
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$ ' Remove link mouse appearance.
Select Case my
Case 1 ' Top menu.
dcnt = 0: MenuWidth = 0
User selection, sucker
On Error GoTo erhandler_data
Do
Read dta$
If dta$ = "eof" Then Exit Do
If Len(dta$) Then
Read nul$, nul
If nul Then dta$ = dta$ + " " + Chr$(26) + " "
End If
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
On Error GoTo 0
ReDim a$(dcnt), abr$(dcnt), sf(dcnt)
User selection, sucker
On Error GoTo erhandler_data
For i = 1 To dcnt
Read dta$
If Len(dta$) Then
Read abr$(i), nul
If nul Then dta$ = dta$ + " " + Chr$(26): sf(i) = nul
End If
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
On Error GoTo 0
MenuHeight = dcnt * (spacing + 1) - spacing + 2
If sucker <> -1 Then
MenuTop = my + 1 + pop: Rem To center is _Height \ 2 - MenuHeight \ 2 + 1
MenuLeft = _InStrRev(" " + Mid$(MapHeading$(my), 1, mx), " ")
action$ = "": mhl = 0
PCopy 0, 1
center_menu pop, a$(), dcnt, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing
Else
sucker = 0
End If
Case _Height ' The footer menu.
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$, ""
MenuOpen = 0: selection = 0 ' Needed to clear variables.
Case 2: System
End Select
End Select
End If
Case Else ' Menu is open.
If Len(MapHeading$(MenuOpen)) And my = MenuOpen Then ' Sliding mouse to open menus.
j = Asc(Mid$(MapHeading$(MenuOpen), mx, 1)) - 96
If j > 0 And j <> selection Then
selection = j ' Leave MenuOpen as is.
If sucker Then sucker = 0
PCopy 1, 0
GoTo 101
End If
End If
If j = selection And lb = 2 Then
action$ = "toggle-shut"
ElseIf Len(b$) Then
action$ = "key"
ElseIf mw Then
action$ = "wheel"
ElseIf oldmy And my <> oldmy And action$ <> "toggle-shut" Or oldmy And mx <> oldmx And action$ <> "toggle-shut" 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"
Select Case b$
Case Chr$(0) + "H"
mw = -1: b$ = ""
Case Chr$(0) + "P"
mw = 1: b$ = ""
End Select
If mhl + mw > 0 And mhl + mw <= UBound(a$) Then
j = mhl
Do
j = j + mw: If j > UBound(a$) Then Exit Do
Loop Until Len(LTrim$(a$(j)))
End If
Case "mouse-in"
j = (my - MenuTop + pop + spacing) / (spacing + 1)
Case "mouse-out", "toggle-shut"
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
If sucker = 1 Then ' Closes suckerfish menu. Keeps parent menu open.
sucker = -1: PCopy 2, 0
MenuLeft = oldMenuLeft
MenuTop = oldmenutop
mhl = oldmhl: selection = oldselection
my = 1 '''' Need to address this issue.
GoTo 101
Else
PCopy 1, 0: MenuOpen = 0: Exit Sub
End If
End If
End Select
If j And Int(j) = j Then
If j <> mhl And Len(LTrim$(a$(j))) 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
If sf(j) Then ' Open suckerfish menu.
oldmhl = mhl: oldmenutop = MenuTop: oldMenuLeft = MenuLeft: oldselection = selection
dcnt = 0
sucker = 1: User selection, sucker
On Error GoTo erhandler_data
Do
Read dta$
If dta$ = "eof" Then Exit Do
If Len(dta$) Then Read nul$
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
On Error GoTo 0
ReDim a$(dcnt), abr$(dcnt)
sucker = 1: User selection, sucker
On Error GoTo erhandler_data
For i = 1 To dcnt
Read dta$
If Len(dta$) Then Read abr$(i)
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
On Error GoTo 0
MenuTop = my ''' This will need to be hanged.
MenuHeight = dcnt * (spacing + 1) - spacing + 2
MenuLeft = MenuLeft + MenuWidth - 2
action$ = "": mhl = 0
PCopy 0, 2
center_menu pop, a$(), dcnt, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing
Else ' Regular non-suckerfish menu choice.
b$ = LTrim$(Str$(j))
PCopy 1, 0: MenuOpen = 0: selection = 0
If sucker Then sucker = 0
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
_Title a$(j)
End If
Else
If curstyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow "LINK"
End If
Case "wheel", "key"
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
If mb = 2 Or lb = 2 Or b$ = Chr$(13) Then
b$ = LTrim$(Str$(j))
If sucker Then sucker = 0
PCopy 1, 0: MenuOpen = 0: selection = 0
_Title a$(j)
End If
End Select
End If
End Select
oldmy = my: oldmx = mx
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
If Len(LTrim$(a$(h))) Then
Print a$(h);
Else
Color MenuBdrFg, MenubrdBg
Locate , Pos(0) - 2: Print Chr$(195);
Print String$(MenuWidth - 2, Chr$(196)) + Chr$(180);
End If
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
Also, Mark, glad I could help. The DO/LOOP is self-exiting after a mouse cycle is completd. It is required to measure all states: 1 = Depress, -1 = Held Down, 2 = Released, 0 = Cycle completed. Yes, you could construct another method to achieve the same results but I'm not sure it would be simpiler and universally applicable.
Pete
Shoot first and shoot people who ask questions, later.
Posts: 376
Threads: 33
Joined: Jul 2022
Reputation:
27
@Bplus
very nice multiple button menu application!
We can say that Pete is a good debugger! He has catched the queue of mouse input bug in a glance!
@Pete
my 2nd example of menu is already a sukerfish menu but it uses a voice/item of menu to go back...
now here I post a version using as control the click out of the menu area...
It is still in working both for modularizing menu management both for getting a better mouse input control...
for now you can see menu flickering if you continue to click on the menu item for submenu (Menu2 and Menu3)!
I think that I need to use an array for menu data for a simpler management of the menu system and a more accurate gathering of the mouse input.
I'll try to do these improvements as soon as I have more time...
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/Menu3/4th/5th/6th/7th/8th/9th/"
Menu3$ = "3-1/3-2/3-3/3-4/3-5/3-6/3-7/3-8/3-9/"
item$ = ""
items2$ = ""
items3$ = ""
Do
Color _RGBA(6, 6, 127, 255), _RGBA(227, 55, 55, 255)
While _MouseInput: _PrintString (580, 300), " X" + Str$(_MouseX) + "/ Y" + Str$(_MouseY) + " " + "-" + item$ + Space$(8): Wend
Mx% = _MouseX
My% = _MouseY
mb% = _MouseButton(1)
If item2$ = "Menu3" Then
item3$ = ShowMenu$(Menu3$, 40 + (_FontWidth * 12 * 2), 20 + (_FontHeight * (a1% + a%)), Mx%, My%, mb%)
If mb% And item3$ = "" Then
item2$ = ""
mb% = 0
Line (40 + (_FontWidth * 12 * 2), 20 + (_FontHeight * a1%))-(40 + (_FontWidth * 12 * 3), 20 + (_FontHeight * (a% + a1% + b1%))), _RGBA(0, 0, 0, 255), BF
End If
ElseIf item$ = "Menu2" Then
item2$ = ShowMenu$(Menu2$, 40 + (_FontWidth * 12), 20 + (_FontHeight * a%), Mx%, My%, mb%)
a1% = Mx%
b1% = My%
If mb% And item2$ = "" Then
item$ = ""
mb% = 0
Line (40 + (_FontWidth * 12), 20 + (_FontHeight * a%))-(40 + (_FontWidth * 24), 20 + (_FontHeight * (a% + b%))), _RGBA(0, 0, 0, 255), BF
End If
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%)
ShowMenu$ = ""
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
![[Image: immagine-2024-12-27-021104902.png]](https://i.ibb.co/h9J9y6L/immagine-2024-12-27-021104902.png)
Posts: 2,328
Threads: 239
Joined: Apr 2022
Reputation:
120
01-01-2025, 02:03 AM
(This post was last modified: 01-01-2025, 08:15 PM by Pete.)
Well all the mechanics are done, I think. If anyone takes this for a spin and finds a glitch, please let me know; otherwise I need to convert to more variables to type variables (get rid of dim shared ), optimize it a bit, and maybe get some better variable/sub names. I usually rough out all my projects first, and refine them later.
So we have a main centered menu, a footer menu, and a drop open top menu with a couple of suckerfish examples.
Tomorrow I'm going to go through my archives, because I know about three years ago I made something very similar. It will be fun to see what is and is not in common in terms of coding methods.
Code: (Select All)
Dim Shared autokey$, MenuType$
Dim Shared pete, pop, style, curstyle
Type menu
top As Integer
height As Integer
left As Integer
width As Integer
oldtop As Integer
oldleft As Integer
oldwidth As Integer
End Type
Dim m As menu
Type color
MenuBdrFg As Integer
MenubrdBg As Integer
MenuSdwFg As Integer
MenuSdwBg As Integer
MenuFg As Integer
MenuBg As Integer
MenuHlFg As Integer
MenuHlBg As Integer
MenuAbr As Integer
MenuTopActiveFg As Integer
MenuTopActiveBg As Integer
MenuTopAbrFg As Integer
MenuTopAbrBg As Integer
MenuTopHlFg As Integer
MenuTopHlBg As Integer
LineFg As Integer
LineBg As Integer
PageFg As Integer
PageBg As Integer
End Type
Dim c As color
Width 80, 28
_Font 16
_ScreenMove _Middle
Do
ReDim MapHeading$(1), heading$(1), a$(1)
User MenuType$, spacing, curstyle, pop, selection, sucker
setup c, PageAltFg, PageAltBg
Color 1, 7: a$ = " File Edit View Search": Locate 1, 1
map_heading a$, heading$(), MapHeading$(), 0
Color 7, 1: a$ = "[F1] Help [Esc] Quit": Locate _Height, 1
map_heading a$, heading$(), MapHeading$(), 1
ReDim a$(1), abr$(1), sf(1)
MenuType$ = "display": data_reader m, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker
center_menu c, m, pop, a$(), abr$(), dcnt, spacing
MenuType$ = "": menu_main c, m, heading$(), MapHeading$(), spacing, curstyle, PageAltFg, PageAltBg
pete = 0
Loop
End
erhandler_data:
Cls
Print "Error: " + LTrim$(Str$(Err)) + " at line " + LTrim$(Str$(Erl)) + "."
Print "Incorrectly aligned data statements is the most likely cause."
End
Sub User (MenuType$, spacing, curstyle, pop, selection, sucker)
Static initiate
If initiate = 0 Then
initiate = 1
' User defined.............................
spacing = 0
curstyle = 1
pop = 1
'..........................................
End If
Select Case MenuType$
Case "display"
Restore menu_data
Case "header"
Select Case selection
Case 1: Restore data1
Case 2: Restore data2
Case 3: Restore data3
Case 4: Restore data4
End Select
Case "suckerfish"
Select Case sucker
Case 1: Restore suckerfish1
Case 2: Restore suckerfish2
Case 3: Restore suckerfish3
Case 4: Restore suckerfish4
End Select
Case "footer"
' Nothing to do here.
End Select
color_palette_data:
' Palette assignments 1-15.
Data 1,-1,2,-1,3,-1,4,-1,5,-1,6,63,7,-1,8,-1,9,-1,10,-1,11,-1,12,-1,13,-1,14,-1,15,-1: Rem Do not add to this data.
color_data:
Rem c.MenuBdrFg, c.MenubrdBg, c.MenuSdwFg, c.MenuSdwBg
Rem c.MenuFg, c.MenuBg, c.MenuHlFg, c.MenuHlBg, c.MenuAbr
Rem c.MenuTopActiveFg, c.MenuTopActiveBg, c.MenuTopAbrFg, c.MenuTopAbrBg
Rem c.MenuTopHlFg, c.MenuTopHlBg, c.LineFg, c.LineBg, c.PageFg, c.PageBg
Data 1,6,8,0
Data 0,6,15,1,1
Data 0,7,9,7
Data 15,0,14,1,9,1
Data -999: Rem eof
menu_data:
Data "1) Single-Space Display Menu",0
Data "2) Double-Space Display Menu",0
Data "3) Triple-Space Display Menu",0
Data "4) Toggle Block/Center Style",0
Data "5) Toggle Background",0
Data "6) Toggle Link Cursor On/Off",0
Data "7) Toggle Flat/Popup Window",0
Data eof
data1:
Data New,N,0,Open,O,0,Save,S,0,,Export,E,1,,Exit,x,0
Data eof
data2:
Data Undo,U,0,Redo,R,0,,Cut,0,0,Copy,0,0,Paste,0,0,Select All,0,0
Data eof
data3:
Data Subs...,S,0,Line Numbers,L,2,Compiler Warnings,C,0
Data eof
data4:
Data Find,F,0,Repeat Last Find,R,0,Change,C,0,,Clear Search History,H,0,,Quick Navigation,Q,0,Go To Line,G,0
Data eof
suckerfish1:
Data Hypertext,H,Rich Text,R,Code Block,C
Data eof
suckerfish2:
Data Show Line Numbers,L,Background Color,B,Show Separator,S
Data eof
suckerfish3:
Data
Data eof
suckerfish4:
Data
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 (c As color, PageAltFg, PageAltBg)
Restore color_palette_data
For i = 1 To 15
Read j, k
If k <> -1 Then Palette j, k
Next
Restore color_data
i = 0
Do
i = i + 1
Read j
If j = -999 Then Exit Do
Select Case i
Case 1: c.MenuBdrFg = j
Case 2: c.MenubrdBg = j
Case 3: c.MenuSdwFg = j
Case 4: c.MenuSdwBg = j
Case 5: c.MenuFg = j
Case 6: c.MenuBg = j
Case 7: c.MenuHlFg = j
Case 8: c.MenuHlBg = j
Case 9: c.MenuAbr = j
Case 10: c.MenuTopActiveFg = j
Case 11: c.MenuTopActiveBg = j
Case 12: c.MenuTopAbrFg = j
Case 13: c.MenuTopAbrBg = j
Case 14: c.MenuTopHlFg = j
Case 15: c.MenuTopHlBg = j
Case 16: c.LineFg = j
Case 17: c.LineBg = j
Case 18: c.PageFg = j
Case 19: c.PageBg = j
End Select
Loop
If PageAltFg + PageAltBk Then c.PageFg = PageAltFg: c.PageBg = PageAltBg
Color c.PageFg, c.PageBg
Cls
Color c.LineFg, c.LineBg
Locate 2, 1: Print String$(80, 196);
Locate _Height - 1, 1: Print String$(80, 196);
Color c.PageFg, c.PageBg
For i = 3 To _Height - 2
Locate i, 1: Print String$(80, 176);
Next
End Sub
Sub menu_main (c As color, m As menu, heading$(), MapHeading$(), spacing, curstyle, PageAltFg, PageAltBg)
Do
_Limit 30
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, alt%, clkcnt, drag, b$
menu_selection c, m, selection, spacing, pop, curstyle, my, mx, lb, mb, mw, alt%, b$, heading$(), MapHeading$(), a$(), PageAltFg, PageAltBg
If pete Then Exit Do
Loop
End Sub
Sub map_heading (heading$, heading$(), MapHeading$(), centering)
y = CsrLin: Locate y, 1: Print Space$(_Width);
Select Case centering
Case 0: Locate y, 1
Case Else: Locate y, _Width \ 2 - Len(heading$) \ 2 + 1
End Select
Print heading$;
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): ReDim _Preserve heading$(y)
MapHeading$(y) = map$: heading$(y) = heading$
End Sub
Sub data_reader (m As menu, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker)
Static sfTop()
User MenuType$, spacing, curstyle, pop, selection, sucker
On Error GoTo erhandler_data
dcnt = 0: ReDim a$(0), abr$(0)
Do
Read dta$
If dta$ = "eof" Or (_Height - 6 + pop) \ 2 <= (dcnt * (spacing + 1) + 1) \ 2 + pop Then Exit Do ' Data exceeds window max menu height.
dcnt = dcnt + 1
ReDim _Preserve abr$(dcnt)
If Len(dta$) Then
Read abr$(dcnt)
Else
abr$(dcnt) = "" ' Indicates a blank divider in the menu.
End If
If MenuType$ = "header" And Len(dta$) Then
ReDim _Preserve sf(dcnt) ' Only header type menus contain suckerfish option.
Read sf(dcnt)
If sf(dcnt) Then
ReDim sfTop(sf(dcnt)): sfTop(sf(dcnt)) = dcnt
dta$ = dta$ + " " + Chr$(26) ' Suckerfish id symbol.
End If
End If
ReDim _Preserve a$(dcnt): a$(dcnt) = dta$
If Len(dta$) > w Then w = Len(dta$) ' Look for greatest width.
Loop
On Error GoTo 0
For i = 1 To dcnt
temp$ = a$(i)
a$(i) = Space$(w)
Select Case style
Case 0: j = 1
Case 1: j = w \ 2 - Len(temp$) \ 2 + 1
End Select
If InStr(temp$, Chr$(26)) Then
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(26)) - 2)
Mid$(a$(i), Len(a$(i)), 1) = Chr$(26)
End If
Mid$(a$(i), j) = temp$
Next
m.height = dcnt * (spacing + 1) - spacing + 2
m.width = w + 4
If MenuType$ = "display" Then
m.top = _Height \ 2 - m.height \ 2 + 1
m.left = _Width \ 2 - m.width \ 2 + 1
Else
If sucker > 0 Then
m.top = MenuOpen + 1 + pop + sfTop(sucker) * (spacing + 1) - spacing - 1
m.left = m.oldleft + m.oldwidth - 1 ' 1-space overlap.
Else
m.top = MenuOpen + 1 + pop ' "header"
j = InStr(MapHeading$(MenuOpen), Chr$(96 + selection))
m.left = _InStrRev(" " + Mid$(MapHeading$(MenuOpen), 1, j), " ")
End If
End If
End Sub
Sub TopMenu (c As color, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice)
Static TopMenuAbbr$
If alt% Or b$ = Chr$(27) And altmenu Then
If altdown = 0 Then altmenu = 1 - altmenu: altdown = 1
Select Case altmenu
Case 1
GoSub highlight_top_menu
Case 0
GoSub unhighlight_top_menu
End Select
Else
altdown = 0
End If
Select Case b$
Case Chr$(0) + "P"
selection = TopMenuChoice
Case Chr$(0) + "K"
TopMenuChoice = TopMenuChoice - 1
If TopMenuChoice = 0 Then TopMenuChoice = Asc(Right$(RTrim$(MapHeading$(1)), 1)) - Asc(Left$(LTrim$(MapHeading$(1)), 1)) + 1
GoSub highlight_top_menu
Case Chr$(0) + "M"
TopMenuChoice = TopMenuChoice + 1
If TopMenuChoice > Asc(Right$(RTrim$(MapHeading$(1)), 1)) - Asc(Left$(LTrim$(MapHeading$(1)), 1)) + 1 Then TopMenuChoice = 1
GoSub highlight_top_menu
Case "a" To "z", "A", "Z"
If InStr(UCase$(TopMenuAbbr$), UCase$(b$)) Then
TopMenuChoice = InStr(UCase$(TopMenuAbbr$), UCase$(b$))
GoSub highlight_top_menu
selection = TopMenuChoice
End If
Case Chr$(27)
GoSub unhighlight_top_menu
b$ = ""
End Select
Exit Sub
highlight_top_menu:
If TopMenuChoice = 0 Then TopMenuChoice = 1
Color c.MenuTopActiveFg, c.MenuTopActiveBg: Locate 1, 1: Print heading$(CsrLin) + " ";: Locate 1, 1 ' Extra space is to mask out highlighted area.
i = Asc(Left$(LTrim$(MapHeading$(CsrLin)), 1))
Color c.MenuTopAbrFg, c.MenuTopAbrBg
TopMenuAbbr$ = "" ' Print different color letter abbreviation to open menu from keyboard.
Do
j = InStr(MapHeading$(CsrLin), Chr$(i))
If j = 0 Then Exit Do
i = i + 1
Locate , j
temp$ = Mid$(heading$(CsrLin), j, 1)
Print temp$;
TopMenuAbbr$ = TopMenuAbbr$ + temp$
Loop
temp$ = Chr$(TopMenuChoice + Asc(Left$(LTrim$(MapHeading$(CsrLin)), 1)) - 1) ' Find the menu in the top list. Ex: File Edit.
i = InStr(MapHeading$(CsrLin), temp$) - 1
j = _InStrRev(MapHeading$(CsrLin), temp$) - i + 2
Locate 1, i ' Print a highlighted block behind menu to be opened.
Color c.MenuTopHlFg, c.MenuTopHlBg: Print Mid$(heading$(CsrLin) + " ", i, j);
Return
unhighlight_top_menu:
Color 0, 7
Locate 1, 1: Print heading$(CsrLin) + " ";
Return
End Sub
Sub menu_selection (c As color, m As menu, selection, spacing, pop, curstyle, my, mx, lb, mb, mw, alt%, b$, heading$(), MapHeading$(), a$(), PageAltFg, PageAltBg)
Static MenuOpen, MouseField$, abr$(), sf(), sucker, oldmy, oldmx, mshow$, dcnt
Static mhl, oldmhl
Static oldselection, altmenu, altdown, TopMenuChoice
If MenuType$ = "" Then MenuType$ = "display": data_reader m, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker
Select Case MenuOpen
Case 0
If alt% Or altmenu <> 0 Then
If mhl Then ' Get rid of previous highlighted item if switching menus.
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice
If selection Then MenuOpen = 1: GoSub top_menu
Else
altdown = 0
End If
j = 0: selection = 0
If Len(MapHeading$(my)) And selection = 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
If altmenu Then ' Toggle menu highlighting off.
alt% = 1: TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice
altdown = 0 ' Force this here because the cycle hasn't gone back to the mouse sub yet.
End If
If mhl Then ' Get rid of previous highlighted item if switching menus.
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
selection = j ' The menu selected to be opened.
MenuOpen = my ' The row the selected menu occupies.
If MenuOpen = 1 Then ' IMPORTANT Change this to allow for top menu to be on a different row.
TopMenuChoice = selection
alt% = 1: TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice
End If
End If
Else ' Mouse pointer is at top or footer menu in a non-clickable area.
j = 0
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
GoSub check_top_menu_status
End If
Else ' Mouse pointer is not on top or footer menu.
GoSub check_top_menu_status
If MenuType$ = "display" Then
GoSub eval: If pete Then Exit Sub
Else ' For "header" type.
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
End If
If selection Then
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$ ' Remove link mouse appearance.
Select Case my
Case 1 ' Top menu.
GoSub top_menu ' Opens the selected top menu.
Case _Height ' The footer menu.
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$, ""
MenuOpen = 0: selection = 0 ' Needed to clear variables.
Case 2: System
End Select
End Select
End If
Case Else ' Menu is open.
GoSub eval: If pete Then Exit Sub
End Select
oldmy = my: oldmx = mx
Exit Sub
eval:
' Evaluate mouse field.
If my > m.top - pop And my < m.top - pop + m.height - 1 And mx > m.left - pop + 1 And mx < m.left - pop + m.width - 2 Then
MouseField$ = "mouse-in"
Else
MouseField$ = "mouse-out"
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
If oldmy And my <> oldmy Or oldmy And mx <> oldmx Then ' Only for header menus.
If Len(MapHeading$(MenuOpen)) And my = MenuOpen Then
j = Asc(Mid$(MapHeading$(MenuOpen), mx, 1)) - 96
GoSub slider ' Sliding mouse to open menus.
End If
End If
If lb <> 0 Or mb <> 0 Or mw <> 0 Or Len(b$) Then ' An event occured.
If lb = 2 Then
Select Case MouseField$
Case "mouse-in"
j = (my - m.top + pop + spacing) / (spacing + 1)
If j And Int(j) = j Then
If j <> mhl And Len(LTrim$(a$(j))) Then
GoSub menu_item_highlight
_Delay .25
End If
If MenuType$ = "display" Then
b$ = LTrim$(Str$(mhl))
Else ' "header"
j = mhl: GoSub menu_item_selected
End If
Else
If mhl Then
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
End If
Case "mouse-out"
GoSub closeit: If sucker = -1 Then GoSub top_menu
End Select
ElseIf mb Then
If mhl Then
If MenuType$ = "display" Then
b$ = LTrim$(Str$(mhl))
Else ' "header"
j = mhl: GoSub menu_item_selected
End If
End If
ElseIf mw Then
i = mw: GoSub next_menu_item
End If
If Len(b$) Then
Select Case MenuType$
Case "display"
Do
Select Case b$
Case Chr$(0) + "H"
i = -1: GoSub next_menu_item: b$ = ""
Case Chr$(0) + "P"
i = 1: GoSub next_menu_item: b$ = ""
Case "1": spacing = 0
Case "2": spacing = 1
Case "3": spacing = 2
Case "4": style = 1 - style
Case "5"
Select Case c.PageBg
Case 0: PageAltFg = c.PageFg: PageAltBg = 1
Case 1: PageAltFg = c.PageFg: PageAltBg = 0
End Select
Case "6"
curstyle = 1 - curstyle
If curstyle = 0 Then
If mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
End If
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$, ""
b$ = ""
Case Chr$(13)
If mhl Then b$ = LTrim$(Str$(mhl)): _Continue
Case Chr$(27): System
Case Else
b$ = ""
End Select
Exit Do
Loop
If Len(b$) Then pete = 1: mhl = 0
Case Else ' "header"
Select Case b$
Case Chr$(0) + "H"
i = -1: GoSub next_menu_item
Case Chr$(0) + "P"
i = 1: GoSub next_menu_item
Case Chr$(0) + "M" ' Enter alternative for suckerfish menu symbol.
If InStr(a$(mhl), Chr$(26)) Then
selection = TopMenuChoice ' Get the top menu number.
j = mhl: GoSub menu_item_selected ' Get the number of the item selected.
Else
j = TopMenuChoice + 1
If j > Asc(Right$(RTrim$(MapHeading$(1)), 1)) - Asc(Left$(LTrim$(MapHeading$(1)), 1)) + 1 Then j = 1
b$ = "": GoSub slider
End If
Case Chr$(0) + "K" ' Esc alternative for suckerfish menu.
If sucker > 0 Then
GoSub closeit: If sucker = -1 Then GoSub top_menu
Else
j = TopMenuChoice - 1
If j = 0 Then j = Asc(Right$(RTrim$(MapHeading$(1)), 1)) - Asc(Left$(LTrim$(MapHeading$(1)), 1)) + 1
b$ = "": GoSub slider
End If
Case Chr$(13)
selection = TopMenuChoice
j = mhl: GoSub menu_item_selected
Case Chr$(27)
GoSub closeit: If sucker = -1 Then GoSub top_menu
Case "a" To "z", "A", "Z"
For j = 1 To dcnt
If Len(abr$(j)) Then
If UCase$(abr$(j)) = UCase$(b$) Then
b$ = LTrim$(Str$(j))
GoSub menu_item_selected
Exit For
End If
End If
Next
End Select
End Select
End If
Else
If MouseField$ = "mouse-in" Then
If oldmy And my <> oldmy Or oldmy And mx <> oldmx Then
j = (my - m.top + pop + spacing) / (spacing + 1)
If j And Int(j) = j Then
If curstyle And mshow$ <> "LINK" Then mshow$ = "LINK": _MouseShow mshow$
If j <> mhl And Len(LTrim$(a$(j))) Then
GoSub menu_item_highlight
End If
Else
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
If mhl Then
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
End If
End If
End If
End If
Return
slider:
If j > 0 And j <> selection Then
mhl = 0: altmenu = 0: altdown = 0
selection = j ' Leave MenuOpen as is.
If sucker Then sucker = 0
PCopy 1, 0
TopMenuChoice = selection
MenuOpen = 1 ' The row the selected menu occupies.
alt% = 1: TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice
GoSub top_menu
End If
Return
check_top_menu_status:
If lb = 2 Or rb = 2 Or mb = 2 Then ' Mouse Event.
If altmenu Then ' Remove prep to open from top menu.
b$ = Chr$(27): TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoices
End If
End If
Return
top_menu:
MenuType$ = "header": data_reader m, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker
If sucker <> -1 Then
PCopy 0, 1
center_menu c, m, pop, a$(), abr$(), dcnt, spacing
Else
sucker = 0
End If
Return
menu_item_highlight:
s1 = CsrLin: s2 = Pos(0): c1 = _DefaultColor: c2 = _BackgroundColor
If mhl Then ' Unhighlight the previous menu item.
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1
show_menu_item c, mhl, a$(), abr$()
End If
Locate m.top - pop + j + (j - 1) * spacing, m.left - pop + 2 - 1
Color c.MenuHlFg, c.MenuHlBg
Print " " + a$(j) + " ";
Locate s1, s2: Color c1, c2: mhl = j ' Highlight current.
Return
next_menu_item:
j = mhl
Do
j = j + i: If j > UBound(a$) Or j < 1 Then j = 0: Exit Do
Loop Until Len(LTrim$(a$(j))) ' Bypass dividers.
If j Then GoSub menu_item_highlight
Return
suckerfish_menu:
oldmhl = mhl: m.oldtop = m.top: m.oldleft = m.left: m.oldwidth = m.width: oldselection = selection
MenuType$ = "suckerfish": data_reader m, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker
mhl = 0 ' Don't unhighlight the parent menu, but zeroing mhl here revents the child menu from being highlighted at the parent level when it opens.
PCopy 0, 2
center_menu c, m, pop, a$(), abr$(), dcnt, spacing
Return
menu_item_selected:
If sf(j) And sucker = 0 Then ' Open suckerfish menu.
sucker = sf(j)
GoSub suckerfish_menu
Else
sucker = 0 ' Selection was made so close both windows.
_Title a$(j)
GoSub closeit
MenuType$ = "display": data_reader m, MapHeading$(), a$(), abr$(), sf(), dcnt, MenuType$, MenuOpen, spacing, pop, selection, sucker
End If
If mhl Then ' Get rid of previous highlighted item if switching menus.
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
Return
closeit:
If sucker > 0 Then ' Closes suckerfish menu. Keeps parent menu open.
sucker = -1: PCopy 2, 0
m.left = m.oldleft
m.top = m.oldtop
mhl = oldmhl
selection = oldselection
Else
If MenuType$ = "display" Then
If mhl Then ' Get rid of previous highlighted item if switching menus.
Locate m.top - pop + mhl + (mhl - 1) * spacing, m.left - pop + 2 - 1: Color c.MenuFg, c.MenuBg: Print " " + a$(mhl) + " "; ' Unhighlight.
mhl = 0
End If
Else
PCopy 1, 0
End If
MenuOpen = 0: selection = 0: MouseField$ = "": mhl = 0
If sucker Then sucker = 0
If curstyle And mshow$ <> "DEFAULT" Then mshow$ = "DEFAULT": _MouseShow mshow$
b$ = Chr$(27): TopMenu c, b$, heading$(), MapHeading$(), alt%, altmenu, altdown, selection, TopMenuChoice
MenuType$ = "": TopMenuChoice = 0: altmenu = 0: altdown = 0
End If
Return
End Sub
Sub center_menu (c As color, m As menu, pop, a$(), abr$(), dcnt, spacing)
' Centers height evenly for odd window heights and 1-space towards top for even.
Locate m.top - pop, m.left - pop
For h = 1 To dcnt
If h = 1 Then
Color c.MenuBdrFg, c.MenubrdBg
Print Chr$(218) + String$(m.width - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To m.height - 2
If CsrLin < _Height Then Locate j, m.left - pop Else Locate , m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
Color c.MenuBdrFg, c.MenubrdBg: Print Space$(m.width - 2);
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(192) + String$(m.width - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color c.MenuSdwFg, c.MenuSdwBg ' Shadow below.
Locate CsrLin + 1, m.left - pop + 2
For i = 1 To m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate m.top - pop + 1 ' Shadow to the right.
For i = 1 To m.height - 1
Locate , m.left - pop + m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color c.MenuFg, c.MenuBg
Locate m.top - pop + h + (h - 1) * spacing, m.left - pop + 2 - 1
If Len(LTrim$(a$(h))) Then
show_menu_item c, h, a$(), abr$() ' Show each menu item in this for/next loop.
Else
Color c.MenuBdrFg, c.MenubrdBg
Locate , Pos(0) - 1: Print Chr$(195);
Print String$(m.width - 2, Chr$(196)) + Chr$(180);
End If
Next h
End Sub
Sub show_menu_item (c As color, counter, a$(), abr$())
j = InStr(a$(counter), abr$(counter))
If j Then ' Color coded short-cut key selection.
If j = 1 Then
Print " ";: Color c.MenuAbr, c.MenuBg: Print Left$(a$(counter), 1);: Color c.MenuFg, c.MenuBg: Print Mid$(a$(counter), 2); " ";
Else
Color c.MenuFg, c.MenuBg: Print " " + Mid$(a$(counter), 1, j - 1);: Color c.MenuAbr, c.MenuBg: Print Mid$(a$(counter), j, 1);: Color c.MenuFg, c.MenuBg: Print Mid$(a$(counter), j + 1); " ";
End If
Else ' Menu selection without short-cut key.
Color c.MenuFg, c.MenuBg: Print " " + a$(counter) + " ";
End If
End Sub
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, alt%, 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
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 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
Happy New TRUMP Year!
Pete
Posts: 376
Threads: 33
Joined: Jul 2022
Reputation:
27
@Pete
Wow a full menu system with all its variants!
Very impressive.
This cake is already ready to be eaten...
Happy New Year Friends
Posts: 4,085
Threads: 181
Joined: Apr 2022
Reputation:
232
Yes agreed, just the mouse and keyboard routine might be something valuable to look into when I have more time.
so +1 again to Pete in advance of what I expect to be very useful routine, I like the demo for its familiar look and function.
b = b + ...
Posts: 2,761
Threads: 332
Joined: Apr 2022
Reputation:
231
As long as you guys are all going gaga over menu systems, don't forget to take a look at Terry's menu library which he wrote back in the day here: https://qb64phoenix.com/forum/showthread.php?tid=83
Posts: 2,328
Threads: 239
Joined: Apr 2022
Reputation:
120
Terry's stuff is library oriented, which is what most of my newer stuff is tending toward. My Son just doesn't have the degree of interest in coding, but he can use libraries. It might come in handy some day. Who knows, maybe when I get too old to code... next Wednesday??? it will come in handy for me, too.
I got rid of the shared variables, but instead of posting or updating here, I started a new thread in the WIP section: https://qb64phoenix.com/forum/reputation.php?uid=19
Pete
- Screen Zero Hero Productions still alive and kicking in '25!
|
