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.
Happy New TRUMP Year!
Pete
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