(12-14-2025, 07:59 PM)bplus Wrote: I added a Quick Menu.bas, the original demo I was thinking of, to the previous post I made, I like that for it's simplicity.
But by all means Make Your Own! It's a Basic Exercise for any Basic fan!
Well I spent more than a couple hours on this today. Got it implemented on the Main Menu screen of my Next X16 Movie Maker update !
(I WAS NOT Planning on going this far today. But once ya get rolling....lol....)
(12-15-2025, 07:53 AM)Petr Wrote: Can it be something as this?
Now released in my Dynamic Libraries thread.
That's the sort of thing I'm after but can it be done without the input box, just the selection box? I'll head over to your thread and take a look at things
12-16-2025, 01:58 AM (This post was last modified: 12-16-2025, 02:00 AM by bplus.)
This can easily serve as menu but it can display a whole string array and allow you to select from it.
Code: (Select All)
Option _Explicit
_Title "GetArrayItem$ v 2021-02-07" 'b+ NEED dev 1.5
' build from getArrayItemNumber& function 2019-05-18
' Main testing and demo of the FUNCTION getArrayItem$
Dim As Long lb, ub, i, locRow, locCol, boxWidth, boxHeight, snap
Dim As String selected
'test string array, use indexes in lines for alignment to code for function
lb = 1: ub = 45 ' <<<<<<<<<<<<<< different size arrays
ReDim arr(lb To ub) As String
For i = lb To ub
arr(i) = "This is arr item:" + Str$(i)
Next
'set variables to call display
locRow = 5: locCol = 80: boxWidth = 30: boxHeight = 20 ' character cell units not pixels
Do
Cls
' off by 1 row too height in display
Locate locRow - 2, locCol - 1: Print "*" ' height starts 1 less than spec'd
' this is box that contains the getArrItem box
Line ((locCol - 1) * 8 - 1, (locRow - 2) * 16 - 1)-Step(boxWidth * 8 + 2, boxHeight * 16 + 2), &HFFFFFF00, B
selected = GetArrayItem$(locRow, locCol, boxWidth, boxHeight, arr())
Print "You selected: "; selected; ", press any to continue..."
Sleep
Loop Until _KeyDown(27)
' Help: all this I hope is intuitive so Help not needed
' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
' "Press spacebar to select a highlighted item or just click it."
' "Use number(s) + enter to select an array item by it's index number,"
' "backspace will remove last number pressed, c will clear a number started. << Change to Delete
' "Numbers started are shown in bottom right PgDn bar."
' "Enter will also select the highlighted item, if no number has been started."
' "Home starts you at lowest array index, End highlights then highest index."
' "Use PgUp and PgDn keys to flip through pages of array items."
'
' Escape to Cancel Return "" else Return the selected string from the array
Function GetArrayItem$ (locateRow, locateColumn, boxWidth, boxHeight, arr() As String)
'This sub needs ScrState to store and restore screen condition before and after this sub does it's thing
'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
'boxWidth and boxHeight are in character units, again for locate and print at correct places.
'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
Dim maxWidth As Integer, maxHeight As Integer, page As Integer, hlite As Integer, mx As Integer, my As Integer
Dim lastMX As Integer, lastMY As Integer, row As Integer, mb As Integer
Dim lba As Long, uba As Long, choice As Long, kh As Long, index As Long
Dim clrStr As String, b As String
'save old settings to restore at end ofsub
ScnState 0
maxWidth = boxWidth ' number of characters in box
maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
lba = LBound(arr)
uba = UBound(arr)
page = 0
hlite = 0 ' line in display ready for selection by spacebar or if no number is started, enter
clrStr$ = Space$(maxWidth) 'clearing a display line
GoSub update ' show the beginning of the array items for selection
choice = -1719
Do 'until get a selection or demand exit
'handle the key stuff
kh& = _KeyHit
If kh& Then
If kh& > 0 And kh& < 255 Then
If InStr("0123456789", Chr$(kh&)) > 0 Then b$ = b$ + Chr$(kh&): GoSub update
If Chr$(kh&) = "c" Then b$ = "": GoSub update
If kh& = 13 Then 'enter pressed check if number is being entered?
If Len(b$) Then
If Val(b$) >= lba And Val(b$) <= uba Then 'we have number started
choice = Val(b$): Exit Do
Else 'clear b$ to show some response to enter
b$ = "": GoSub update 'clear the value that doesn't work
End If
Else
choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
End If
End If
If kh& = 27 Then Exit Do 'escape clause offered to Cancel selection process
If kh& = 32 Then choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
If kh& = 8 Then 'backspace to edit number
If Len(b$) Then b$ = Left$(b$, Len(b$) - 1): GoSub update
End If
Else
Select Case kh& 'choosing sections of array to display and highlighted item
Case 20736 'pg dn
If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
Case 18688 'pg up
If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
Case 18432 'up
If hlite - 1 < 0 Then
If page > 0 Then
page = page - 1: hlite = maxHeight - 1: GoSub update
End If
Else
hlite = hlite - 1: GoSub update
End If
Case 20480 'down
If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
If hlite + 1 > maxHeight - 1 Then
page = page + 1: hlite = 0: GoSub update
Else
hlite = hlite + 1: GoSub update
End If
End If
Case 18176 'home
page = 0: hlite = 0: GoSub update
Case 20224 ' end
page = Int((uba - lba) / maxHeight): hlite = maxHeight - 1: GoSub update
End Select
End If
End If
'handle the mouse stuff
While _MouseInput
If _MouseWheel = -1 Then 'up?
If hlite - 1 < 0 Then
If page > 0 Then
page = page - 1: hlite = maxHeight - 1: GoSub update
End If
Else
hlite = hlite - 1: GoSub update
End If
ElseIf _MouseWheel = 1 Then 'down?
If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
If hlite + 1 > maxHeight - 1 Then
page = page + 1: hlite = 0: GoSub update
Else
hlite = hlite + 1: GoSub update
End If
End If
End If
Wend
mx = Int((_MouseX - locateColumn * 8) / 8) + 2: my = Int((_MouseY - locateRow * 16) / 16) + 2
If _MouseButton(1) Then 'click contols or select array item
'clear mouse clicks
mb = _MouseButton(1)
If mb Then 'clear it
While mb 'OK!
If _MouseInput Then mb = _MouseButton(1)
_Limit 100
Wend
End If
If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
choice = my + page * maxHeight + lba - 1 'select item clicked
ElseIf mx >= 1 And mx <= maxWidth And my = 0 Then 'page up or exit
If my = 0 And (mx <= maxWidth And mx >= maxWidth - 2) Then 'exit sign
Exit Do 'escape plan for mouse click top right corner of display box
Else 'PgUp bar clicked
If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
End If
ElseIf mx >= 1 And mx <= maxWidth And my = maxHeight + 1 Then 'page down bar clicked
If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
End If
Else ' mouse over highlighting, only if mouse has moved!
If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
If mx <> lastMX Or my <> lastMY Then
If my - 1 <> hlite And (my - 1 + page * maxHeight + lba <= uba) Then
hlite = my - 1
lastMX = mx: lastMY = my
GoSub update
End If
End If
End If
End If
_Limit 200
Loop Until choice >= lba And choice <= uba
If choice <> -1719 Then GetArrayItem$ = arr(choice) 'set function and restore screen
ScnState -1 'restore
Exit Function
'display of array sections and controls on screen ====================================================
update:
'fix hlite if it has dropped below last array item
While hlite + page * maxHeight + lba > uba
hlite = hlite - 1
Wend
'main display of array items at page * maxHeight (lines high)
For row = 0 To maxHeight - 1
If hlite = row Then Color _RGB(200, 200, 255), _RGB32(0, 0, 88) Else Color _RGB32(0, 0, 88), _RGB(200, 200, 255)
Locate locateRow + row, locateColumn: Print clrStr$
index = row + page * maxHeight + lba
If index >= lba And index <= uba Then
Locate locateRow + row, locateColumn
Print Left$(LTrim$(Str$(index)) + ") " + arr(index), maxWidth)
End If
Next
'make page up and down bars to click, print PgUp / PgDn if available
Color _RGB32(200, 200, 255), _RGB32(0, 100, 50)
Locate locateRow - 1, locateColumn: Print Space$(maxWidth)
If page <> 0 Then Locate locateRow - 1, locateColumn: Print Left$(" Pg Up" + Space$(maxWidth), maxWidth)
Locate locateRow + maxHeight, locateColumn: Print Space$(maxWidth)
If page <> Int(uba / maxHeight) Then
Locate locateRow + maxHeight, locateColumn: Print Left$(" Pg Dn" + Space$(maxWidth), maxWidth)
End If
'make exit sign for mouse click
Color _RGB32(255, 255, 255), _RGB32(200, 100, 0)
Locate locateRow - 1, locateColumn + maxWidth - 3
Print " X "
'if a number selection has been started show it's build = b$
If Len(b$) Then
Color _RGB(255, 255, 0), _RGB32(0, 0, 0)
Locate locateRow + maxHeight, locateColumn + maxWidth - Len(b$) - 1
Print b$;
End If
_Display
_Limit 100
Return
End Function
' this is funky anyway
'Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill should we get a snap shot of screen?
' Static As _Unsigned Long defaultColor, backGroundColor
' Static As Long font, dest, source, row, col, autodisplay, mb, snap
' If restoreTF Then
' _Font font
' Color defaultColor, backGroundColor
' _Dest dest
' _Source source
' Locate row, col
' _KeyClear
' While _MouseInput: Wend 'clear mouse clicks
' mb = _MouseButton(1)
' If mb Then 'need this if line ?
' Do
' While _MouseInput: Wend
' mb = _MouseButton(1)
' _Limit 100
' Loop Until mb = 0
' End If
' _PutImage , snap, dest
' _FreeImage snap
' _Display
' If autodisplay Then _AutoDisplay Else _Display
' Else
' snap = _NewImage(_Width, _Height, 32)
' _PutImage , 0, snap
' font = _Font: defaultColor = _DefaultColor: backGroundColor = _BackgroundColor
' dest = _Dest: source = _Source
' row = CsrLin: col = Pos(0): autodisplay = _AutoDisplay
' While _MouseInput: Wend 'clear mouse clicks
' mb = _MouseButton(1)
' If mb Then 'need this if line ?
' Do
' While _MouseInput: Wend
' mb = _MouseButton(1)
' _Limit 100
' Loop Until mb = 0
' End If
' _KeyClear
' End If
'End Sub
' see if this version of screen state is OK because the above one does not play nice with old mBox and InputBox$
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static As _Unsigned Long defaultColor, backGroundColor
Static As Long font, dest, source, row, col, autodisplay, mb
If restoreTF Then
_Font font
Color defaultColor, backGroundColor
_Dest dest
_Source source
Locate row, col
If autodisplay Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb = _MouseButton(1)
If mb Then
Do
While _MouseInput: Wend
mb = _MouseButton(1)
_Limit 100
Loop Until mb = 0
End If
Else
font = _Font: defaultColor = _DefaultColor: backGroundColor = _BackgroundColor
dest = _Dest: source = _Source
row = CsrLin: col = Pos(0): autodisplay = _AutoDisplay
_KeyClear
End If
End Sub
It can also serve as a string array tool!
Comment: I was looking all over my files for this when the OP was made, just found it when looking for my String array tools. I had forgotten what I named it, no menu or select anywhere in name of file.
12-16-2025, 10:28 PM (This post was last modified: 12-16-2025, 10:50 PM by Pete.)
Well this is more for a right click popup text editor, and it's designed for text, not graphics. It could easily be modified to not need a right click to open, and also to stay open instead of closing after a selection is made, but just to show it off...
Right click to open menu. Right click to a different position to move it a bit. It's a big menu, so you won't be able to move it very far... Oh, and once you open it, mouse wheel or hover to highlight, or just mouse click a selection. Wheel and middle button click also selects.
Code: (Select All)
Type TextVar
PopupHardwareAceleration 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
Show As Integer ' 0 or 1.
hwWindow As Long
mwidth As Integer
mheight 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.
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
Do
_Limit 60
If m.rb = -1 Then pop.Show = -1
Mouse_Keyboard m, b$
Popup_Menu t, in, pop, m, c, b$
If t.PopupHardwareAceleration Then _Display
Loop
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
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.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
t.PopupHardwareAceleration = 1 ' Hardware Acceleration On.
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 leave Germany.
Data The pizza is free if it isn't there in 30-minutes of less.
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 How many Windows updates can you fit on the head of a hard drive?
Data "When life gives you lemons, Make lemonaid."
Data "When life gives you Sh*t, will 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 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: MenuModel = 0: myalt = 0: pop.MenuHL = 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 + 1) \ 2 > 1 Then
myalt = pop.MenuHL - 2: 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) \ 2 < nomi Then
myalt = pop.MenuHL + 2: mxalt = -1
End If
End If
ElseIf b$ = Chr$(13) Or m.mb = 2 Then
If menu_restrict((pop.MenuHL - pop.MenuT + 1) \ 2) = 0 Then
pop.Choice = (pop.MenuHL - pop.MenuT + 1) \ 2
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.
MenuModel = 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 * 2 + 1 ' Add one for the separate border element.
Select Case MenuModel
Case 0 ' Fixed menu to left.
pop.MenuT = 3: pop.MenuL = 1: pop.MenuR = pop.MenuL + pop.mwidth: pop.MenuB = pop.MenuT + pop.mheight
Case 1 ' 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.PopupHardwareAceleration Then
If pop.hwWindow = 0 Then
CRed = 120: CGrn = 120: CBlu = 120
t1 = _NewImage((pop.mwidth + 2) * t.fw, nomi * 3 * t.fh, 32)
_Dest t1
Line (t.fw \ 2, 0)-(pop.mwidth * t.fw - t.fw \ 2, t.fh \ 2), _RGB32(255, 255, 255), BF
Line (t.fw \ 2, (i - 1) * 2 * t.fh + t.fh \ 2 - t.fh)-(pop.mwidth * t.fw - t.fw \ 2, ((i - 1) * 2 * t.fh + t.fh \ 2 - t.fh + 7)), _RGB32(255, 255, 255), BF
Line (t.fw \ 2 + 1, 0)-(t.fw, (pop.MenuB - pop.MenuT - 1) * t.fh), _RGB32(255, 255, 255), BF
Line (pop.mwidth * t.fw - t.fw \ 2, 0)-(pop.mwidth * t.fw - t.fw, (pop.MenuB - pop.MenuT - 1) * t.fh), _RGB32(255, 255, 255), BF
For i = 0 To nomi
Line (t.fw \ 2, i * 2 * t.fh)-(pop.mwidth * t.fw - t.fw \ 2, i * 2 * t.fh), _RGB32(CRed, CGrn, CBlu), B
Next
j = 2 ' Make shadow 2 units smaller than font height and width.
Line (t.fw \ 2, 0)-(t.fw \ 2, (pop.MenuB - pop.MenuT - 1) * t.fh), _RGB32(CRed, CGrn, CBlu), B
Line (pop.mwidth * t.fw - t.fw \ 2, 0)-(pop.mwidth * t.fw - t.fw \ 2, (pop.MenuB - pop.MenuT - 1) * t.fh), _RGB32(CRed, CGrn, CBlu), B
Line (pop.mwidth * t.fw - t.fw \ 2 + 1, t.fh \ 2)-((pop.mwidth) * t.fw + t.fw \ 2 - j, (pop.MenuB - pop.MenuT) * t.fh - t.fh \ 2 - j), _RGB32(0, 0, 0, 128), BF
Line (t.fw * 1.5, (i - 1) * 2 * t.fh + 1)-((pop.mwidth * t.fw - t.fw \ 2), (i - 1) * 2 * t.fh + t.fh \ 2 - 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 - 2
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 * 2, pop.MenuL + 2
If menu_restrict(i + 1) Then Color c.PopupUnavail, c.PopupBkg Else Color c.PopupFrg, c.PopupBkg
Print menu$(i + 1)
Color c.PopupFrg, c.PopupBkg
Locate , pop.MenuL
If t.PopupHardwareAceleration = 0 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
i = (myalt - pop.MenuT) \ 2 <> (myalt - pop.MenuT) / 2 And myalt <> oldmy
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 + 1) \ 2))) = menu$((pop.MenuHL - pop.MenuT + 1) \ 2)
Locate pop.MenuHL, pop.MenuL + 2 - 1
If menu_restrict((pop.MenuHL - pop.MenuT + 1) \ 2) 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 + 1) \ 2))) = menu$((myalt - pop.MenuT + 1) \ 2)
Locate myalt, pop.MenuL + 2 - 1
If menu_restrict((myalt - pop.MenuT + 1) \ 2) 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 + 1) \ 2) = 0 Then
pop.Choice = (myalt - pop.MenuT + 1) \ 2
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.PopupHardwareAceleration Then _PutImage ((pop.MenuL - 1) * t.fw, (pop.MenuT - 1) * t.fh + t.fh / 2), pop.hwWindow
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 Sub
Pete
Shoot first and shoot people who ask questions, later.
DisableItem MainMenu, 5
ScrollDelay = .25 Do Cls Locate20, 1: Print"Press <H> to hide the menu." Print"Press <S> to show the menu." Print"Press <N> for No Sort order." Print"Press <A> for Alphabetic Sort order." Print"Press <#> for Numeric Sort order." Print"Press <C> to toggle case sorting." Print"Press <R> to toggle reverse sorting." Print"Press <L> to link the menus." Print"Press <U> to unlink the menus." Print"Press <TAB> to swap between menus." Print"<ESC> to quit" Print Print"Currently: "; If sortmode And1Then Print"ALPHA SORT"; If kase ThenPrint", CASE-SENSITIVE"; If reversed ThenPrint", REVERSE-ORDER"ElsePrint ElseIf sortmode And2Then Print"NUMERIC SORT"; If reversed ThenPrint", REVERSE-ORDER"ElsePrint Else Print"NOT SORTING" End If Locate5, 25 If linked ThenPrint"LINKED LISTS"ElsePrint"UNLINKED LISTS" Locate6, 15: Print"MENU ASSOCIATED WITH KEYBOARD: "; menuon
k = _KeyHit Select Case k CaseAsc("L"), Asc("l"): LinkMenus MainMenu, SecondMenu: linked = -1 CaseAsc("U"), Asc("u"): UnLinkMenus MainMenu, SecondMenu: linked = 0 CaseAsc("H"), Asc("h"): HideMenu menuon CaseAsc("S"), Asc("s"): ShowMenu menuon CaseAsc("N"), Asc("n"): sortmode = None: changed = -1: reversed = 0: kase = 0 CaseAsc("A"), Asc("a"): sortmode = Alpha: changed = -1 CaseAsc("#"), Asc("3"): sortmode = Numeric: changed = -1 CaseAsc("C"), Asc("c"): kase = Not kase: changed = -1 CaseAsc("R"), Asc("r"): reversed = Not reversed: changed = -1 Case9: menuon = menuon + 1: If menuon = 3Then menuon = 1 Case27: System End Select If changed Then If sortmode <> 0Then If kase Then sortmode = sortmode Or NoCase Else sortmode = sortmode AndNot NoCase If reversed Then sortmode = sortmode Or Reverse Else sortmode = sortmode AndNot Reverse End If MenuDisplaySort menuon, sortmode
changed = 0 End If DisplayMenus CheckMenus MouseStatus, MenuSelected, OptionSelected If MouseStatus <> 0And MenuSelected <> 0Then If MouseStatus And LeftClick Then Locate1, 1 Print"You LEFT CLICKED Option #"; OptionSelected; " in Menu #"; MenuSelected Print"Which was: "; GetListItem(MenuSelected, OptionSelected) Print If linked Then Print"Since our lists are linked, we get the following items:"; GetListItem(1, OptionSelected), GetListItem(2, OptionSelected) Else Print"Since our lists are unlinked, we get the following items:"; GetListItem(MenuSelected, OptionSelected) End If _Display _Delay2'give it time to pop up ElseIf MouseStatus And RightClick Then Locate1, 1 Print"You RIGHT CLICKED Option #"; OptionSelected; " in Menu #"; MenuSelected Print"Which was: "; GetListItem(MenuSelected, OptionSelected) Print If linked Then Print"Since our lists are linked, we get the following items:"; GetListItem(1, OptionSelected), GetListItem(2, OptionSelected) Else Print"Since our lists are unlinked, we get the following items:"; GetListItem(MenuSelected, OptionSelected) End If _Display _Delay2'give it time to pop up End If Color Yellow If MouseStatus And LeftDown ThenLocate35, 1: Print"LEFT MOUSE DOWN over Option #"; OptionSelected; " in Menu #"; MenuSelected If MouseStatus And RightDown ThenLocate35, 1: Print"RIGHT MOUSE DOWN over Option #"; OptionSelected; " in Menu #"; MenuSelected Color Purple If MouseStatus And Hover ThenLocate36, 1: Print"HOVERING over Option #"; OptionSelected; " in Menu #"; MenuSelected; Color White
SubLinkMenus (handle1, handle2) If handle1 = 0Or handle2 = 0ThenError5: Exit Sub If handle1 = handle2 ThenExit Sub'Why the heck are we linking one list to itself?! If Menu(handle1).Valid And Menu(handle2).Valid Then
LinkMax = LinkedTo(0).one 'I'm using the very first entry into my array to store the number of link entries I have 'First check to see if the two menus are already linked For i = 1To LinkMax
found = 0 If handle1 = LinkedTo(i).one Or handle1 = LinkedTo(i).another Then found = found + 1 If handle2 = LinkedTo(i).one Or handle2 = LinkedTo(i).another Then found = found + 1 If found = 2ThenExit Sub'the two lists are already linked If handle1 = 0And handle2 = 0And openspot = 0Then openspot = i 'we found a spot where a link was freed before; let's use it Next MenuDisplaySort handle1, None: MenuDisplaySort handle2, None 'unsort the lists to begin with.
Menu(handle1).TopEntry = 1: Menu(handle2).TopEntry = 1'and then reset them to their topmost position
If openspot Then
LinkedTo(openspot).one = handle1
LinkedTo(openspot).another = handle2 Else
LinkMax = LinkMax + 1: LinkedTo(0).one = LinkMax
LinkedTo(LinkMax).one = handle1
LinkedTo(LinkMax).another = handle2 End If Else Error5 End If End Sub
SubUnLinkMenus (handle1, handle2) If handle1 = 0Or handle2 = 0ThenError5: Exit Sub'no list should be linked to 0. 0 is nothing... Can't free a link to nothing. If handle1 = handle2 ThenExit Sub'We can't unlink a list from itself! If Menu(handle1).Valid And Menu(handle2).Valid Then For i = 1To LinkedTo(0).one If handle1 = LinkedTo(i).one Or handle1 = LinkedTo(i).another Then found = found + 1 If handle2 = LinkedTo(i).one Or handle2 = LinkedTo(i).another Then found = found + 1 If found = 2Then LinkedTo(i).one = 0: LinkedTo(i).another = 0'unlink them! Next Else Error5 End If End Sub
SubDisableItem (handle, item) If Menu(handle).Valid Then MenuListDisabled(item, handle) = -1ElseError5 End Sub
SubEnableItem (handle, item) If Menu(handle).Valid Then MenuListDisabled(item, handle) = 0ElseError5 End Sub
SubAddMenuItem (Handle, Item$) If Menu(Handle).Valid Then
Menu(Handle).Entries = Menu(Handle).Entries + 1
MenuList(Menu(Handle).Entries, Handle) = Item$
MenuDisplayOrder(Menu(Handle).Entries, Handle) = Menu(Handle).Entries Else Error5 End If End Sub
SubSetMenuListProperties (Handle, ListColor As_UnsignedLong, ListBackground As_UnsignedLong, ListJustify As_Byte) If Menu(Handle).Valid Then
Menu(Handle).ListColor = ListColor
Menu(Handle).ListBackground = ListBackground
Menu(Handle).ListJustify = ListJustify Else Error5 End If End Sub
SubSetMenuCaption (Handle, Header, Caption AsString * 255, CaptionColor As_UnsignedLong, CaptionBackground As_UnsignedLong, Xit) If Menu(Handle).Valid Then
Menu(Handle).Header = Header
Menu(Handle).Caption = Caption
Menu(Handle).CC = CaptionColor
Menu(Handle).CBG = CaptionBackground
Menu(Handle).Exit = Xit Else Error5 End If End Sub
SubSetMenuFrame (Handle, HaveFrame, FrameColor As_UnsignedLong, FrameBackGround As_UnsignedLong) If Menu(Handle).Valid Then
Menu(Handle).Frame = HaveFrame
Menu(Handle).BorderColor = FrameColor
Menu(Handle).BackgroundColor = FrameBackGround Else Error5 End If End Sub
MenuSelected = 0: OptionSelected = 0 For i = 1To MenusActive If Menu(i).Visible And Menu(i).Valid Then If startnum = 0Then startnum = i ProcessMenu i, startnum, MouseStatus, MenuSelected, OptionSelected If MenuSelected ThenExit Sub End If Next End Sub
SubDisplayMenus
FC = _DefaultColor: BG = _BackgroundColor For Whichone = 1To MenusActive If Menu(Whichone).Visible Then 'Get the starting limits of where menu/list text can appear
x1 = Menu(Whichone).Left: x2 = x1 + Menu(Whichone).Width
y1 = Menu(Whichone).Top: y2 = Menu(Whichone).Top + Menu(Whichone).Height
caption$ = LTrim$(RTrim$(Menu(Whichone).Caption)) 'strip unneeded spaces from the caption (WhichOnef any)
'clear the background Line (Menu(Whichone).Left, Menu(Whichone).Top)-Step(Menu(Whichone).Width, Menu(Whichone).Height), Menu(Whichone).BackgroundColor, BF 'draw the frame; adjust text limits If Menu(Whichone).Frame Then Line (Menu(Whichone).Left, Menu(Whichone).Top)-Step(Menu(Whichone).Width, Menu(Whichone).Height), Menu(Whichone).BorderColor, B
x1 = x1 + 1: y1 = y1 + 1
x2 = x2 - 1: y2 = y2 - 1 End If If Menu(Whichone).Header Then
temp = x2 - x1 + 1 Line (x1, y1)-(x2, y1 + _FontHeight), Menu(Whichone).CBG, BF If Menu(Whichone).ExitThen
temp = temp - _FontWidth * 2
ex1 = x2 - 1 - _FontWidth: ex2 = ex1 + _FontWidth
ey1 = y1 + 1: ey2 = ey1 + _FontHeight - 3 Line (ex1, ey1)-(ex2, ey2), Red, BF Line (ex1, ey1)-(ex2, ey2), Black Line (ex1, ey2)-(ex2, ey1), Black End If Do Until_PrintWidth(caption$) <= temp
caption$ = Left$(caption$, Len(caption$) - 1) Loop Color Menu(Whichone).CC, Menu(Whichone).CBG _PrintString (x1 + (temp - _PrintWidth(caption$)) \ 2, y1), caption$
y1 = y1 + _FontHeight If Menu(Whichone).Frame Then Line (x1, y1)-(x2, y1), Menu(Whichone).BorderColor
y1 = y1 + 2 End If End If'end header creation
If Menu(Whichone).Entries > 0Then'We have items in our list to display! If Menu(Whichone).TopEntry < 1Then Menu(Whichone).TopEntry = 1'check to make certain we're displaying from the first entry on at least If Menu(Whichone).TopEntry > Menu(Whichone).Entries Then Menu(Whichone).TopEntry = Menu(Whichone).Entries
printlimit = (x2 - x1 + 1) \ _FontWidth
limitfound = 1 + (y2 - y1 + 1) \ _FontHeight - 1 If limitfound > Menu(Whichone).Entries Then
limitfound = Menu(Whichone).Entries Else
scrollneeded = -1
printlimit = printlimit - 1 End If Color Menu(Whichone).ListColor, Menu(Whichone).ListBackground If Menu(Whichone).ScrollBarHidden = -1Then scrollneeded = 0 Dim r As_Unsigned_Byte, g As_Unsigned_Byte, b As_Unsigned_Byte Dim CC AsInteger
r = _Red32(Menu(Whichone).BackgroundColor)
g = _Green32(Menu(Whichone).BackgroundColor)
b = _Blue32(Menu(Whichone).BackgroundColor)
Fade& = _RGBA32(r, g, b, 180)
Select Case Menu(Whichone).ListJustify Case Left For j = 1To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(CC, Whichone))) If MenuListDisabled(CC, Whichone) Then graybox = -1 For ii = 1To LinkedTo(0).one If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1 If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1 Next
t$ = Left$(t$, printlimit) _PrintString (x1, y1 + (j - 1) * _FontHeight), t$ If graybox ThenLine (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF Next Case Right For j = 1To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone), Whichone))) If MenuListDisabled(CC, Whichone) Then graybox = -1 For ii = 1To LinkedTo(0).one If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1 If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1 Next
t$ = LTrim$(Left$(t$, printlimit))
p = _PrintWidth(t$) If scrollneeded Then _PrintString (x2 - p - _FontWidth, y1 + (j - 1) * _FontHeight), t$ Else _PrintString (x2 - p, y1 + (j - 1) * _FontHeight), t$ End If If graybox ThenLine (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF Next Case Center For j = 1To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = LTrim$(MenuList(MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone), Whichone)) If MenuListDisabled(CC, Whichone) Then graybox = -1 For ii = 1To LinkedTo(0).one If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1 If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1 Next
t$ = LTrim$(RTrim$(Left$(t$, printlimit)))
p = _PrintWidth(t$) _PrintString ((x2 - x1 + 1) - p \ 2, y1 + (j - 1) * _FontHeight), t$ If graybox ThenLine (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF Next Case Else For j = 1To limitfound
CC = MenuDisplayOrder(Menu(Whichone).TopEntry + j - 1, Whichone) 'currentchoice
graybox = 0
t$ = RTrim$(LTrim$(MenuList(CC, Whichone))) If MenuListDisabled(CC, Whichone) Then graybox = -1 For ii = 1To LinkedTo(0).one If Whichone = LinkedTo(ii).one And MenuListDisabled(CC, LinkedTo(ii).another) Then graybox = -1 If Whichone = LinkedTo(ii).another And MenuListDisabled(CC, LinkedTo(ii).one) Then graybox = -1 Next
t$ = Left$(t$, printlimit) _PrintString (x1, y1 + (j - 1) * _FontHeight), t$ If graybox ThenLine (x1, y1 + (j - 1) * _FontHeight)-(x2, y1 + (j) * _FontHeight), Fade&, BF Next
Menu(Whichone).ListJustify = Left 'If it's not specified for some reason, let's make it left justified as default End Select End If'end of displaying items If scrollneeded Then'then we need a vertical scroll bar
barx1 = x2 - _FontWidth - 1
barx2 = barx1 + _FontWidth Line (barx1, y1)-(barx2, y2), LightGray, BF Color Black, DarkGray _PrintString (barx1, y1), "" _PrintString (barx1, y2 - _FontHeight), "" End If End If Next Color FC, BG End Sub
'Get the starting limits of where menu/list text can appear
x1 = Menu(WhichOne).Left: x2 = x1 + Menu(WhichOne).Width
y1 = Menu(WhichOne).Top: y2 = Menu(WhichOne).Top + Menu(WhichOne).Height If WhichOne = StartNum Then If OldMouse = 0And MB = -1Then Click = -1Else Click = 0 If OldMouse2 = 0And MB2 = -1Then Click2 = -1Else Click2 = 0
OldMouse = MB: OldMouse2 = MB2 If ElapsedTimer + ScrollDelay < Timer(0.01) Then
ElapsedTimer = Timer(0.01)
ScrollAble = -1 Else
ScrollAble = 0 End If End If
If Menu(WhichOne).Frame Then Line (Menu(WhichOne).Left, Menu(WhichOne).Top)-Step(Menu(WhichOne).Width, Menu(WhichOne).Height), Menu(WhichOne).BorderColor, B
x1 = x1 + 1: y1 = y1 + 1
x2 = x2 - 1: y2 = y2 - 1 End If If Menu(WhichOne).Header Then
temp = x2 - x1 + 1 If Menu(WhichOne).ExitThen
temp = temp - _FontWidth * 2
ex1 = x2 - 1 - _FontWidth: ex2 = ex1 + _FontWidth
ey1 = y1 + 1: ey2 = ey1 + _FontHeight - 3 End If
y1 = y1 + _FontHeight If Menu(WhichOne).Frame Then y1 = y1 + 2 End If'end header creation
If Menu(WhichOne).Entries > 0Then'We have items in our list to display! If Menu(WhichOne).TopEntry < 1Then Menu(WhichOne).TopEntry = 1'check to make certain we're displaying from the first entry on at least If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries
printlimit = (x2 - x1 + 1) \ _FontWidth
limitfound = 1 + (y2 - y1 + 1) \ _FontHeight - 1 If limitfound > Menu(WhichOne).Entries Then
limitfound = Menu(WhichOne).Entries Else
scrollneeded = -1
printlimit = printlimit - 1 End If End If'end of displaying items
If Menu(WhichOne).ScrollBarHidden = -1Then scrollneeded = 0
Select Case MY 'let's determine which line we clicked the mouse on Case Is < ey1 'do nothing as it's too far up the screen to be a click in this box Case Is > y2 'do nothing again as it's too far down the screen to be a click in this box Case ey1 To ey2 'we've clicked on the line where the EXIT button might exist Case y1 To y2 End Select
Select Case MY 'let's determine which line we clicked the mouse on Case Is < ey1 'do nothing as it's too far up the screen to be a click in this box Case Is > y2 'do nothing again as it's too far down the screen to be a click in this box Case ey1 To ey2 'we've clicked on the line where the EXIT button might exist If Click And Menu(WhichOne).ExitThen If MX >= ex1 And MX <= ex2 Then Menu(WhichOne).Visible = False 'If the exit button is available, and we click it, it closes the menu/list End If Case y1 To y2
done = 0 If barx1 > 0Then p2 = barx1 - 1Else p2 = x2 If MX >= x1 And MX <= p2 Then'highlight the choice the user is over
yPOS = ((MY - y1 + 1) \ _FontHeight) * _FontHeight + y1 If yPOS + _FontHeight <= y2 ThenLine (x1, yPOS)-(p2, yPOS + _FontHeight), Menu(WhichOne).HighLightColor, B End If
If MouseScroll Then If MX >= x1 And MX <= x2 Then
Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry + MouseScroll If Menu(WhichOne).TopEntry < 1Then Menu(WhichOne).TopEntry = 1 If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries - limitfound + 1Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries - limitfound + 1 For i = 1To LinkedTo(0).one If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry Next End If End If
If scrollneeded Then If MY >= y1 And MY <= y1 + _FontHeightAnd MX >= barx1 And MX <= barx2 And MB <> 0Then'it's the top scroll bar If ScrollAble Then Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry - 1 If Menu(WhichOne).TopEntry < 1Then Menu(WhichOne).TopEntry = 1
done = -1 For i = 1To LinkedTo(0).one If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry Next ElseIf MY >= y2 - _FontHeightAnd MY <= y2 And MX >= barx1 And MX <= barx2 And MB <> 0Then'it's the bottom scroll bar If ScrollAble Then Menu(WhichOne).TopEntry = Menu(WhichOne).TopEntry + 1 If Menu(WhichOne).TopEntry > Menu(WhichOne).Entries - limitfound + 1Then Menu(WhichOne).TopEntry = Menu(WhichOne).Entries - limitfound + 1
done = -1 For i = 1To LinkedTo(0).one If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry Next ElseIf MX >= barx1 And MX <= barx2 And MB <> 0Then
MenuLimit = Menu(WhichOne).Entries - limitfound + 2
ylimit = y2 - y1 - _FontHeight * 2 + 1
yPOS = MY - y1 - _FontHeight + 1
Menu(WhichOne).TopEntry = (MenuLimit - (ylimit - yPOS) / ylimit * MenuLimit) If Menu(WhichOne).TopEntry >= MenuLimit Then Menu(WhichOne).TopEntry = MenuLimit - 1
done = -1 For i = 1To LinkedTo(0).one If WhichOne = LinkedTo(i).one Then Menu(LinkedTo(i).another).TopEntry = Menu(WhichOne).TopEntry If WhichOne = LinkedTo(i).another Then Menu(LinkedTo(i).one).TopEntry = Menu(WhichOne).TopEntry Next End If End If
IfNot done Then'if we've processed a scrollbar event, we're finished If MX >= x1 And MX <= x2 Then
MenuSelected = WhichOne
OptionSelected = MenuDisplayOrder((MY - y1 + 1) \ _FontHeight + Menu(WhichOne).TopEntry, WhichOne)
invalidate = 0 If MenuListDisabled(OptionSelected, WhichOne) Then invalidate = -1 For ii = 1To LinkedTo(0).one If WhichOne = LinkedTo(ii).one And MenuListDisabled(OptionSelected, LinkedTo(ii).another) Then invalidate = -1 If WhichOne = LinkedTo(ii).another And MenuListDisabled(OptionSelected, LinkedTo(ii).one) Then invalidate = -1 Next If barx1 <> 0And MX > barx1 Then invalidate = -1 If invalidate Then MenuSelected = 0: OptionSelected = 0 End If End If End Select
MouseStatus = 0
MouseStatus = MouseStatus Or -Click 'leftclick
MouseStatus = MouseStatus Or Click2 * -2'rightclick
MouseStatus = MouseStatus Or_MouseButton(1) * -4'leftdown
MouseStatus = MouseStatus Or_MouseButton(2) * -8'rightdown
MouseStatus = MouseStatus Or (MenuSelected <> 0) * 16'If we're over the menu, we're hovering
SubMenuDisplaySort (handle AsLong, sortmethod As_Byte)
gap = Menu(handle).Entries
If sortmethod And Alpha Then If sortmethod And NoCase Then Do
gap = 10 * gap \ 13 If gap < 1Then gap = 1
i = 0
swapped = 0 Do
t$ = UCase$(LTrim$(RTrim$(MenuList(MenuDisplayOrder(i, handle), handle))))
t1$ = UCase$(LTrim$(RTrim$(MenuList(MenuDisplayOrder(i + gap, handle), handle)))) If t$ > t1$ Then Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle) For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one ThenSwap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another) If handle = LinkedTo(ii).another ThenSwap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one) Next
swapped = -1 End If
i = i + 1 Loop Until i + gap > Menu(handle).Entries Loop Until gap = 1And swapped = 0 Else Do
gap = 10 * gap \ 13 If gap < 1Then gap = 1
i = 0
swapped = 0 Do
t$ = LTrim$(RTrim$(MenuList(MenuDisplayOrder(i, handle), handle)))
t1$ = LTrim$(RTrim$(MenuList(MenuDisplayOrder(i + gap, handle), handle))) If t$ > t1$ Then Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle) For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one ThenSwap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another) If handle = LinkedTo(ii).another ThenSwap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one) Next
swapped = -1 End If
i = i + 1 Loop Until i + gap > Menu(handle).Entries Loop Until gap = 1And swapped = 0 End If If sortmethod And Reverse Then For i = 1To Menu(handle).Entries \ 2 Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(Menu(handle).Entries - i + 1, handle) For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one ThenSwap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).another) If handle = LinkedTo(ii).another ThenSwap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).one) Next Next End If ElseIf sortmethod And Numeric Then Do
gap = 10 * gap \ 13 If gap < 1Then gap = 1
i = 0
swapped = 0 Do IfVal(MenuList(MenuDisplayOrder(i, handle), handle)) > Val(MenuList(MenuDisplayOrder(i + gap, handle), handle)) Then Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(i + gap, handle) For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one ThenSwap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(i + gap, LinkedTo(ii).another) If handle = LinkedTo(ii).another ThenSwap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(i + gap, LinkedTo(ii).one) Next
swapped = -1 End If
i = i + 1 Loop Until i + gap > Menu(handle).Entries Loop Until gap = 1And swapped = 0 If sortmethod And Reverse Then For i = 1To Menu(handle).Entries \ 2 Swap MenuDisplayOrder(i, handle), MenuDisplayOrder(Menu(handle).Entries - i + 1, handle) For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one ThenSwap MenuDisplayOrder(i, LinkedTo(ii).another), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).another) If handle = LinkedTo(ii).another ThenSwap MenuDisplayOrder(i, LinkedTo(ii).one), MenuDisplayOrder(Menu(handle).Entries - i + 1, LinkedTo(ii).one) Next Next End If Else For i = 1To Menu(handle).Entries
MenuDisplayOrder(i, handle) = i For ii = 1To LinkedTo(0).one If handle = LinkedTo(ii).one Then MenuDisplayOrder(i, LinkedTo(ii).another) = i If handle = LinkedTo(ii).another Then MenuDisplayOrder(i, LinkedTo(ii).one) = i Next Next End If
Not only does this have lists, which can be used for a menu, but it also links multiple menus together so they work interactively with each other. You can work with the first menu, or the second, or both.... scroll one at a time, or both of them.. link them, or unlink them. sort them, scroll them, click them. It's primarily mouse driven.
With this, I can make a whole multi-dimensional array of lists, like an excel spreadsheet, and work with any particular column or all columns as desired.
Use your mouse wheel to scroll in a list, use the keyboard prompts to link them, unlink them, sort them, ect. Mouse buttons click on them and such.
Folks here are making menus, while I've long ago invented spreadsheets.
![[Image: Screenshot-from-2025-12-14-21-53-37.png]](https://i.ibb.co/SD4vxBHt/Screenshot-from-2025-12-14-21-53-37.png)
