9 hours ago
Code: (Select All)
_ScreenMove _Middle
_Font 16
Palette 7, 63
MenuWidth = 0
bgc1 = 9: bgc2 = 1 ' Background appearance.
While -1
Color 15, 1
Cls
Color 14, 1
Locate 2, 1: Print String$(80, 196);
Locate _Height - 1, 1: Print String$(80, 196);
Color bgc1, bgc2
For i = 3 To _Height - 2
Locate i, 1: Print String$(80, 176);
Next
Color 14, 1
Locate 1
text$ = "Menu Options"
Print center$(text$);
Locate _Height
text$ = "[F1] Help [Esc] Quit"
Print center$(text$);
Restore menu_data: dcnt = 0
Do
Read dta$
If dta$ = "eof" Then Exit Do
If _Height \ 2 <= (dcnt * (spacing + 1) + 1) \ 2 + pop Then Exit Do ' Data exceeds window max menu height.
dcnt = dcnt + 1
ReDim _Preserve a$(dcnt)
a$(dcnt) = dta$
If Len(a$(dcnt)) > MenuWidth - 4 Then
MenuWidth = Len(a$(dcnt)) + 4
MenuLeft = _Width \ 2 - Len(a$(dcnt)) \ 2 - 2 + 1
End If
Loop
MenuHeight = dcnt * (spacing + 1) - spacing + 2
MenuTop = _Height \ 2 - MenuHeight \ 2 + 1
Color 1, 7
center_menu style, pop, a$(), dcnt, x, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$
If lb = 2 Then
If my = _Height Then ' Special to footer menu.
If FooterMap$ = "" Then
For i = 1 To _Width
FooterMap$ = FooterMap$ + Chr$(Screen(_Height, i))
Next
End If
j = _InStrRev(Mid$(FooterMap$, 1, mx), "[")
If j Then
temp$ = Mid$(FooterMap$, j + 1)
b$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)
End If
Else
If my > MenuTop - pop And my < MenuTop - pop + MenuHeight - 1 And mx > MenuLeft - pop + 1 And mx < MenuLeft - pop + MenuWidth - 2 Then
j = (my - MenuTop + pop + spacing) / (spacing + 1)
If Int(j) = j Then
b$ = LTrim$(Str$(j))
End If
End If
End If
End If
Select Case b$
Case "1": spacing = 0
Case "2": spacing = 1
Case "3": spacing = 2
Case "4": style = 1 - style
Case "5"
Select Case bgc2
Case 0: bgc2 = 1
Case 1: bgc2 = 0
End Select
Case "6"
pop = 1 - pop
Case Chr$(0) + Chr$(59), "F1"
Restore help_data
Do
Read d$
If d$ = "eof" Then Exit Do
help$ = help$ + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + d$
Loop
_MessageBox " App Help", help$, ""
Case Chr$(27), "Esc": Exit While
End Select
If Len(b$) Then Exit Do
Loop
Wend
System
menu_data:
Data "1) Single-Space Display Menu"
Data "2) Double-Space Display Menu"
Data "3) Triple-Space Display Menu"
Data "4) Toggle Block/Center Style"
Data "5) Toggle Background Color"
Data "6) Toggle Flat/Popup Window"
Data eof
help_data:
Data This demo includes this
Data handy dandy help window
Data where we simply add data
Data statements to produce
Data then help text displayed
Data in this pop-up window.
Data eof
Function center$ (text$)
Locate , _Width \ 2 - Len(text$) \ 2 + 1
center$ = text$
End Function
Sub center_menu (style, pop, a$(), dcnt, x, 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 1, 7: 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 1, 7: Print Chr$(179);
Color 1, 7: Print Space$(MenuWidth - 2);
Color 1, 7: Print Chr$(179);
j = j + 1
Next
Locate j, MenuLeft - pop
Color 1, 7: Print Chr$(192) + String$(MenuWidth - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color 8, 1 ' 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 0, 7
Select Case style
Case 0: x = _Width \ 2 - Len(a$(h)) \ 2 + 1 - pop
Case 1: x = MenuLeft + 2 - pop
End Select
Locate MenuTop - pop + h + (h - 1) * spacing, x
Print a$(h);
Next h
End Sub
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$)
Static oldmy, oldmx, z1, hover, mwy, oldmwy
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Else
b$ = InKey$
End If
If z1 Then If Abs(Timer - z1) > .3 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
b_hover = 0
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
Exit For
End If
Next
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1
If z1 = 0 Then
z1 = Timer ' Let first click go through.
Else
clkcnt = clkcnt + 1
End If
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
oldmy = my: oldmx = mx
End Sub
I use a function to center text horizontally and a sub to center menu and contents. This is set up as a demo with working keys and mouse.