[bb] Improved Dropdown (v2.0) by MadMunky [ 1+ years ago ]

[BlitzBot]

Title : Improved Dropdown (v2.0)
Author : MadMunky
Posted : 1+ years ago

Description : Yahfree, I hope it's ok with you that I took the liberty of giving your dropdown an overhaul? Anyways, here it is
I changed a lot compared to your version. Sorting, key-browsing, scrollmouse, styles, fonts, ... . And you can add an ID+value to each dropdown element now.

Thanks again, Yahfree.

Code :

Code (blitzbasic) Select Expand

Graphics 800, 600, 0, 2

;----------------------------------
;             DROPDOWN
;        By Wishbone/Madmunky
;    Special thanks to Yahfree ;)
;
Const DD_UNORDERED = 0, DD_ORDERBYID = 1, DD_ORDERBYVALUE = 2

Global dd_CursorX, dd_CursorY, dd_ListLast$, dd_fontheight
Global dd_MouseHold, dd_screenGFX = CreateImage(GraphicsWidth(), GraphicsHeight())

Type dd_list
Field id%
Field valueRaw$
Field name$, value$
Field orderedBy%
End Type

Type dd_DropDown
Field id%
Field name$, value$
Field width%, height%
Field style%
Field scrolly#, shown#
Field x%, y%
End Type

Function dd_createDropDown$(dd_id, dd_style=0, dd_height=14)
While MouseDown(1): Wend

dd_fontheight = FontHeight()+4

dd_d.dd_DropDown = New dd_DropDown
dd_did = dd_id

i = 0: dd_dwidth = 0
For dd_L.dd_list = Each dd_list
If dd_Lid = dd_id
i = i+1
If dd_dwidth < StringWidth(dd_Lvalue) Then dd_dwidth = StringWidth(dd_Lvalue)
EndIf
Next
dd_dwidth = dd_dwidth+22
dd_dheight = dd_height
dd_heightorig = dd_height
If dd_dheight > i Or (dd_dheight < i And dd_heightorig > dd_dheight) Then dd_dheight = i

dd_dx = MouseX()
dd_dy = MouseY()-dd_fontheight+2
If dd_dx+dd_dwidth > GraphicsWidth() Then dd_dx = GraphicsWidth()-dd_dwidth-1
If dd_dy+dd_fontheight*(dd_dheight+1) > GraphicsHeight() Then dd_dy = MouseY()-(dd_fontheight*(dd_dheight+1))-1

dd_dscrolly = dd_dy+dd_fontheight
dd_dstyle = dd_style
dd_dshown = dd_dy
dd_d
ame = ""
dd_dvalue = ""

res$ = dd_drawDropDowns()
Return res$
End Function

Function dd_drawDropDown(dd_d.dd_DropDown, dd_md=False)
dd_id = dd_did
dd_scrolly# = dd_dscrolly
dd_shown# = dd_dshown
dd_x = dd_dx
dd_y = dd_dy
dd_name$ = dd_d
ame$
dd_value$ = dd_dvalue$
dd_style = dd_dstyle
dd_width = dd_dwidth
dd_height = dd_dheight
dd_heightorig = dd_dheight
dd_colR = 0
dd_colG = 0
dd_colB = 0
dd_buttonwidth = 15
dd_hold = False

If Not(dd_md) Then dd_MouseHold = False

Select dd_style
Case 0: c1=255: c2=128
Case 1: c1=224: c2=64
End Select
Color c1, c1, c1
Rect dd_x-1, dd_y+dd_fontheight-2, dd_width-dd_buttonwidth+2, dd_height*dd_fontheight+3

Color c2, c2, c2
Rect dd_x-1, dd_y+dd_fontheight-2, dd_width-dd_buttonwidth+2, dd_height*dd_fontheight+3, False
Line dd_x, dd_y+(dd_height+1)*dd_fontheight+1, dd_x+dd_width-dd_buttonwidth, dd_y+(dd_height+1)*dd_fontheight+1

Line dd_x+dd_width-dd_buttonwidth+1, dd_y+dd_fontheight-1, dd_x+dd_width-dd_buttonwidth+1, dd_y+(dd_height+1)*dd_fontheight+1

st = -1
k$=Lower$(Chr$(GetKey()))
If k$ >= "a" And k$ <= "z"
i=0
For dd_l.dd_list = Each dd_list
If dd_lid=dd_id
i1 = 1
Repeat
k1$=Lower$(Mid$(dd_lvalue, i1, 1))
i1 = i1+1
Until i1 > Len(dd_lvalue) Or (k1$ >= "a" And k1$ <= "z")
If k1$ = k$
st = i*dd_fontheight
Exit
ElseIf k1$ < k$
st = i*dd_fontheight
EndIf
i=i+1
EndIf
Next
EndIf

Viewport dd_x, dd_y+dd_fontheight, dd_width-dd_buttonwidth, dd_height*dd_fontheight-1
i=0
For dd_l.dd_list = Each dd_list
If dd_lid=dd_id
i=i+1
If RectsOverlap(dd_x, dd_shown+(i*dd_fontheight), dd_width-dd_buttonwidth, dd_fontheight, dd_CursorX, dd_CursorY, 1, 1)
If dd_lvalue<>"s"
If RectsOverlap(dd_x, dd_y+dd_fontheight, dd_width-dd_buttonwidth, dd_height*dd_fontheight-1, dd_CursorX, dd_CursorY, 1, 1)
Color 0, 0, 128
Rect dd_x+1, dd_shown+(i*dd_fontheight), dd_width-dd_buttonwidth-2, dd_fontheight
If dd_MouseHold = False
If dd_md And MouseDown(2) = False
While MouseDown(1): Wend
dd_md = False
dd_name$=dd_l
ame
dd_value$=dd_lvalue
dd_shown=dd_y
dd_scrolly=dd_y+dd_fontheight
Exit
EndIf
EndIf
Color c1, c1, c1
EndIf
EndIf
Else
Color dd_colR, dd_colG, dd_colB
End If
If dd_lvalue="s"
Color 192, 192, 192
Line dd_x+4, dd_shown+((i+0.5)*dd_fontheight), dd_x+dd_width-dd_buttonwidth-5, dd_shown+((i+0.5)*dd_fontheight)
Else
t = Instr(dd_lvalue, " ")
If t > 0
v1$ = Mid$(dd_lvalue, 1, t-1)
v2$ = Mid$(dd_lvalue, t+2)
Else
v1$ = dd_lvalue
EndIf

Text dd_x+4, dd_shown+(i*dd_fontheight)+2, v1$
If t > 0 Then Text dd_x+dd_width-dd_buttonwidth-StringWidth(v2$)-4, dd_shown+(i*dd_fontheight)+2, v2$
EndIf
End If
Next

Viewport 0, 0, GraphicsWidth(), GraphicsHeight()
If i>dd_height
mzs = MouseZSpeed(): mz = MouseZ()
If mz = 0 And (mzs < -1 Or mzs > 1) Then mzs = 0 ;Stupid Windows bug

Color c1, c1, c1
Rect dd_x+dd_width-dd_buttonwidth, dd_y+dd_fontheight-2, dd_buttonwidth+1, dd_height*dd_fontheight+3, True
Color c2, c2, c2
Rect dd_x+dd_width-dd_buttonwidth, dd_y+dd_fontheight-2, dd_buttonwidth+1, dd_height*dd_fontheight+3, False
Line dd_x+dd_width-dd_buttonwidth, dd_y+(dd_height+1)*dd_fontheight+1, dd_x+dd_width, dd_y+(dd_height+1)*dd_fontheight+1
Line dd_x+dd_width+1, dd_y+dd_fontheight-1, dd_x+dd_width+1, dd_y+(dd_height+1)*dd_fontheight+1

Color 192, 192, 192
Rect dd_x+dd_width-dd_buttonwidth+2, dd_scrolly, dd_buttonwidth-3, dd_fontheight-1, True
If dd_md
If RectsOverlap(dd_x+dd_width-dd_buttonwidth, dd_y+dd_fontheight, dd_buttonwidth, dd_height*dd_fontheight, dd_CursorX, dd_CursorY, 1, 1)
dd_MouseHold = True
EndIf
EndIf
If dd_MouseHold = True Then dd_scrolly = MouseY() - dd_yo
dd_scrolly = dd_scrolly-mzs*8

dd_ScrollbarMax# = dd_y+dd_height*dd_fontheight-dd_y-dd_fontheight
dd_ListSize = (i - dd_height) * dd_fontheight
If st <> -1
dd_shown = dd_y - st
dd_ScrollbarPos# = (dd_y - dd_shown) * (dd_scrollbarmax / dd_ListSize) + dd_fontheight
dd_scrolly = dd_y + dd_ScrollbarPos
EndIf
If dd_scrolly < dd_y+dd_fontheight Then dd_scrolly=dd_y+dd_fontheight
If dd_scrolly > dd_y+dd_height*dd_fontheight Then dd_scrolly=dd_y+dd_height*dd_fontheight
dd_ScrollbarPos# = dd_ScrollY - dd_y - dd_fontheight
dd_shown = dd_y - (1.0 * dd_scrollbarpos * dd_ListSize / dd_scrollbarmax)
End If

dd_dscrolly = dd_scrolly
dd_dshown = dd_shown
dd_d
ame$ = dd_name$
dd_dvalue$ = dd_value$
End Function

Function dd_drawDropDowns$()
While MouseDown(1) Or MouseDown(2): Wend

GrabImage dd_screenGFX, 0, 0
Repeat
DrawBlock dd_screenGFX, 0, 0
dd_CursorX = MouseX()
dd_CursorY = MouseY()
dd_md = (MouseDown(1) Or MouseDown(2))
dd_name$ = "~"
For dd_d1.dd_DropDown = Each dd_DropDown
dd_drawDropDown(dd_d1.dd_DropDown, dd_md)
dd_name$ = dd_d1
ame$
Next
If ((dd_md) And dd_MouseHold = False) Or KeyDown(1) Or (dd_name$ <> "" And dd_name$ <> "~")
While MouseDown(1) Or MouseDown(2): Wend
FlushMouse: FlushKeys
dd_deleteDropDowns()
EndIf

Flip
Delay 5
Until dd_name$<>""
DrawBlock dd_screenGFX, 0, 0
If dd_name$ = "~" Then Return "" Else Return dd_name$
End Function

Function dd_deleteDropDowns()
For dd_d1.dd_DropDown = Each dd_DropDown
dd_deleteList(dd_d1id)
Delete dd_d1
Return True
Next
Return False
End Function

Function dd_getDropDownName$()
For dd_d1.dd_DropDown = Each dd_DropDown
Return dd_d1.dd_DropDown
ame$
Next
Return ""
End Function

Function dd_getDropDownValue$()
For dd_d1.dd_DropDown = Each dd_DropDown
Return dd_d1.dd_DropDownvalue$
Next
Return ""
End Function

;dd_orderedBy
;0 = unordered
;1 = name
;2 = value
Function dd_addToList.dd_list(dd_id, dd_name$, dd_value$, dd_orderedBy=DD_UNORDERED)
For l1.dd_list = Each dd_list
If l1id = dd_id And l1
ame = dd_name Then Return Null
Next
l.dd_list = New dd_list
lid = dd_id
lorderedBy = dd_orderedBy
lvalueRaw = dd_value
l
ame = dd_name
lvalue = dd_filterString(dd_value)

For l1.dd_list = Each dd_list
Select lorderedBy
Case 1:
If Lower$(l
ame) < Lower$(l1
ame) Then Insert l Before l1: Exit
Case 2:
If Lower$(lvalueRaw) < Lower$(l1valueRaw) Then Insert l Before l1: Exit
End Select
Next

Return l
End Function

Function dd_deleteList(dd_id)
For l.dd_list = Each dd_list
If lid = dd_id Then Delete l
Next
End Function

Function dd_filterString$(s$)
i=1: While Mid$(s$, i, 1) = "!": i = i+1: Wend
Return Mid$(s$, i)
End Function
;
;         END OF DROPDOWN
;----------------------------------


;----------------------------------
;          EXAMPLE CODE
;
SeedRnd MilliSecs()

SetBuffer BackBuffer()

font = LoadFont("Courier New", 15, True)
font1 = LoadFont("Arial", 14)
font2 = LoadFont("Arial", 24)

ClsColor 224, 224, 224

While Not KeyHit(1)
Cls

SetFont font
Color 0, 0, 0
Text 65, 50, "Click box to open dropdown #1"
Text 465, 50, "Click box to open dropdown #2"
Text 65, 100, "Click box to open dropdown #3"

Color 255, 0, 0
Rect 50, 50, 12, 12, True
Rect 450, 50, 12, 12, True
Rect 50, 100, 12, 12, True

If MouseHit(1)

;Dropdown example #1
;The " " in the dd_addToList makes all following text align to the right.
;The "s" in the dd_addToList generates a line separator.
;The second parameter in the dd_CreateDropDown function is the dropdown style. Only 0 or 1 at the moment.
;The third parameter in the dd_CreateDropDown function is the length of the dropdown.
If RectsOverlap(50, 50, 12, 12, MouseX(), MouseY(), 1, 1)
dd_addToList(1, "cut", "Cut (Ctrl+X)")
dd_addToList(1, "copy", "Copy (Ctrl+C)")
dd_addToList(1, "paste", "Paste (Ctrl+V)")
dd_addToList(1, "", "s")
dd_addToList(1, "edit", "Edit (Ctrl+E)")
SetFont font1
dd$ = dd_createDropDown(1, 1, 5): dn = 1
EndIf

;Dropdown example #2
If RectsOverlap(450, 50, 12, 12, MouseX(), MouseY(), 1, 1)
For i = 1 To 100
dd_addToList(2, i, "Item #"+i)
Next
SetFont font1
dd$ = dd_createDropDown(2, 0, 8): dn = 2
EndIf

;Dropdown example #3
;The fourth parameter in the dd_addToList makes it order by the IDs of the list (in this case; A, B, C, etc...)
If RectsOverlap(50, 100, 12, 12, MouseX(), MouseY(), 1, 1)
dd_addToList(3, "D", "1 Daisy", DD_ORDERBYID)
dd_addToList(3, "B", "2 Bert", DD_ORDERBYID)
dd_addToList(3, "C", "3 Charlotte", DD_ORDERBYID)
dd_addToList(3, "A", "4 Artie", DD_ORDERBYID)
dd_addToList(3, "E", "5 Edward", DD_ORDERBYID)
SetFont font2
dd$ = dd_createDropDown(3): dn = 3
EndIf

EndIf
If dd$ <> ""
SetFont font
Color 255, 0, 0
Text 400, 300, "The selected ID is '"+dd$+"' from dropdown #"+dn, True, True
EndIf
Flip
Wend
;
;        END OF EXAMPLE CODE
;----------------------------------

Comments :


chwaga(Posted 1+ years ago)

 nice


Yahfree(Posted 1+ years ago)

 interesting...No problem with the building off mine