Yesterday, 06:14 PM
@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).
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
@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 SubAlso, 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.