Quote:Also remember to put on the quirk that Dimster desires... the pulldown animation.![[Image: smile.png]](https://qb64phoenix.com/forum/images/smilies/smile.png)
Dang! I missed that. Stay Tuned... oh this is going to be tougher than I thought!
Code: (Select All)
Option _Explicit ' no typos for variables if you please
_Title "Drop Menu more 2 function test" ' b+ 2023-06-27
' Instigated by Dimster here:
' https://qb64phoenix.com/forum/showthread...7#pid17117
' More! = 1. Highlite mouse overs 2. Handle extra long menu descriptions up to .5 screen width
' So sorry Ultraman, no tool tips but extra long descriptions is better than nutt'n.
Const ButtonW = 100, ButtonH = 20 ' basic rectangle size for title of menu panel
Type BoxType ' to be used for MouseZone click checking
As String Label ' menu title
As Long LeftX, TopY, BoxW, BoxH ' left most, top most , box width, box height
End Type
Dim Shared As Integer NBoxes ' setting up a demo in main
NBoxes = 72 ' exorbinant amount of menu titles
Dim Shared Boxes(1 To NBoxes) As BoxType ' data array for positions and labels
Dim As Integer i, x, y, mz, nItems, choice ' index, positions, menu count, choice selected
ReDim menu$(1 To 1) ' dynamic array to store quick menu's into
Dim s$ ' a string variable
Screen _NewImage(800, 600, 32) ' screen stuff
_ScreenMove 250, 50 ' somewhere in middle of my laptop, you may prefer to change for your screen
_PrintMode _KeepBackground ' preserve background when printing stuff
Cls ' so we have solid black background for image saving
x = 0: y = 0 ' set up boxes x, y for top left box corner
For i = 1 To NBoxes
Boxes(i).Label = "Box" + Str$(i) ' quick menu title
Boxes(i).LeftX = x: Boxes(i).TopY = y ' top left corner
Boxes(i).BoxW = ButtonW ' width to constant set for all
Boxes(i).BoxH = ButtonH ' height to constant set for all
If (x + 2 * ButtonW) > _Width Then ' spread out the menu titles left right, top down
x = 0: y = y + ButtonH ' next title didn't fit across so start new row
Else
x = x + ButtonW ' fits going across
End If
DrawTitleBox i ' draw the menu title panel
Next
Do
mz = MouseZone% ' reports which menu panel has been clicked and mouse
If mz Then ' quick make up a list of items for the menu title box
nItems = Int(Rnd * 10) + 1 ' pick random 1 to 10 inclusive
ReDim menu$(1 To nItems) ' resize menu$ by nItems
For i = 1 To nItems ' menu option and description
s$ = "Box" + Str$(mz) + " Menu Item:" + Str$(i) ' still needs to be less
s$ = s$ + " with extra, extra, long description." ' than .5 screen width
menu$(i) = s$ ' item is described with fairly good width to it
Next ' his was alternate to tool tips
choice = getButtonNumberChoice%(Boxes(mz).LeftX, Boxes(mz).TopY, menu$())
If choice = 0 Then s$ = "You quit menu by clicking outside of it." Else s$ = menu$(choice)
_MessageBox "Drop Menu Test", "Your Menu Choice was: " + s$, "info"
End If
_Limit 30
Loop Until _KeyDown(27)
Sub DrawTitleBox (i) ' draw a box according to shared Boxes array then print label
Line (Boxes(i).LeftX + 1, Boxes(i).TopY + 1)-Step(ButtonW - 2, ButtonH - 2), &HFF550088, BF
Color &HFFFFFFFF
_PrintString (Boxes(i).LeftX + (ButtonW - _PrintWidth(Boxes(i).Label)) / 2, _
Boxes(i).TopY + ButtonH / 2 - 8), Boxes(i).Label
End Sub
Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$) ' draw menu items for menu title
If highliteTF% Then ' reverse colors as mouse is over this item
Line (leftX, topY)-Step(BoxW, ButtonH), &HFFAAAAAA, BF
Color &HFF333333
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
Else
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF333333, BF
Color &HFFAAAAAA
_PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$
End If
Line (leftX, topY)-Step(BoxW, ButtonH), &HFF000000, B ' draw black box around item
End Sub
Function MouseZone% ' returns the Shared Boxes() index clicked or 0 none clicked
' Set the following up in your Main code of app
'Type BoxType ' to be used for mouse click checking
' As Long LeftX, TopY, BoxW, BoxH ' left most, top most, box width, box height
'End Type
'Dim Shared As Integer NBoxes
'Dim Shared Boxes(1 To NBoxes) As BoxType
Dim As Integer i, mb, mx, my
While _MouseInput: Wend ' poll mouse
mb = _MouseButton(1) ' looking for left click
If mb Then
_Delay .25
mx = _MouseX: my = _MouseY ' get the mouse position
For i = 1 To NBoxes ' see if its in a menu tile box from data in Shared Boxes array
If mx > Boxes(i).LeftX And mx < Boxes(i).LeftX + Boxes(i).BoxW Then
If my > Boxes(i).TopY And my < Boxes(i).TopY + Boxes(i).BoxH Then
MouseZone% = i: Exit Function ' yes a click in this box index
End If
End If
Next
End If
End Function
Function getButtonNumberChoice% (BoxX As Integer, BoxY As Integer, choice$())
' This fucion uses Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$)
' BoxX, BoxY are top left corner from the Menu Title Panel
' We will be drawing our Menu Items below that panel
Dim As Integer ub, lb, b ' choice$() boundaries and an index, b, to run through items
Dim As Integer longest ' find the longest string length in choices
Dim As Integer menuW, menuX ' use menuWidth and menuX start box side so long menu strings fit
Dim As Integer mx, my, mb ' mouse status of position and left button
Dim As Long save ' we are saving the whole screen before drop down to redraw after click
Dim As Long drawerDown ' save drawer down after animate dropping drawers for Dimster
ub = UBound(choice$): lb = LBound(choice$) ' array boundaries
For b = lb To ub ' find longest string in choice
If Len(choice$(b)) > longest Then longest = Len(choice$(b))
Next
If (longest + 2) * 8 > ButtonW Then ' don't use default button Width string too long
menuW = (longest + 2) * 8 ' calculate the needed width, up to half screen fits
If BoxX < _Width / 2 - 3 Then ' -3 ?? wouldn't work right until took 3 off middle
menuX = BoxX ' use the same left side of box to start
Else
menuX = BoxX + ButtonW - menuW ' right side box align minus menu width = x start box
End If
Else
menuW = ButtonW ' use default sizes that fit nicely under menu title panel
menuX = BoxX
End If
save = _NewImage(_Width, _Height, 32) ' save our beautiful screen before dropping menu
_PutImage , 0, save
' Animate dropping drawers for Dimster
For b = lb To ub ' clear any previous highlites
DrawChoiceBox 0, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
_Limit 5
Next
drawerDown = _NewImage(_Width, _Height, 32) ' save our beautiful screen after dropping menu
_PutImage , 0, drawerDown
Do ' until a mouse click occurs
_PutImage , drawerDown, 0 ' actually this is better to clear screen with image
While _MouseInput: Wend ' poll mouse
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
For b = lb To ub ' scan through the box dimension to see if mouse is in one
If mx > menuX And mx <= menuX + menuW Then
If my >= BoxY + b * ButtonH And my <= BoxY + b * ButtonH + ButtonH Then
If mb Then ' item is clicked!
_PutImage , save, 0 ' put image of screen back
_FreeImage save ' throw out screen image so no memory leak
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = b: _Delay .25: _AutoDisplay: Exit Function
Else
' indicate mouse over this menu item! draw highlight in box = -1
DrawChoiceBox -1, menuX, BoxY + b * ButtonH, menuW, choice$(b)
_Display
End If
End If
End If
Next
If mb Then ' there was a click outside the menu = cancel
_PutImage , save, 0 ' put image before dropdown draw back up
_FreeImage save ' leaving sub avoid memory leak, dump image
_FreeImage drawerDown
' delay before exit to give user time to release mouse button
' set function, restore autodisplay and exit
getButtonNumberChoice% = 0: _Delay .25: _AutoDisplay: Exit Function
End If
_Display ' display was needed here to avoid blinking when redrawing the highlited item
'_Limit 60
Loop ' until a mouse click occurs
End Function
b = b + ...