Since I keep messing around with different combinations and using those to build up libraries, I'd thought I just post and update the popup menu stuff here.
Menu restrictions are a little harder to make universal, so I took them out for know. By restrictions I mean like the kind I use of a right click cut/copy/paste menu mutes the features that are not available like cut when nothing is highlighted, etc.
For this demo use the function keys to view the different examples and if you pick one, you can also right click the menu around the screen, just like to popups that use cut/copy/paste etc. in Windows apps.
The neat part is that it's very customizable. YOU can keep the shadow, ditch the shadow, change the colors, etc. all by changing the values in the User Defined Variables sub.
Hell, for fun I might even make an all graphics version. It all depends on how spiked the eggnog gets this season. Ho, ho, friggin' ho.
MAGA Christmas... and a G.O.P. Year!
Pete
Code: (Select All)
Width 90, 35: _Font 16
_ScreenMove 200, 20
Dim Shared MenuModel: MenuModel = 1
Type TextVar
HardwareMenus As Integer ' 0 or 1.
FormStyle As Integer
InptMthd As Integer ' 2 is for creating an input field when csrlin is activated by mouse or keyboard.
mt As Integer
mr As Integer
mb As Integer
ml As Integer
bsTop As Integer
bsRight As Integer
bsBottom As Integer
bsLeft As Integer
noe As Integer
nol As Integer
scr As Integer
oldscr As Integer
wide As Integer
tall As Integer
fw As Integer
fh As Integer
redisplay As Integer
hl As Integer
HlFind As Integer
ScreenEstablished As Integer
ScrnResize As Integer
ScrnResizeW As Integer
ScrnResizeH As Integer
ScrnResizeInputRow As Integer
ScrnResizeInputCol As Integer
RollupEvent As Integer
RollupStatus As Integer
HoldScr As Integer
persistency As Integer ' 1 or 0
UseDefaultDisplay As Integer ' 1 or 0
InputActive As Integer ' Records cursor row.
FieldIndent As Integer ' 0 whole text. 1 Input field only for text after prefix (Ex URL:_________).
redo As Integer
undo As Integer
RedoText As String
UndoText As String
MarkerOn As Integer
marker As Integer
EncodeOn As Integer
remakeIDX As Integer
hideshow As String
AddDelete As Integer ' 1 Add, -1 Delete, or 0 inactive.
OpenInput As Integer ' 1 Open input line pase colon or 2 Open entire input line.
hgltPos1 As Integer
hwUnderlineShow As Integer
hwUnderlineImage As Long
End Type
Dim t As TextVar
Type InputVar
CurStyle As Integer
CurShow As Integer
fld As Integer
mtop As Integer
mleft As Integer
myclose As Integer
mxclose As Integer
hwFieldPresent As Integer
hwFieldFront As Long
hwFieldBack As Long
hwFieldHlMargin As Long
End Type
Dim in As InputVar
Type PopupVar
ForceInitiate As Integer
Show As Integer ' 0 or 1.
hwWindow As Long
mwidth As Integer
mheight As Integer
FixMenuT As Integer
FixMenuL As Integer
MenuT As Integer
MenuB As Integer
MenuL As Integer
MenuR As Integer
MenuHL As Integer
MarginRt As Integer
BoundsLt As Integer
BoundsRt As Integer
Shadow As Integer ' 0 or 1.
VSpacing As Integer
Choice As Integer
End Type
Dim pop As PopupVar
Type MouseVar
x As Integer
y As Integer
lb As Integer
rb As Integer
mb As Integer
mw As Integer
clkcnt As Integer
caps As Integer
shift As Integer
ctrl As Integer
alt As Integer
prevx As Integer
prevy As Integer
drag As Integer
sbar As Integer
sbRow As Integer
oldsbRow As Integer
ThumbTop As Integer
ThumbSize As Integer
ThumbDrag As Integer
autokey As String
End Type
Dim m As MouseVar
Type ColorVar
pal1 As Integer
pal2 As Integer
pal3 As Integer
pal4 As Integer
PageColor As Integer
SkinFrg As Integer
SkinBkg As Integer
InputFrg As Integer
InputFrg2 As Integer
InputBkg As Integer
InputHl As Integer
InputH2 As Integer
SkinShadowFrg As Integer
SkinShadowBkg As Integer
PopupFrg As Integer
PopupBkg As Integer
PopupUnavail As Integer
PopupShadowFrg As Integer
PopupShadowBkg As Integer
End Type
Dim c As ColorVar
Color 7, 1: Cls
User_Defined_Variables t, pop, c
GoSub Menu
Do
_Limit 60
If m.rb = -1 Then pop.Show = 1: MenuModel = -1: getmenu = 1
Mouse_Keyboard m, b$
If Len(b$) Then
If Mid$(b$, 2, 1) >= Chr$(59) And Mid$(b$, 2, 1) <= Chr$(66) Then getmenu = 1: MenuModel = 1 Else getmenu = 0
Select Case b$
Case Chr$(0) + Chr$(59): t.HardwareMenus = 0: pop.VSpacing = -1
Case Chr$(0) + Chr$(60): t.HardwareMenus = 0: pop.VSpacing = -2
Case Chr$(0) + Chr$(61): t.HardwareMenus = 0: pop.VSpacing = 1
Case Chr$(0) + Chr$(62): t.HardwareMenus = 0: pop.VSpacing = 2
Case Chr$(0) + Chr$(63): t.HardwareMenus = 1: pop.VSpacing = -1
Case Chr$(0) + Chr$(64): t.HardwareMenus = 1: pop.VSpacing = -2
Case Chr$(0) + Chr$(65): t.HardwareMenus = 1: pop.VSpacing = 1
Case Chr$(0) + Chr$(66): t.HardwareMenus = 1: pop.VSpacing = 2
Case Chr$(27): System
End Select
End If
If getmenu Then getmenu = 0: pop.Show = -1: GoSub Menu: pop.ForceInitiate = 1
Popup_Menu t, in, pop, m, c, b$
_Display
Loop
Menu:
Color 15, 1: Cls
Locate 2, 2
Print "Press F1 for a Single-Spaced No Lines Popup Menu"
Locate 3, 2
Print "Press F2 for a Double-Spaced No Lines Popup Menu"
Locate 4, 2
Print "Press F3 for a Single-Spaced Lined Popup Menu"
Locate 5, 2
Print "Press F4 for a Double-Spaced Lined Popup Menu"
Locate 6, 2
Print "Press F5 for a Single-Spaced No Lines Hardware Popup Menu"
Locate 7, 2
Print "Press F6 for a Double-Spaced No Lines Hardware Popup Menu"
Locate 8, 2
Print "Press F7 for a Single-Spaced Lined Hardware Popup Menu"
Locate 9, 2
Print "Press F8 for a Double-Spaced Lined Hardware Popup Menu"
Print
Color 1, 3
For i = 1 To 22
Print String$(_Width, Chr$(177))
Next
Color 15, 1
Return
Sub User_Defined_Variables (t As TextVar, pop As PopupVar, c As ColorVar)
t.ml = 1: t.mr = _Width: t.mt = 1: t.mb = _Height
t.HardwareMenus = 1 ' Hardware Acceleration On. Used for Menus and requires _DISPLAY to be placed in calling loop.
pop.FixMenuT = 13
pop.FixMenuL = 10
pop.MarginRt = 4 ' Margin from right side if popup. Popup elements will be limited to this point of indentation.
pop.BoundsLt = 0 ' Popup will not appear further left than this indent value measured as the distance away from the left border of the parent window.
pop.BoundsRt = 0 ' Popup and shadow, if present, will not appear further right than this indent value measured as the distance away from the right border of the parent window.
pop.VSpacing = 2 ' 1 single space with dividers (if harware images on), -1 single space no dividers, 2 double space with dividers, -2 double space no dividers.
pop.Shadow = 1 ' 1 for present or 0 for absent.
c.PageColor = 5 ' _BackgroundColor
c.SkinFrg = 3
c.SkinBkg = 5
c.SkinShadowFrg = 8
c.SkinShadowBkg = 0
c.InputFrg = 0 ' Use 15 for bright white if a black input field background is wanted.
c.InputFrg2 = 6
c.InputBkg = c.PageColor ' Same as page color. Use with hardware highlighting, otherwise use 0 to create a black input field.
c.InputHl = 15
c.InputH2 = 6
c.PopupFrg = 0 ' Available menu item.
c.PopupBkg = 5 ' Popup background. (Same as c.SkinBkg)
c.PopupUnavail = 7 ' Unavailable menu item.
c.PopupShadowBkg = 2 ' Shadow. (Ignore if not present).
c.PopupShadowFrg = 7 ' Characters under shadow.
c.pal1 = 34
c.pal2 = 17
c.pal3 = 63
c.pal4 = 56
Palette c.InputFrg2, c.pal2
Palette c.SkinBkg, c.pal3
Palette c.PopupShadowBkg, c.pal4
MyFormData: ' Name column, name, input row, input column, input length, max length, initial text. Note eof must be lowercase.
Data 3,"Field 1:",2,12,44,250,""
Data 3,"Field 2:",5,12,44,250,""
Data eof
PopupMenuData: ' eof must be lowercase.
Data Pete's tremendous! While Steve's just amazing.
Data Four score and 7 years ago was a good time to get out of Germany.
Data The rain in Spain falls mainly on the Hispanic People.
Data "The rain in California falls mainy on the Hispanic people, too."
Data You can't make Halloween fun without breaking a few eggs.
Data What do you get when you cross an elephant with a rhino? Elephino!
Data "When life gives you lemons, make lemonaid."
Data "When life gives you crap, does juicing it really help?"
Data eof
End Sub
Sub Mouse_Keyboard (m As MouseVar, b$)
Static z1
If Len(m.autokey) Then
b$ = Mid$(m.autokey + ",", 1, InStr(m.autokey$ + ",", ",") - 1)
m.autokey = Mid$(m.autokey, InStr(m.autokey$ + ",", ",") + 1) ' Don't add "," tomid$() portion or the last key will always be a comma.
Else
b$ = InKey$
End If
m.prevx = m.x: m.prevy = m.y
If m.mw Then m.mw = 0
While _MouseInput
m.mw = m.mw + _MouseWheel: If m.mw Then m.mw = m.mw \ Abs(m.mw) ' Limit to 1 or -1 for up or down.
Wend
m.x = _MouseX
m.y = _MouseY
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: m.clkcnt = 0
Select Case m.lb
Case 2: m.lb = 0 ' Click cycle completed.
Case 1: If _MouseButton(1) = 0 Then m.lb = 2: m.drag = 0: m.ThumbDrag = 0 ' Button released.
Case -1: m.lb = 1 ' Button held down.
Case 0: m.lb = _MouseButton(1)
End Select
Select Case m.rb
Case 2: m.rb = 0 ' Click cycle completed.
Case 1: If _MouseButton(2) = 0 Then m.rb = 2 ' Button released.
Case -1: m.rb = 1 ' Button held down.
Case 0: m.rb = _MouseButton(2)
End Select
Select Case m.mb
Case 2: m.mb = 0 ' Click cycle completed.
Case 1: If _MouseButton(3) = 0 Then m.mb = 2 ' Button released.
Case -1: m.mb = 1 ' Button held down.
Case 0: m.mb = _MouseButton(3)
End Select
If Abs(m.lb) = 1 Then
If m.lb = -1 Then z1 = Timer: m.clkcnt = m.clkcnt + 1
If m.prevx And m.prevx <> m.x Or m.prevy And m.prevy <> m.y Then
If m.x <> m.prevx Then m.drag = Sgn(m.x - m.prevx) ' Prevent zero which can occur if mouse moves off row when being draged horizontally.
End If
End If
If _KeyDown(100301) Then m.caps = -1 Else If m.caps Then m.caps = 0
If _KeyDown(100303) Or _KeyDown(100304) Then m.shift = -1 Else If m.shift Then m.shift = 0
If _KeyDown(100305) Or _KeyDown(100306) Then m.ctrl = -1 Else If m.ctrl Then m.ctrl = 0
If _KeyDown(100307) Or _KeyDown(100308) Then m.alt = -1 Else If m.alt Then m.alt = 0
End Sub
Sub Popup_Menu (t As TextVar, in As InputVar, pop As PopupVar, m As MouseVar, c As ColorVar, b$)
If pop.Show = 0 Then Exit Sub '===================>
Static initiate, nomi, oldmy, myalt
Static menu$(), menu_restrict(), y, x, atmp As String
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
If pop.ForceInitiate Then initiate = 0
If initiate = 0 Then
If t.ml = 0 Or t.mr = 0 Or t.mt = 0 Or t.mb = 0 Then
_MessageBox "Configuration Error", "The required variables (t.mt, t.mr, t.mb, and t.ml must be set and passed to this routine to open the popup window.", "error"
System
End If
initiate = 1
in.CurShow = 0: Locate , , in.CurShow ' Hide cursor
nomi = 0: oldmy = 0: myalt = 0: pop.MenuHL = 0
pop.hwWindow = 0: pop.Show = 0
If t.fw = 0 Then t.fw = _FontWidth: t.fh = _FontHeight
Restore PopupMenuData
Do
Read tmp$
If tmp$ = "eof" Then Exit Do
nomi = nomi + 1
ReDim _Preserve menu$(nomi)
menu$(nomi) = tmp$
ReDim menu_restrict(nomi) ' Restrictions.
y = CsrLin: x = Pos(0)
Loop
End If
Do
If t.ScrnResize Then Exit Do ' Force popup to close when resizing app.
mxalt = 0
If b$ = Chr$(0) + "H" Or m.mw = -1 Then
If (pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing) > 1 Then
myalt = pop.MenuHL - Abs(pop.VSpacing): mxalt = -1
End If
ElseIf b$ = Chr$(0) + "P" Or m.mw = 1 Then
If pop.MenuHL = 0 Then
myalt = pop.MenuT + 1: mxalt = -1
Else
If (pop.MenuHL - pop.MenuT + 1) \ Abs(pop.VSpacing) < nomi + Abs(Abs(pop.VSpacing) - 2) Then
myalt = pop.MenuHL + Abs(pop.VSpacing): mxalt = -1
End If
End If
ElseIf b$ = Chr$(13) And pop.MenuHL Or m.mb = 2 Then
If menu_restrict((pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)) = 0 Then
pop.Choice = (pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)
Exit Do
End If
End If
Select Case pop.Show
Case 0, -1 ' Open popup. Note: -1 is used when call comes outside mousebutton event. If inside, just call this sub and zero opens popup.
For i = 1 To nomi
j = Len(menu$(i))
If j > k Then k = j
Next
pop.mwidth = k + pop.MarginRt ' Variable to determine margin spaces from the right of menu.
pop.mheight = nomi * Abs(pop.VSpacing) + 1 ' Add one for the separate border element.
Select Case MenuModel
Case Is > 0 ' Fixed menu to left.
pop.MenuT = pop.FixMenuT: pop.MenuL = pop.FixMenuL: pop.MenuR = pop.MenuL + pop.mwidth: pop.MenuB = pop.MenuT + pop.mheight
Case Is < 0 ' Movable menu.
While _MouseInput: Wend
pop.MenuT = _MouseY + 1 ' One below input line.
pop.MenuL = _MouseX
If pop.MenuT + pop.mheight >= _Height Then pop.MenuT = _Height - pop.mheight - pop.Shadow
If pop.MenuL + pop.mwidth >= t.mr - pop.Shadow Then
pop.MenuL = t.mr - pop.mwidth - pop.BoundsRt - pop.Shadow
ElseIf pop.MenuL <= pop.BoundsLt Then
pop.MenuL = t.ml - 1 + pop.BoundsLt
End If
pop.MenuR = pop.MenuL + pop.mwidth: pop.MenuB = pop.MenuT + pop.mheight
End Select
pop.Show = 1 ' Identifies the menu is open.
PCopy 0, 1
If t.HardwareMenus Then
If pop.hwWindow = 0 Then
vs = (Abs(Abs(pop.VSpacing) - 2)) ' Equals 1 for single space and 0 for double space.
hWth = t.fw \ 2
hHgt = t.fh \ 2
t1 = _NewImage((pop.mwidth + 2) * t.fw, nomi * 3 * t.fh, 32)
_Dest t1
' top bottom left right (mask)
Line (hWth + 1, 0)-(pop.mwidth * t.fw - hWth, hHgt), _RGB32(255, 255, 255), BF
Line (hWth + 1, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - t.fh)-(pop.mwidth * t.fw - hWth, ((i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - t.fh + hHgt)), _RGB32(255, 255, 255), BF
Line (hWth + 1, 0)-(t.fw, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh), _RGB32(255, 255, 255), BF
Line (pop.mwidth * t.fw - hWth, 0)-(pop.mwidth * t.fw - t.fw, (pop.MenuB - pop.MenuT - (Abs(pop.VSpacing) - 1)) * t.fh), _RGB32(255, 255, 255), BF
If pop.VSpacing > 0 Then
For i = 0 To nomi
If i > 0 And i < nomi Or vs Then
Line (hWth, (i + .5 * vs) * Abs(pop.VSpacing) * t.fh)-(pop.mwidth * t.fw - hWth, (i + .5 * vs) * Abs(pop.VSpacing) * t.fh), _RGB32(0, 0, 0, 32), B
End If
Next
End If
If vs And pop.VSpacing = 1 Then ' Redo right and left mask over divider lines so they do not extend to the edges.
Line (hWth + 1, 0)-(t.fw, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh), _RGB32(255, 255, 255), BF
Line (pop.mwidth * t.fw - hWth, 0)-(pop.mwidth * t.fw - t.fw, (pop.MenuB - pop.MenuT - (Abs(pop.VSpacing) - 1)) * t.fh), _RGB32(255, 255, 255), BF
End If
' top bottom left right (outer border)
Line (hWth, 0)-(pop.mwidth * t.fw - hWth, 0), _RGB32(0, 0, 0, 32), B
Line (t.fw * .5, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh)-((pop.mwidth * t.fw - hWth), (i - 1 + vs) * Abs(pop.VSpacing) * t.fh), _RGB32(0, 0, 0, 32), B
Line (hWth, 0)-(hWth, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh), _RGB32(0, 0, 0, 32), B
Line (pop.mwidth * t.fw - hWth, 0)-(pop.mwidth * t.fw - hWth, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh), _RGB32(0, 0, 0, 32), B
j = 2 ' Make shadow 2 units smaller than font height and width.
Line (pop.mwidth * t.fw - hWth + 1, hHgt)-((pop.mwidth) * t.fw + hWth - j, (pop.MenuB - pop.MenuT + vs) * t.fh - hHgt - j), _RGB32(0, 0, 0, 128), BF
Line (t.fw * 1.5, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + 1)-((pop.mwidth * t.fw - hWth), (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - j), _RGB32(0, 0, 0, 128), BF
pop.hwWindow = _CopyImage(t1, 33)
_FreeImage t1
_Dest 0
End If
Locate pop.MenuT + 1, pop.MenuL
For i = 1 To pop.mheight - 2
Color c.PopupFrg, c.PopupBkg: Locate , pop.MenuL + 1
Print Space$(pop.mwidth - 2)
Next
Else
Locate pop.MenuT, pop.MenuL
Color c.PopupFrg, c.PopupBkg
Print Chr$(218) + String$(pop.mwidth - 2, 196) + Chr$(191)
For i = 1 To pop.mheight - Abs(pop.VSpacing)
Color c.PopupFrg, c.PopupBkg: Locate , pop.MenuL
Print Chr$(179); Space$(pop.mwidth - 2) + Chr$(179);
Color c.PopupShadowBkg, c.PopupShadowFrg: Print Chr$(Screen(CsrLin, Pos(0))) + Chr$(Screen(CsrLin, Pos(0) + 1))
Next
Color c.PopupFrg, c.PopupBkg: Locate , pop.MenuL
Print Chr$(192) + String$(pop.mwidth - 2, 196) + Chr$(217);
Color c.PopupShadowBkg, c.PopupShadowFrg: Print Chr$(Screen(CsrLin, Pos(0))) + Chr$(Screen(CsrLin, Pos(0) + 1))
Locate , pop.MenuL + 2
For i = 1 To pop.mwidth
Print Chr$(Screen(CsrLin, Pos(0)));
Next
End If
Locate pop.MenuT + 2, pop.MenuL + 2
For i = 0 To nomi - 1
Locate pop.MenuT + 1 + i * Abs(pop.VSpacing), pop.MenuL + 1
If menu_restrict(i + 1) Then Color c.PopupUnavail, c.PopupBkg Else Color c.PopupFrg, c.PopupBkg
atmp = Space$(pop.mwidth - 2)
Mid$(atmp, 2) = menu$(i + 1)
Print atmp
Color c.PopupFrg, c.PopupBkg
Locate , pop.MenuL
If t.HardwareMenus = 0 And pop.VSpacing = 2 Then
If i + 1 < nomi Then Print "Ã" + String$(pop.mwidth - 2, Chr$(196)) + "´";
End If
Next
Case 1 ' Popup is present.
If m.rb = -1 Then
If m.y < pop.MenuT Or m.y > pop.MenuB Or m.x < pop.MenuL Or m.x > pop.MenuR Then
Exit Do ' Right click outside popup reopens and moves popup on next sub call when right button = 2.
End If
End If
If mxalt = 0 Then myalt = m.y: mxalt = m.x
i = myalt > pop.MenuT And myalt < pop.MenuB And mxalt > pop.MenuL And mxalt < pop.MenuR
If i Or mxalt = -1 Then
Select Case Abs(pop.VSpacing)
Case 1
i = myalt <> oldmy
Case 2
i = (myalt - pop.MenuT) \ Abs(pop.VSpacing) <> (myalt - pop.MenuT) / Abs(pop.VSpacing) And myalt <> oldmy
End Select
If i Or mxalt = -1 Then ' Works for odd or even number top margins.
If pop.MenuHL Then ' Remove highlighting from previous hover.
atmp = Space$(pop.mwidth - 2)
Mid$(atmp, 2, Len(menu$((pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)))) = menu$((pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing))
Locate pop.MenuHL, pop.MenuL + 2 - 1
If menu_restrict((pop.MenuHL - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)) Then Color c.PopupUnavail, c.PopupBkg Else Color c.PopupFrg, c.PopupBkg
Print atmp
End If
atmp = Space$(pop.mwidth - 2)
Mid$(atmp, 2, Len(menu$((myalt - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)))) = menu$((myalt - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing))
Locate myalt, pop.MenuL + 2 - 1
If menu_restrict((myalt - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)) Then Color c.PopupBkg, c.PopupUnavail Else Color c.PopupBkg, c.PopupFrg
Print atmp;
Color c.PopupFrg, c.PopupBkg
pop.MenuHL = myalt
oldmy = m.y
End If
If m.lb = 2 Then
If menu_restrict((myalt - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)) = 0 Then
pop.Choice = (myalt - pop.MenuT + Abs(pop.VSpacing) - 1) \ Abs(pop.VSpacing)
Exit Do
End If
End If
Else
' Toggle close popup menu.
If m.lb = 1 Then
If m.y > pop.MenuT Or m.y < pop.MenuB Or m.x > pop.MenuR Or m.x < pop.MenuL Then Exit Do
End If
End If
If Len(b$) Then
'-----------------------------------------------------------------------------------------------------------
' Valid menu shortcut key list here.
Select Case b$
Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): m.autokey = b$: b$ = "": Exit Do
Case Chr$(27): pop.Show = 0: b$ = "": Exit Do ' Simply close popup.
End Select
End If
End Select
If t.HardwareMenus Then _PutImage ((pop.MenuL - 1) * t.fw, (pop.MenuT - 1) * t.fh + t.fh \ 2), pop.hwWindow
pop.ForceInitiate = 0
Locate y, x
Exit Sub ' -------------------------------------------------------->
Loop ' Loop is exited when popup is closed; otherwise we exit the sub from the statement above.
pop.Show = 0
PCopy 1, 0
Color restore_color1, restore_color2
Locate y, x
If b$ = Chr$(27) Then b$ = "" ' Negate b$ so an esc routine will not be preformed in the next subroutine before relooping to the mouse call.
_KeyClear
initiate = 0
Locate _Height - 1, 1: Color 15, 1: Print Space$(_Width);
Locate _Height - 1, 2: Print menu$(pop.Choice);
End SubMenu restrictions are a little harder to make universal, so I took them out for know. By restrictions I mean like the kind I use of a right click cut/copy/paste menu mutes the features that are not available like cut when nothing is highlighted, etc.
For this demo use the function keys to view the different examples and if you pick one, you can also right click the menu around the screen, just like to popups that use cut/copy/paste etc. in Windows apps.
The neat part is that it's very customizable. YOU can keep the shadow, ditch the shadow, change the colors, etc. all by changing the values in the User Defined Variables sub.
Hell, for fun I might even make an all graphics version. It all depends on how spiked the eggnog gets this season. Ho, ho, friggin' ho.
MAGA Christmas... and a G.O.P. Year!
Pete