01-11-2026, 02:26 AM
Well I probably shouldn't code while watching the playoffs, but...
So universal shortcut keys now function with a menu open, but I also want to add all keys in all menus when they are all closed.
Pete
Code: (Select All)
$Resize:On
_ScreenMove 200, 20
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
ScrnW As Integer
ScrnH As Integer
ScrnResize As Integer
ScrnResizeMinW As Integer
ScrnResizeMinH 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 ' Number of window to show.
CloseReOpen As Integer ' Number of window to show after previous window gets closed.
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
ChoiceName As String
MenuBar As String
MenuBarLt As String
MenuBarRt As String
MenuBarRow As Integer
MenuModel 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
AltSwitch 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
PopupMenuBarFrg As Integer
PopupMenuBarBkg As Integer
FixedMenuFrg As Integer
FixedMenuBkg As Integer
FixedMenuHlFrg As Integer
FixedMenuHlBkg As Integer
FixedMenuScFrg As Integer
End Type
Dim c As ColorVar
Color 7, 1: Cls
User_Defined_Variables t, pop, c
ReDim text$(1)
Do
_Limit 60
ScreenSize t, c
control t, in, pop, m, b$, text$()
Mouse_Keyboard m, b$
Menu_Bar t, pop, m, c, b$
Popup_Menu t, in, pop, m, c, b$, text$()
_Display
Loop Until pop.Show = 0 And b$ = Chr$(27)
System
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.
t.ScrnW = 90
t.ScrnH = 36
t.ScrnResizeMinW = 80
t.ScrnResizeMinH = 30
pop.MenuBarRow = 1
pop.MenuBarLt = " File Edit View Search"
pop.MenuBarRt = "Help "
pop.FixMenuT = 15
pop.FixMenuL = 11
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 = 1 ' Background color of the page.
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.PopupMenuBarFrg = 0
c.PopupMenuBarBkg = 7
c.FixedMenuFrg = 0
c.FixedMenuBkg = 7
c.FixedMenuHlFrg = 7
c.FixedMenuHlBkg = 0
c.FixedMenuScFrg = 15
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
RtClkPopupData1: ' eof must be lowercase.
Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear.......Delete,Select All..Ctrl+A
Data Close..........Esc,eof
RtClkPopupData2: ' eof must be lowercase.
Data "I only code in QB64 Phoenix, the only BASIC language I need!"
Data "I only code in SCREEN 0 because everthing else is too graphic."
Data "I like to code in FreeBasic, but I hate myself in the morning."
Data "If AI becomes a singularity, QB64 will finally get TYPE arrays."
Data "Typing skills used to be all female related, so why is coding not?"
Data "Good coders copy. Great coders get good coders to code for them."
Data "An ounce of prevention... is Steve's used condom."
Data "We we're doing so well until Pete's mind fell back in the gutter."
Data eof
PopupMenuBarData1:
Data Open......Ctrl+O
Data Save......Ctrl+S
Data Save As...Ctrl+A
Data Exit
Data eof
PopupMenuBarData2:
Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear.......Delete,Select All..Ctrl+A
Data Close..........Esc,eof
Data eof
PopupMenuBarData3:
Data Subs....................F2
Data Line Numbers............F4
Data Compiler Warnings...Ctrl+W
Data eof
PopupMenuBarData4:
Data Find...................Ctrl+F3
Data Repeat Last Find......Shift+F3
Data Change..................Alt+F3
Data Clear Search History....Alt+Lt
Data Add / Remove Bookmark...Alt+Rt
Data Previous Bookmark.......Alt+Dn
Data Go To Line..............Ctrl+G
Data eof
PopupMenuBarData5:
Data View...Shift+F1
Data About...Shift+A
Data eof
PopupMenuBarData6:
Data eof
PopupMenuBarData7:
Data eof
PopupMenuBarData8:
Data eof
PopupMenuBarData9:
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
If m.AltSwitch = 4 Then m.AltSwitch = 0 ' Cycle complete.
Select Case m.alt
Case _TRUE
If m.AltSwitch = 0 Then m.AltSwitch = 1 Else If m.AltSwitch = 2 Then m.AltSwitch = 3
Case Else
If m.AltSwitch = 1 Then m.AltSwitch = 2 Else If m.AltSwitch = 3 Then m.AltSwitch = 4
End Select
End Sub
Sub Menu_Bar (t As TextVar, pop As PopupVar, m As MouseVar, c As ColorVar, b$)
If Len(pop.MenuBarLt) + Len(pop.MenuBarRt) = 0 Then Exit Sub
Static initiate, altmx, oldmy, oldmx, pcopyhack, AltBlocker, AltException, map$, shortcut$
y = CsrLin: x = Pos(0)
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
If pcopyhack Then i = Abs(pcopyhack): md = 3: GoSub Redo_Menu_Bar: pcopyhack = 0
If pop.MenuModel < 0 Then
If pop.Choice And m.alt Then AltBlocker = 1
If AltException = 0 Then altmx = 0: m.AltSwitch = 0 Else AltException = 0
End If
If initiate = 0 Or t.ScrnResize = 2 Then
initiate = 1
If pop.MenuBarRow = 0 Then pop.MenuBarRow = 1 ' Default
Color c.PopupMenuBarFrg, c.PopupMenuBarBkg
Locate pop.MenuBarRow, 1: Print Space$(_Width);
Locate pop.MenuBarRow, 1
pop.MenuBar = Space$(_Width)
Mid$(pop.MenuBar, 1) = pop.MenuBarLt
If _Width > Len(RTrim$(pop.MenuBar)) + 3 + Len(pop.MenuBarRt) Then Mid$(pop.MenuBar, Len(pop.MenuBar) - Len(pop.MenuBarRt)) = pop.MenuBarRt
Print pop.MenuBar;
map$ = "": j = 0: k = 0
For i = 1 To _Width
If Mid$(pop.MenuBar, i, 1) <> " " Then
If k = 0 Then shortcut$ = shortcut$ + Mid$(pop.MenuBar, i, 1)
n$ = LTrim$(Str$(j + 1)): k = 1
Else
If k Then j = j + 1: k = 0
n$ = " "
End If
map$ = map$ + n$
Next
oldmy = m.y: oldmx = m.x ' Set so never zero.
Locate y, x
End If
i = 0
If AltBlocker = 0 Then
Select Case m.AltSwitch
Case 1
If pop.Show = 0 Then md = 1: GoSub Redo_Menu_Bar
Case 2
If pop.Show = 0 Then
md = 2
' Initial alt release. Menu bar is highlighted.
If altmx = 0 Then altmx = InStr(map$, "1"): b$ = "Menu" Else If pop.Show Then GoSub Close_Pseudo_Menu
End If
Case 3
Case 4
If altmx < 0 Then ' Alt pressed while menu open. Close menu and keep menu bar highlighted.
GoSub Close_Pseudo_Menu
altmx = Abs(altmx): i = altmx: m.AltSwitch = 2: pcopyhack = -Abs(i): AltException = 1
Else
md = 0: GoSub Redo_Menu_Bar: altmx = 0 ' Menu bar highlighting is removed when alt key is released.
End If
End Select
Else
If m.alt = 0 Then AltBlocker = 0: m.AltSwitch = 0: altmx = 0
End If
If Len(b$) Then
If Len(b$) = 2 And m.alt Then GoSub converter
If InStr(UCase$(shortcut$), UCase$(b$)) Then ' Shortcut key to open menu.
If m.AltSwitch And m.AltSwitch <= 2 And altmx > -1 Then ' Menu bar is highlghted without popup menu.
j = InStr(UCase$(shortcut$), UCase$(b$))
altmx = -InStr(map$, Chr$(j + 48)) ' altmx is negative so menu is open.
i = altmx
popit = Abs(i) ' Open popup menu.
End If
ElseIf b$ = Chr$(0) + "M" And altmx Then
j = Asc(Mid$(map$, Abs(altmx), 1)) - 48 + 1
If altmx < 0 Then i = -1 Else i = 1
altmx = InStr(map$, LTrim$(Str$(j))) * i
If altmx = 0 Then altmx = InStr(map$, "1") * i
i = altmx
If altmx < 0 Then popit = Abs(i)
ElseIf b$ = Chr$(0) + "K" And altmx Then
j = Asc(Mid$(map$, Abs(altmx), 1)) - 48 - 1
If altmx < 0 Then i = -1 Else i = 1
altmx = InStr(map$, LTrim$(Str$(j))) * i
If altmx = 0 Then altmx = InStr(map$, Mid$(map$, Len(RTrim$(map$)), 1)) * i
i = altmx
If altmx < 0 Then popit = Abs(i)
ElseIf b$ = Chr$(13) And altmx > 0 Or b$ = Chr$(0) + "P" And altmx > 0 Then
altmx = -altmx: popit = Abs(altmx): i = altmx
ElseIf b$ = Chr$(27) And altmx Then ' Esc with highlighted menu bar with or without a popup menu open.
b$ = "" ' Negate b$ so it won't affect other sub routines or the main.
md = 0
If altmx < 0 Then GoSub Close_Pseudo_Menu
md = 0: GoSub Redo_Menu_Bar: altmx = 0: m.AltSwitch = 0
End If
End If
Select Case m.lb
Case -1
If m.y = pop.MenuBarRow And Mid$(map$, m.x, 1) <> " " And altmx >= 0 Then
i = -m.x: popit = i: altmx = i: m.AltSwitch = 2
ElseIf altmx > 0 Then
md = 0: GoSub Redo_Menu_Bar: altmx = 0: m.AltSwitch = 0
End If
Case 0
If altmx Then
If Len(b$) Then
If b$ = "Menu" Then i = altmx
ElseIf m.y = pop.MenuBarRow Then
If oldmx <> m.x Or oldmy <> m.y Then
x$ = Mid$(map$, m.x, 1)
If x$ <> " " And InStr(map$, x$) <> Abs(altmx) Then
i = m.x
If altmx < 0 Then i = -i: popit = i ' A popup menu is open so slide it with the bar.
End If
End If
End If
End If
End Select
If i Then
If altmx > 0 Then GoSub Redo_Menu_Bar
x$ = Mid$(map$, Abs(i), 1)
j = InStr(map$, RTrim$(x$))
altmx = j: If i < 0 Then altmx = -altmx
End If
If popit Then ' Open a menu.
md = 0: GoSub Redo_Menu_Bar
pcopyhack = Abs(i)
pop.MenuModel = 2
If popit > 0 Then g = popit Else g = m.x
x$ = Mid$(map$, g, 1)
h = InStr(map$, RTrim$(x$))
If pop.Show > 0 Then pop.CloseReOpen = Asc(x$) - 48
pop.Show = Asc(x$) - 48
pop.MenuL = Abs(h) - 2
popit = 0
End If
Color restore_color1, restore_color2
Locate y, x
oldmy = m.y: oldmx = m.x
Exit Sub '---------------------------------->
Redo_Menu_Bar:
If md = 0 Or md = 2 Then
Color c.PopupMenuBarFrg, c.PopupMenuBarBkg: Locate pop.MenuBarRow, 1: Print pop.MenuBar
End If
If md > 1 Then ' Highlight Menu Name.
x$ = Mid$(map$, Abs(i), 1)
j = InStr(map$, RTrim$(x$))
If j <> Abs(altmx) And m.lb = 0 Or Len(b$) Or md = 3 Then
Color c.FixedMenuHlFrg, c.FixedMenuHlBkg
k = _InStrRev(map$, x$) + 1 - j
Locate pop.MenuBarRow, j - 1
Print " " + Mid$(pop.MenuBar, j, k); " ";
End If
End If
If md > 0 And altmx > 0 Then ' Shortcut Menubar.
If pop.Show < 1 Then
For h = 1 To Len(shortcut$)
a$ = Mid$(shortcut$, h, 1)
If Len(x$) Then
If h = Asc(x$) - 48 Then Color c.FixedMenuScFrg, c.FixedMenuHlBkg Else Color c.FixedMenuScFrg, c.FixedMenuBkg
Else
Color c.FixedMenuScFrg, c.FixedMenuBkg
End If
Locate pop.MenuBarRow, InStr(pop.MenuBar, a$)
Print Mid$(shortcut$, h, 1);
Next
End If
End If
Return
Close_Pseudo_Menu:
pop.Show = -1: m.AltSwitch = 0
Return
converter:
g = Asc(Mid$(b$, 2, 1)) - 15
If g >= 1 And g <= 35 Then
x$ = "QWERTYUIOP ASDFGHJKL ZXCVBNM"
b$ = RTrim$(Mid$(x$, g, 1)) ' Cancel if space.
End If
Return
End Sub
Sub Popup_Menu (t As TextVar, in As InputVar, pop As PopupVar, m As MouseVar, c As ColorVar, b$, text$())
Static initiate, nomi, oldmy, oldmx, myalt, RtClkRedo
Static menu$(), sc$(), menu_restrict(), y, x, atmp As String
Static UcaseKeys$, LcaseKeys$, CtrlKeys$, AltKeys$
If pop.MenuModel < 0 Then pop.MenuModel = 0: pop.Choice = 0 ' Completed cycle.
If m.rb = -1 And pop.MenuModel = 0 Or RtClkRedo Then
RtClkRedo = 0
pop.Show = 1: pop.MenuModel = 3 ' Future: pop.show will have to be set to another variable to determine the popup data to be loaded.
End If
If pop.Show Then
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
y = CsrLin: x = Pos(0)
While -1
If pop.ForceInitiate Then initiate = 0
If initiate = 0 And pop.Show > 0 Then ' Note: pop.Show = -1 will force menu close.
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: _Font 16
in.CurShow = 0: Locate , , in.CurShow ' Hide cursor
nomi = 0: oldmy = 0: oldmx = 0: myalt = 0: pop.MenuHL = 0
pop.hwWindow = 0: pop.ChoiceName = ""
UcaseKeys$ = ",84 F1,85 F2,86 F3,87 F4,88 F5,89 F6,90 F7,91 F8,92 F9,93 F10,133 F11,134 F12,82 Insert,83 Delete,73 PgUp,81 PgDn,71 Home,79 End,75 Lt,72 Up,80 Dn,77 Rt,8 Backspace,126 ~,33 !,64 @,35 #,36 $,37 %,94 ^,38 &,42 *,40 (,41 ),95 _,43 +,81 Q,87 W,69 E,82 R,84 T,89 Y,85 U,73 I,79 O,80 P,123 {,125 },124 |,65 A,83 S,68 D,70 F,71 G,72 H,74 J,75 K,76 L,58 :,34 -Q,90 Z,88 X,67 C,86 V,66 B,78 N,77 M,60 <,62 >,63 ?,32 Space,15 Tab,27 Esc,13 Enter"
LcaseKeys$ = ",59 F1,60 F2,61 F3,62 F4,63 F5,64 F6,65 F7,66 F8,67 F9,68 F10,133 F11,134 F12,82 Insert,83 Delete,73 PgUp,81 PgDn,71 Home,79 End,75 Lt,72 Up,80 Dn,77 Rt,8 Backspace,96 `,49 1,50 2,51 3,52 4,53 5,54 6,55 7,56 8,57 9,48 0,45 -,61 =,113 q,119 w,101 e,114 r,116 t,121 y,117 u,105 i,111 o,112 p,91 [,93 ],92 \,97 a,115 s,100 d,102 f,103 g,104 h,106 j,107 k,108 l,59 ;,39 ',122 z,120 x,99 c,118 v,98 b,110 n,109 m,44 ,,46 .,47 /,32 Space,9 Tab,27 Esc,13 Enter,42 *,43 +" ' Last 2 are for numlock.
CtrlKeys$ = ",94 F1,95 F2,96 F3,97 F4,98 F5,99 F6,100 F7,101 F8,102 F9,103 F10,137 F11,138 F12,146 Insert,147 Delete,132 PgDp,118 PgDn,119 Home,117 End,115 Lt,141 Up,145 Dn,116 Rt,147 Backspace,17 q,23 w,5 e,18 r,20 t,25 y,21 u,9 i,15 o,16 p,1 a,19 s,4 d,6 f,7 g,8 h,10 j,11 k,12 l,26 z,24 x,3 c,22 v,2 b,14 n,13 m,32 Space,0 2,30 6,31 -"
AltKeys$ = ",104 F1,105 F2,106 F3,108 F5,109 F6,110 F7,111 F8,112 F9,113 F10,139 F11,140 F12,162 Insert,163 Delete,153 PgDp,161 PgDn,151 Home,159 End,155 Lt,152 Up,160 Dn,157 Rt,14 Backspace,41 `,120 1,121 2,122 3,123 4,124 5,125 6,126 7,127 8,128 9,129 0,130 -,131 =,16 q,17 w,18 e,19 r,20 t,21 y,22 u,23 i,24 o,25 p,26 [,27 ],43 \,30 a,31 s,32 d,33 f,34 g,35 h,36 j,37 k,38 l,39 ;,40 ',44 z,45 x,46 c,47 v,48 b,49 n,50 m,51 , 52,. 53,/"
If t.fw = 0 Then t.fw = _FontWidth: t.fh = _FontHeight
Select Case pop.MenuModel
Case 1, 3
Select Case pop.Show
Case 1: Restore RtClkPopupData1
Case 2: Restore RtClkPopupData2
End Select
Case 2
Select Case pop.Show
Case 1: Restore PopupMenuBarData1
Case 2: Restore PopupMenuBarData2
Case 3: Restore PopupMenuBarData3
Case 4: Restore PopupMenuBarData4
Case 5: Restore PopupMenuBarData5
Case 6: Restore PopupMenuBarData6
Case 7: Restore PopupMenuBarData7
Case 8: Restore PopupMenuBarData8
Case 9: Restore PopupMenuBarData9
End Select
End Select
Do
Read tmp$
If tmp$ = "eof" Then Exit Do
nomi = nomi + 1
ReDim _Preserve menu$(nomi), sc$(nomi)
menu$(nomi) = tmp$
sc$(nomi) = Chr$(3) + "0" + Chr$(4) + "0" + Chr$(5) + "0" + Space$(10)
x$ = LCase$(Mid$(tmp$, _InStrRev(tmp$, ".") + 1))
If InStr(x$, " ") Then
a$ = ""
For i = 1 To Len(x$)
If Mid$(x$, i, 1) <> " " Then a$ = a$ + Mid$(x$, i, 1)
Next
x$ = a$
End If
If InStr(x$, "shift") Then Mid$(sc$(nomi), 2, 1) = "1"
If InStr(x$, "ctrl") Then Mid$(sc$(nomi), 4, 1) = "1"
If InStr(x$, "alt") Then Mid$(sc$(nomi), 6, 1) = "1"
Mid$(sc$(nomi), 7) = Mid$(x$, _InStrRev("+" + x$, "+"))
Loop
ReDim menu_restrict(nomi) ' Restrictions.
If pop.MenuModel = 3 Then
If text$(in.fld) = "" Then ' Empty input line. Cut/Copy/Paste/Clear/Select All unavilable.
For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
Else
If t.hl = 0 Then ' Unhighlighted text - Cut/Copy/Paste/Clear unavilable. Select All available.
For i = 1 To 4: menu_restrict(i) = 1: Next
End If
End If
If text$(in.fld) = "" Then menu_restrict(5) = 1 ' Cannot Select All on a blank input line.
If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' Paste available if clipboard is loaded.
End If
' Open popup.
PCopy 0, 1
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 pop.MenuModel
Case 1 ' Fixed Menu.
pop.MenuT = pop.FixMenuT: pop.MenuL = pop.FixMenuL: pop.MenuR = pop.MenuL + pop.mwidth: pop.MenuB = pop.MenuT + pop.mheight
Case 2 ' Menu Bar.
pop.MenuT = pop.MenuBarRow + 1
pop.MenuR = pop.MenuL + pop.mwidth: pop.MenuB = pop.MenuT + pop.mheight
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
Case 3 ' Movable Menu.
pop.MenuT = m.y + 1 ' One below input line.
pop.MenuL = m.x
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
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
M2adj = t.fh \ 2
If pop.MenuModel = 2 Then
Line (hWth + 1, 0)-(pop.mwidth * t.fw - hWth, t.fh), _RGB32(255, 255, 255), BF
End If
' top bottom left right (mask)
Line (hWth + 1, 0 + M2adj)-(pop.mwidth * t.fw - hWth, hHgt + M2adj), _RGB32(255, 255, 255), BF
Line (hWth + 1, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - t.fh + M2adj)-(pop.mwidth * t.fw - hWth, ((i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - t.fh + hHgt + M2adj)), _RGB32(255, 255, 255), BF
Line (hWth + 1, 0 + M2adj)-(t.fw, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh + M2adj), _RGB32(255, 255, 255), BF
Line (pop.mwidth * t.fw - hWth, 0 + M2adj)-(pop.mwidth * t.fw - t.fw, (pop.MenuB - pop.MenuT - (Abs(pop.VSpacing) - 1)) * t.fh + M2adj), _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 + M2adj)-(pop.mwidth * t.fw - hWth, (i + .5 * vs) * Abs(pop.VSpacing) * t.fh + M2adj), _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 + M2adj)-(t.fw, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh + M2adj), _RGB32(255, 255, 255), BF
Line (pop.mwidth * t.fw - hWth, 0 + M2adj)-(pop.mwidth * t.fw - t.fw, (pop.MenuB - pop.MenuT - (Abs(pop.VSpacing) - 1)) * t.fh + M2adj), _RGB32(255, 255, 255), BF
End If
' top bottom left right (outer border)
If pop.MenuModel <> 2 Then Line (hWth, 0 + M2adj)-(pop.mwidth * t.fw - hWth, 0 + M2adj), _RGB32(0, 0, 0, 32), B
Line (t.fw * .5, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + M2adj)-((pop.mwidth * t.fw - hWth), (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + M2adj), _RGB32(0, 0, 0, 32), B
Line (hWth, 0 + M2adj)-(hWth, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh + M2adj), _RGB32(0, 0, 0, 32), B
Line (pop.mwidth * t.fw - hWth, 0 + M2adj)-(pop.mwidth * t.fw - hWth, (pop.MenuB - pop.MenuT - 1 + vs) * t.fh + M2adj), _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 + M2adj), _RGB32(0, 0, 0, 128), BF
Line (t.fw * 1.5, (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + 1 + M2adj)-((pop.mwidth * t.fw - hWth), (i - 1 + vs) * Abs(pop.VSpacing) * t.fh + hHgt - j + M2adj), _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 Chr$(195) + String$(pop.mwidth - 2, Chr$(196)) + Chr$(180); ' Ã ´
End If
Next
Else
If m.lb = 0 And pop.Show > 0 Then initiate = 2
End If
Do
If t.ScrnResize = 1 Then pop.Choice = -1: Exit Do ' Force popup to close when resizing app.
If pop.Show < 0 Or pop.CloseReOpen Then Exit Do ' Close or close and reopen popup menu. Ex: pop.show = -1
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
ElseIf b$ = Chr$(27) Then Exit Do
End If
' Popup is present.
If m.rb = -1 And pop.MenuModel = 3 And RtClkRedo = 0 Then
If m.y < pop.MenuT Or m.y > pop.MenuB Or m.x < pop.MenuL Or m.x > pop.MenuR Then
RtClkRedo = _TRUE
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
If m.y = oldmy And m.x = oldmx And m.lb = 0 Or oldmy = 0 And m.lb = 0 Then
i = 0 ' Prevents mouse on menu that was just opened from highlighting an entry.
Else
i = myalt > pop.MenuT And myalt < pop.MenuB And mxalt > pop.MenuL And mxalt < pop.MenuR
End If
If i Or mxalt = -1 Then
Select Case Abs(pop.VSpacing)
Case 1
i = myalt <> oldmy Or myalt = oldmy And m.x <> oldmx Or pop.MenuHL And m.lb = 2
Case 2
j = (myalt - pop.MenuT) \ Abs(pop.VSpacing): k = (myalt - pop.MenuT) / Abs(pop.VSpacing)
i = j <> k And myalt <> oldmy Or j <> k And myalt = oldmy And m.x <> oldmx Or pop.MenuHL And m.lb = 2
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
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 = 2 And initiate = 2 Then
If m.y > pop.MenuT Or m.y < pop.MenuB Or m.x > pop.MenuR Or m.x < pop.MenuL Then pop.Choice = -1: Exit Do
End If
End If
If Len(b$) Then
If m.alt Then
x$ = AltKeys$
ElseIf m.ctrl Then x$ = CtrlKeys$
ElseIf m.shift Then x$ = UcaseKeys$ Else x$ = LcaseKeys$
End If
If Len(b$) = 1 Then e$ = LTrim$(Str$(Asc(b$))): seed = InStr(x$, "Arrow Rt") + 8 Else e$ = LTrim$(Str$(Asc(Mid$(b$, 2, 1)))): seed = 0
j = InStr(seed, x$, "," + e$ + " ")
If j Then
key$ = Mid$(x$, j + Len(e$) + 2)
key$ = Mid$(key$, 1, InStr(key$ + ",", ",") - 1)
If m.shift Then
j = InStr("`1234567890-=[]\;',./", key$)
If j Then key$ = Mid$("~!@#$%^&*()_+{}|:'<>?", j, 1): If key$ = "'" Then key$ = Chr$(34)
End If
If key$ = "-Q" Then key$ = Chr$(34) ' Compensate for inability to store a quote mark in a data statement.
End If
For i = 1 To nomi
If m.shift And Mid$(sc$(i), 2, 1) = "1" Or m.shift = 0 And Mid$(sc$(i), 2, 1) = "0" Then
If m.ctrl And Mid$(sc$(i), 4, 1) = "1" Or m.ctrl = 0 And Mid$(sc$(i), 4, 1) = "0" Then
If m.alt And Mid$(sc$(i), 6, 1) = "1" Or m.alt = 0 And Mid$(sc$(i), 6, 1) = "0" Then
If RTrim$(Mid$(sc$(i), 7)) = LCase$(key$) Then
pop.Choice = i: pop.ChoiceName$ = menu$(i): Exit Do
End If
End If
End If
End If
Next i
End If
If t.HardwareMenus Then _PutImage ((pop.MenuL - 1) * t.fw, (pop.MenuT - 1) * t.fh), pop.hwWindow
pop.ForceInitiate = 0
oldmy = m.y: oldmx = m.x
Locate y, x
Exit While ' -------------------------------------------------------->
Loop ' Loop is exited when popup is closed; otherwise we exit the sub from the statement above.
If pop.Choice > 0 Then pop.ChoiceName = menu$(pop.Choice) ' A negative value is created when clicking outside a menu.
pop.Show = 0
If initiate Then
PCopy 1, 0 ' Adding initiate here prevents a pop.Show -1 call that was first positive to open the popup and copy the screen.
End If
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
If pop.CloseReOpen Then
pop.Show = pop.CloseReOpen: pop.CloseReOpen = 0 ' Loop back.
Else
pop.MenuModel = -pop.MenuModel
Exit While
End If
Wend
End If
End Sub
Sub control (t As TextVar, in As InputVar, pop As PopupVar, m As MouseVar, b$, text$())
Static initiate, seen
If initiate = 0 Or t.ScrnResize = 2 Then
t.HardwareMenus = 1: pop.VSpacing = 2: mc = 8
If t.ScrnResize = 0 Then getmenu = 1
initiate = 1
ReDim text$(1): in.fld = 1: text$(in.fld) = "Test!"
GoSub Menu_Layout
End If
If m.y >= 3 And m.y <= 8 + 3 Then
If m.lb = -1 Then b$ = Chr$(0) + Chr$(59 + m.y - 3)
End If
If Mid$(b$, 2, 1) >= Chr$(59) And Mid$(b$, 2, 1) <= Chr$(66) Then
If pop.MenuModel = 2 And pop.Show Then
Else
getmenu = 1
Select Case b$
Case Chr$(0) + Chr$(59): t.HardwareMenus = 0: pop.VSpacing = -1: mc = 1
Case Chr$(0) + Chr$(60): t.HardwareMenus = 0: pop.VSpacing = -2: mc = 2
Case Chr$(0) + Chr$(61): t.HardwareMenus = 0: pop.VSpacing = 1: mc = 3
Case Chr$(0) + Chr$(62): t.HardwareMenus = 0: pop.VSpacing = 2: mc = 4
Case Chr$(0) + Chr$(63): t.HardwareMenus = 1: pop.VSpacing = -1: mc = 5
Case Chr$(0) + Chr$(64): t.HardwareMenus = 1: pop.VSpacing = -2: mc = 6
Case Chr$(0) + Chr$(65): t.HardwareMenus = 1: pop.VSpacing = 1: mc = 7
Case Chr$(0) + Chr$(66): t.HardwareMenus = 1: pop.VSpacing = 2: mc = 8
End Select
End If
End If
If getmenu Then
pop.Show = 2: pop.MenuModel = 1: pop.ForceInitiate = 1
getmenu = 0
GoSub Menu_Layout
End If
If pop.Choice > 0 Then
Sound 1000, .1
seen = 1
Locate _Height - 1, 1: Color 15, 1: Print Space$(_Width);
Locate _Height - 1, 2: Print "#"; LTrim$(Str$(pop.Choice)); " "; pop.ChoiceName;
If pop.MenuModel = -3 Then
If pop.Choice = 5 Then t.hl = 1 Else t.hl = 0
End If
Else
If pop.Show And seen = 1 Then
Locate _Height - 1, 1: Color 15, 1: Print Space$(_Width);: seen = 0
End If
End If
Exit Sub '===============================>
Menu_Layout:
Color 15, 1: View Print 2 To _Height: Cls 2: View Print
Locate 3, 2
Print "Press F1 for a Single-Spaced No Lines Popup Menu"
Locate , 2
Print "Press F2 for a Double-Spaced No Lines Popup Menu"
Locate , 2
Print "Press F3 for a Single-Spaced Lined Popup Menu"
Locate , 2
Print "Press F4 for a Double-Spaced Lined Popup Menu"
Locate , 2
Print "Press F5 for a Single-Spaced No Lines Hardware Popup Menu"
Locate , 2
Print "Press F6 for a Double-Spaced No Lines Hardware Popup Menu"
Locate , 2
Print "Press F7 for a Single-Spaced Lined Hardware Popup Menu"
Locate , 2
Print "Press F8 for a Double-Spaced Lined Hardware Popup Menu"
Print
Locate , 2
a$ = "Current Menu Type: "
q1 = CsrLin: q2 = Len(a$)
Print a$;
Select Case mc
Case 1: a$ = "Single-Spaced No Lines Popup Menu"
Case 2: a$ = "Double-Spaced No Lines Popup Menu"
Case 3: a$ = "Single-Spaced Lined Popup Menu"
Case 4: a$ = "Double-Spaced Lined Popup Men"
Case 5: a$ = "Single-Spaced No Lines Hardware Popup Menu"
Case 6: a$ = "Double-Spaced No Lines Hardware Popup Menu"
Case 7: a$ = "Single-Spaced Lined Hardware Popup Menu"
Case 0, 8: a$ = "Double-Spaced Lined Hardware Popup Menu"
End Select
Color 14, 1
Print a$ + Space$(14)
Print
Color 1, 3
For i = 1 To 20
Print String$(_Width, Chr$(177))
Next
Color 15, 1
Return
End Sub
Sub ScreenSize (t As TextVar, c As ColorVar)
Static initiate
If t.ScreenEstablished = 0 Then
_Resize On: w = t.ScrnW: h = t.ScrnH
Else
Select Case t.ScrnResize
Case 0
If _ResizeWidth \ _FontWidth <> _Width Or _ResizeHeight \ _FontHeight <> _Height Then
t.ScrnResize = 1: Exit Sub
End If
Case 1
t.ScrnResize = 2: w = _ResizeWidth \ _FontWidth: h = _ResizeHeight \ _FontHeight
Case 2
t.ScrnResize = 0: Exit Sub ' Resize cycle complete.
End Select
End If
If t.ScrnResize = 2 Then
If w < x Then w = 0 ' Prevents the screen from resizing smaller than the current cursor column.
If w < t.ScrnResizeMinW Then w = 0
If h < CsrLin Then h = 0 'Prevents the screen from resizing smaller than the current cursor row.
If h < t.ScrnResizeMinH Then h = 0
End If
If w And h <> 0 Then
Width w, h: _Font 16
t.mr = _Width
Palette c.InputFrg2, c.pal2
Palette c.SkinBkg, c.pal3
Palette c.PopupShadowBkg, c.pal4
Color , c.PageColor: Cls
t.ScreenEstablished = 1: initiate = 1
End If
End SubSo universal shortcut keys now function with a menu open, but I also want to add all keys in all menus when they are all closed.
Pete
Shoot first and shoot people who ask questions, later.