Basic graphical pick from list function

[191Brian]

A basic graphical pick from list function demo PickFromList (itemList() As String, xPos As Integer, yPos As Integer) pass the list as an array and an x y cord for the top left corner of the list box use your mouse to select an item it returns the index of the item picked or (array passed ubound) + 1 if none selected

demo uses the forum slpit function to build the list
the function PickFromList uses the UDT button and Terry Ritchie's RectCollide function

Code: QB64: [Select]

1. Option _Explicit
2.  
3. ' Basic graphical pick from list function demo
4. ' PickFromList (itemList() As String, xPos As Integer, yPos As Integer)
5. ' pass the list as an array and an x y cord for the top left corner of the list box
6. ' it returns the index of the item picked or array ubound + 1 if none selected
7.  
8. ' demo uses the forum slpit function to build the list
9. ' the function PickFromList uses the UDT button and Terry Ritchie's RectCollide function
10.  
11.  
12. Type button
13.     x As Integer
14.     y As Integer
15.     w As Integer
16.     h As Integer
17.     no As Integer
18.     text As String
19. End Type
20.  
21.  
22. ReDim aList(12) As String
23. Dim d As String
24. Dim itemNo As Integer
25.  
26. d = "January,February,March,April,May,June,July,August,September,October,November,December"
27.  
28. Split d, ",", aList()
29.  
30. Screen _NewImage(800, 600, 32)
31.  
32. Do
33.  
34.  
35.     itemNo = PickFromList(aList(), 100, 50)
36.     Cls
37.  
38.     If itemNo <= UBound(alist) Then
39.         Print "you picked "; aList(itemNo), itemNo
40.     Else
41.         Print "you didn't like and of the options presneted"
42.     End If
43.  
44.     Print "Press any key to continue or esc twice to exit"
45.     Sleep
46.  
47.  
48. Loop Until _KeyDown(27)
49.  
50. Sleep 0
51. System
52.  
53.  
54. Function PickFromList (itemList() As String, xPos As Integer, yPos As Integer)
55.     Dim fi As Integer
56.     ReDim itemBtn(UBound(itemlist) + 1) As button
57.     Dim pickedOne As Integer
58.     Dim mouseXPos As Integer
59.     Dim mouseYPos As Integer
60.     Dim listWidth As Integer
61.  
62.  
63.     PickFromList = 9999
64.     pickedOne = 0
65.     listWidth = 0
66.  
67.     For fi = 0 To UBound(itemlist) + 1
68.         itemBtn(fi).x = xPos + 2
69.         itemBtn(fi).y = yPos + (fi * 16) + 2
70.         itemBtn(fi).h = _FontHeight
71.         itemBtn(fi).no = fi
72.  
73.         If fi <= UBound(itemlist) Then
74.             itemBtn(fi).w = _PrintWidth(itemList(fi))
75.             itemBtn(fi).text = itemList(fi)
76.         Else
77.             itemBtn(fi).w = _PrintWidth("<None of the above>")
78.             itemBtn(fi).text = "<None of the above>"
79.         End If
80.         If itemBtn(fi).w > listWidth Then
81.             listWidth = itemBtn(fi).w
82.         End If
83.     Next fi
84.  
85.     Line (xPos, yPos)-(xPos + listWidth, yPos + _FontHeight * (UBound(itembtn) + 1)), _RGB32(50), BF
86.  
87.     For fi = 0 To UBound(itembtn)
88.         _PrintMode _KeepBackground
89.         _PrintString (itemBtn(fi).x, itemBtn(fi).y), itemBtn(fi).text
90.     Next fi
91.     Do
92.  
93.         While _MouseInput: Wend
94.         mouseXPos = _MouseX
95.         mouseYPos = _MouseY
96.         If _MouseButton(1) Then
97.             For fi = 0 To UBound(itemBtn)
98.                 If RectCollide(mouseXPos, mouseYPos, 1, 1, itemBtn(fi).x, itemBtn(fi).y, itemBtn(fi).w, itemBtn(fi).h) Then
99.                     pickedOne = 1
100.                     PickFromList = fi
101.  
102.                 End If
103.             Next fi
104.         End If
105.     Loop Until pickedOne = 1
106.     _PrintMode _FillBackground
107.  
108. End Function
109.  
110. FUNCTION RectCollide (rect1X as integer,rect1Y as integer,rect1Width as integer,rect1Height as integer,_
111.                       rect2X as integer,rect2Y as integer,rect2Width as integer,rect2Height as integer)
112.  
113.     Dim rect1X2 As Integer
114.     Dim rect1Y2 As Integer
115.     Dim rect2X2 As Integer
116.     Dim rect2Y2 As Integer
117.  
118.     rect1X2 = rect1X + rect1Width - 1
119.     rect1Y2 = rect1Y + rect1Height - 1
120.     rect2X2 = rect2X + rect2Width - 1
121.     rect2Y2 = rect2Y + rect2Height - 1
122.  
123.     RectCollide = 0
124.     If rect1X2 >= rect2X Then
125.         If rect1X <= rect2X2 Then
126.             If rect1Y2 >= rect2Y Then
127.                 If rect1Y <= rect2Y2 Then
128.                     RectCollide = -1
129.                 End If
130.             End If
131.         End If
132.     End If
133.  
134. End Function
135.  
136.  
137. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
138.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
139.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
140.     dpos = InStr(curpos, SplitMeString, delim)
141.     Do Until dpos = 0
142.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
143.         arrpos = arrpos + 1
144.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
145.         curpos = dpos + LD
146.         dpos = InStr(curpos, SplitMeString, delim)
147.     Loop
148.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
149.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
150. End Sub
151.  
152.  

[bplus]

Well that's interesting, treating a mouse point as a box and recycling code you have for box collisions.

Finding out if a point is inside a box is so easy who would think to make a tool of it? And yet it could be time saver if did have such a tool.

Have you actually tried this for different sized fonts because I am seeing a 16 for a y dim so that is depending on default font @ 8x16 and I am seeing a _FontHeight function being employed?

And what happens when the list has more rows than screen can fit?

Well I am sure it's good for allot of things.

[Pete]

It certainly works as advertised, but I don't think this method would be my choice for graphics menu builds, but it's always interesting to see different techniques. Since I don't work in graphics, SCREEN 0 only, I might be missing something here. So I'm wondering if this is more a case of, "Just because you can, doesn't mean you should." or if there is a special significance, which would make this technique more elegant than other graphic menu methods.?

Pete

[191Brian]

Well that's interesting, treating a mouse point as a box and recycling code you have for box collisions.

Finding out if a point is inside a box is so easy who would think to make a tool of it? And yet it could be time saver if did have such a tool.

Have you actually tried this for different sized fonts because I am seeing a 16 for a y dim so that is depending on default font @ 8x16 and I am seeing a _FontHeight function being employed?

And what happens when the list has more rows than screen can fit?

Well I am sure it's good for allot of things.

Hi bolus

Yes it currently has a few limitations but thought it was reasonably neat light weight cross platform solution. Thanks for pointing out i missed changing the 16 to _fontheight in the ypos calc.I have thoughts on a scrollable version for when the list is to long for the screen size.

[191Brian]

It certainly works as advertised, but I don't think this method would be my choice for graphics menu builds, but it's always interesting to see different techniques. Since I don't work in graphics, SCREEN 0 only, I might be missing something here. So I'm wondering if this is more a case of, "Just because you can, doesn't mean you should." or if there is a special significance, which would make this technique more elegant than other graphic menu methods.?

Pete

Hi Pete

I am new to QB64 so I am not aware of other cross platform graphic menu methods apart from the excellent Inform but that is quite heavy weight. I will definitely be using it in some of my programs to make them more user friendly especially for those aimed at the younger generation.

[bplus]

I like this project so much I tried it myself :)  (v1.5 specially for ReDim's)

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Get Button Menu" 'bplus 2021-03-11
3. ' B+ 2021-03-11 Rewrite 191Brian list picker  https://www.qb64.org/forum/index.php?topic=3730.msg130862#msg130862
4. ' assuming default font 8x16
5.  
6. 'Globals here, Cap first letters
7. Type Button
8.     As Long x, y, w, h
9.     text As String
10.     As _Unsigned Long FC, BC
11. End Type
12.  
13. Screen _NewImage(800, 620, 32)
14. _Delay .25 'give screen time to load before
15. _ScreenMove _Middle
16.  
17. 'locals for main event code, keep locals lowercase on first letter
18. ReDim As Long i, nMonths, nDays, nYears, mx, my, mb
19. ReDim monthNames$, monthPick$, years$, yearPick$, days$, dayPick$
20. ReDim months$(1 To 1) '<<<<<<<<<<<< don't need to know in advance the number of items in split sting  but good to start at 1
21. ReDim monthButtons(1 To 1) As Button
22. ReDim yearButtons(1 To 1) As Button
23. ReDim dayButtons(1 To 1) As Button
24. For i = 1 To 31 'create days and years strings
25.     If i = 1 Then years$ = TS$(2000 + i) Else years$ = years$ + "," + TS$(2000 + i)
26.     If i = 1 Then days$ = TS$(i) Else days$ = days$ + "," + TS$(i)
27. Next
28. monthNames$ = "January,February,March,April,May,June,July,August,September,October,November,December"
29. MakeButtons &HFFFF8888, &HFF880000, 300, 0, years$, yearButtons()
30. MakeButtons &HFF88FF88, &HFF008800, 369, (_Height - 12 * 25) / 2, monthNames$, monthButtons()
31. MakeButtons &HFF8888FF, &HFF0000FF, 478, 0, days$, dayButtons()
32. nYears = UBound(yearButtons)
33. nMonths = UBound(monthButtons)
34. nDays = UBound(dayButtons)
35.  
36. ''check the making all good!
37. 'For i = 1 To nMonths
38. '    Print MonthButtons(i).x, MonthButtons(i).y, MonthButtons(i).w, MonthButtons(i).h, MonthButtons(i).text
39. 'Next
40. 'End
41.  
42. Do
43.     Cls
44.     Print "Last Date Picked: " + yearPick$ + "-" + monthPick$ + "-" + dayPick$
45.     For i = 1 To nYears
46.         DrawButton yearButtons(i)
47.     Next
48.     For i = 1 To nMonths
49.         DrawButton monthButtons(i)
50.     Next
51.     For i = 1 To nDays
52.         DrawButton dayButtons(i)
53.     Next
54.  
55.     While _MouseInput: Wend ' might want mouse for other things besides checking a button click
56.     mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
57.     If mb Then
58.         For i = 1 To nYears
59.             If InBoxTF&(mx, my, yearButtons(i)) Then yearPick$ = yearButtons(i).text: GoTo continue
60.         Next
61.         For i = 1 To nMonths
62.             If InBoxTF&(mx, my, monthButtons(i)) Then monthPick$ = monthButtons(i).text: GoTo continue
63.         Next
64.         For i = 1 To nDays
65.             If InBoxTF&(mx, my, dayButtons(i)) Then dayPick$ = dayButtons(i).text: GoTo continue
66.         Next
67.     End If
68.  
69.     continue:
70.     _Display
71.     _Limit 60
72. Loop Until _KeyDown(27)
73.  
74. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
75.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
76.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
77.     dpos = InStr(curpos, SplitMeString, delim)
78.     Do Until dpos = 0
79.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
80.         arrpos = arrpos + 1
81.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
82.         curpos = dpos + LD
83.         dpos = InStr(curpos, SplitMeString, delim)
84.     Loop
85.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
86.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
87. End Sub
88.  
89. Function InBoxTF& (x, y, b As Button)
90.     If x >= b.x And x <= b.x + b.w Then
91.         If y >= b.y And y <= b.y + b.h Then InBoxTF& = -1
92.     End If
93. End Function
94.  
95. Sub DrawButton (b As Button)
96.     ReDim As _Unsigned Long FC, BC
97.     Line (b.x, b.y)-Step(b.w, b.h), b.BC, BF
98.     Line (b.x, b.y)-Step(b.w, b.h), b.FC, B
99.     FC = _DefaultColor: BC = _BackgroundColor
100.     Color b.FC, b.BC
101.     _PrintString ((b.x + (b.w - 8 * Len(b.text)) / 2), b.y + (b.h - 16) / 2), b.text
102.     Color FC, BC
103. End Sub
104.  
105. Sub MakeButtons (fore As _Unsigned Long, back As _Unsigned Long, X As Long, Y As Long, CommaDelimitedList$, arr() As Button)
106.     ReDim As Long items, i, lngItem
107.     ReDim list$(1 To 1)
108.     Split CommaDelimitedList$, ",", list$()
109.     items = UBound(list$)
110.  
111.     'what's longest item?
112.     For i = 1 To items
113.         If Len(list$(i)) > lngItem Then lngItem = Len(list$(i))
114.     Next
115.     ReDim arr(1 To items) As Button ' make month buttons
116.     For i = 1 To items
117.         arr(i).x = X
118.         arr(i).y = Y + 20 * (i - 1)
119.         arr(i).w = 8 * (lngItem + 4)
120.         arr(i).h = 18 'assuming default font
121.         arr(i).text = list$(i)
122.         arr(i).FC = fore
123.         arr(i).BC = back
124.     Next
125. End Sub
126.  
127. Function TS$ (n As Long)
128.     TS$ = _Trim$(Str$(n))
129. End Function
130.  

[191Brian]

Hi Bplus

Great work.