Mistrel,
I made a slight change to your code and the lines display correctly now
function Menu_Make()
dim qMenu(0) as tMenu `qMenu global array
dim qChildList(0) as tChildList `qChildList global array
endfunction
type tMenu `Use (0) as count
name as string `The name of the element for this menu
parent as string `The name of the parent menu of this element
group as string `The name of the quad group associated with this menu
quad as integer `The quadrant associated with this menu
count as integer `Used only for qMenu(0), to keep track of the total number of elements
x as integer `The screen x coord of the menu
y as integer `The screen y coord of the menu
visible as integer
endtype
type tChildList
count as integer `Count stores the total number of indexes within the array within index 0
gc as integer `Group Count, stores the total number of sub menu groups that are visible
index as integer `Index stores the index number that points to an index in qMenu()
endtype
`----------------------------------------------------
` Add Menu
`----------------------------------------------------
function Add_Menu(parent$,name$,group$)
array insert at bottom qMenu()
i=qMenu(0).count+1
qMenu(0).count=i
qMenu(i).name=name$
qMenu(i).parent=parent$
qMenu(i).group=group$
endfunction
`----------------------------------------------------
` Draw Menu
`---------------------------------------------------
function DrawMenu(group$,x,y,handle) `handle, 1=handle, 0=no handle
for i=1 to qMenu(0).count
if qMenu(i).group=group$
n=n+1
if n=1
qmt$=qMenu(i).name `qMenu top, first on. This is required to properly adjust padding on top
qmti=i `qMenu Index, stores at which index the first element is found
if qMenu(i).parent="root"
qmri=i `qMenu Root Index, stores at which index the first element is found
endif
endif
endif
if mouseclick()=0 && cma=1
Global cmr=1 `Context Menu Release, identifies when the rmb has been released for the first time after calling the menu
endif
if mouseclick()=2
if cmi<1 `See global declaration
if qMenu(i).parent="root"
rdx=-15 `Root Displacement X, displacement of menu from bottom left corner of handle bar on create
rdy=6 `Root Displacement Y
qMenu(qmri).x=MouseX()+rdx
qMenu(qmri).y=MouseY()+rdy
ClearChildMenus()
endif
Global cma=1 `Context Menu Active
cmi=1 `See global declaration
endif
if cmr=1 `See global declaration
ClearAllMenus()
cmr=0 `See global declaration
endif
endif
if qMenu(i).parent<>"root" && x<>0 && y<>0
cx=x `Context Menu X, this variable stores the x position of the menu throughout the function
cy=y `Context Menu Y
else
cx=qMenu(qmri).x
cy=qMenu(qmri).y
endif
next i
if cma=1 `see global declaration for explanation
mpl=14 `menu padding left
mpr=45 `menu padding right
mpt=6 `menu padding topmost/bottommost, use a number divisible by 2, this will be the padding on the top and bottom
mh=-13 `menu handle height, use negative values
mhpr=4 `menu handle padding right
mpra=7 `menu padding to the right of sub menu arrow
if handle=0
mhm=0 `menu handle mask height
else
mhm=mh
endif
for i=1 to qMenu(0).count
if qMenu(i).group=group$
menuh=menuh+d3d_gettextheight(1,qMenu(i).name)+mpt `Add the height of each index + padding and return the background box height
n=d3d_gettextwidth(1,qMenu(i).name) `Get the text width for the .name in the current loop
if menuw-mpl-mpr < n `If the new text width is greater than the last found
menuw=n+mpl+mpr `Then set this as the menu width and add padding to it
endif
endif
next i
menuh=menuh-mpt `Subtract the padding from the top, this is meant to be added only once later
colourD3D(2) `Menu border
rem Cloggy - Changed following lines
d3d_line cx-1,cy-1,cx+menuw,cy-1
d3d_line cx+menuw,cy,cx+menuw,cy+menuh+mpt
d3d_line cx+menuw-1,cy+menuh+mpt,cx-1,cy+menuh+mpt
d3d_line cx-1,cy+menuh+mpt,cx-1,cy-1
colourD3D(1) : d3d_box cx,cy,cx+menuw,cy+menuh+mpt `menu background
if handle=1 `Handle=1 draws the context menu handle with the group name, otherwise it isn't drawn at all (use handle=0)
for i=1 to qMenu(0).count `Loop through each each index, 1-i(0). The index 0 always stores the total
if qMenu(i).group=group$
colourD3D(2) `Handle border
d3d_line cx-1,cy+mh-1,cx+menuw,cy+mh-1
rem Cloggy - Changed following line
d3d_line cx+menuw,cy+mh,cx+menuw,cy-1
d3d_line cx-1,cy+mh,cx-1,cy-1
colourD3D(3) : d3d_box cx,cy+mh,cx+menuw,cy-1 `Menu handle
colourD3D(0)
d3d_starttext
d3d_text 3,cx+menuw,cy+mh,2,group$ `Group$ name drawn inside the menu handle
d3d_endtext
i=qMenu(0).count `break
endif
next i
endif
for i=1 to qMenu(0).count
if qMenu(i).group=group$ `I'm only interested in the group values associated with the current draw_menu group$
colourD3D(0)
d3d_starttext
if qMenu(i).name=qmt$ `If .name is the first on the list to be drawn..
d3d_text 1,cx+mpl,cy+texth+(mpt/2),0,qMenu(i).name `Add a modified padding to it
texth=texth+d3d_gettextheight(1,qMenu(i).name)+(mpt/2)
else
d3d_text 1,cx+mpl,cy+texth+mpt,0,qMenu(i).name `For all other names use the default padding
texth=texth+d3d_gettextheight(1,qMenu(i).name)+mpt
endif
endif
`d3d_endtext -> moved to below d3d_box to be drawn on top. An effective d3d_ bug!
mx=MouseX()
my=MouseY()
colourD3D(3) `Mouse hover
if mx>cx-1 && mx<cx+menuw+2 && my>cy+mhm-2 && my<cy+menuh+mpt+2 && qMenu(i).group=group$ `This mouse hook radius which includes the handle, unlike the later w/2px buffer
Global mhc=1 `Menu Hover Check, if mhc=0 after one complete loop then the mouse is not hovering over any menus
if mouseclick()=1
Global cmc=1 `context menu click, saves the cm when it is clicked and mouse leaves. This allows the user to left click and drag and leave the cm without it closing
endif
`colourD3D(4) : d3d_box cx-1,cy+mhm-2,cx+menuw+2,cy+menuh+mpt+2 `uncomment to see hover-mask
if mx>cx-1 && mx<cx+menuw+2 && my>cy+texth-d3d_gettextheight(1,qMenu(i).name)-(mpt/2) && my<cy+texth+(mpt/2)+1 && qMenu(i).group=group$
`colourD3D(4) : d3d_box cx-1,cy+texth-d3d_gettextheight(1,qMenu(i).name)-(mpt/2),cx+menuw+2,cy+texth+(mpt/2)+1 `uncomment to see hover-mask
for n=1 to qMenu(0).count `Loop through all indexes of the qMenu and create an array of indexes of all elements within the the group that the mouse is currently hovering over
if qMenu(i).group=qMenu(n).group `If the local qMenu.group == the qMenu.group of the group the mouse is currently hovering over
AddToChildList(n)
endif
next n
if mouseclick()=1 && tsm=qChildList(0).gc && mhc=1
a$=qMenu(i).name
Global return$=a$
mmsgbox(a$)
endif
for n=1 to qMenu(0).count `This loop runs through qChildList and adds any indexes that are missing for all visible groups. The mouse-hovered index is the only one added to the array the first time
for a=1 to qChildList(0).count `Loop through every index in the qChildList array
if qMenu(qChildList(a).index).name=qMenu(n).parent `If the .name of the index stored by qChildList == .parent value of the encapsulating loop then this group (the parent of referenced .name) is visible
for b=1 to qChildList(0).count `Loop through the current qChildList array
if qChildList(b).index=n `If the current index is already in the array
exists=1
endif
if b=qChildList(0).count && exists=0 `If b has finished looping and the index is not in the array
AddToChildList(n)
`n=0
endif
next b
exists=0
endif
next a
next n
for n=1 to qChildList(0).count `This loop prevents adjacent sub menus from dissapearing because "root", the parent of the first sub menu cannot be compared to visible because it always ==0
if qMenu(qChildList(n).index).visible=1 && qMenu(i).name<>qMenu(qChildList(n).index).parent `If the current menu .name does not have a visible .parent
if qMenu(i).group<>qMenu(qChildList(n).index).group `And the menu is not equal to the one currently being drawn
qMenu(qChildList(n).index).visible=0 `This menu is no longer visible
endif
endif
next n
if qMenu(i).group=group$
d3d_box cx,cy+texth-d3d_gettextheight(1,qMenu(i).name)-(mpt/2),cx+menuw,cy+texth+(mpt/2) `menu mouseover highlight
for n=1 to qMenu(0).count `Loop through each each index
if qMenu(n).parent=qMenu(i).name `Check to see if the current menu of this loop .name is a child of the current menu in the main loop, if yes, continue
qMenu(n).visible=1 `Do not set 1 to 0!
qMenu(n).x=cx+menuw+1
qMenu(n).y=cy+texth+mh-(mpt/2)
n=qMenu(0).count
endif
next n
endif
qChildList(0).count=0 `Empty this array for the next loop (all arrays are global)
dim qChildList(0) as tChildList
endif
endif
if qMenu(i).group=group$
colourD3D(0)
for n=1 to qMenu(0).count `Loop through each each index
if qMenu(n).parent=qMenu(i).name && lfapn$<>qMenu(i).name `Check to see if the current menu name is a parent if yes, continue
dw=d3d_gettextwidth(1,qMenu(i).name)+mpr-mpra-4 `Dot Width, Get the text width and add padding right, subtract mpra, and 4px for arrow width
dh=texth-d3d_gettextheight(1,qMenu(i).name) `Dot displacement by 1/2 height of text
dmpt=mpt+dh `Dot Menu Padding Top, Adjust dot dist from top if .name is first on the list
d3d_dot cx+dw+mpl,cy+dmpt : d3d_dot cx+dw+mpl-1,cy+dmpt : d3d_dot cx+dw+mpl-2,cy+dmpt
d3d_dot cx+dw+mpl-3,cy+dmpt : d3d_dot cx+dw+mpl-1,cy+dmpt+1 : d3d_dot cx+dw+mpl-1,cy+dmpt-1
d3d_dot cx+dw+mpl-2,cy+dmpt+1 : d3d_dot cx+dw+mpl-2,cy+dmpt+2 : d3d_dot cx+dw+mpl-2,cy+dmpt-1
d3d_dot cx+dw+mpl-2,cy+dmpt-2 : d3d_dot cx+dw+mpl-3,cy+dmpt+3 : d3d_dot cx+dw+mpl-3,cy+dmpt-1
d3d_dot cx+dw+mpl-3,cy+dmpt-2 : d3d_dot cx+dw+mpl-3,cy+dmpt-3 : d3d_dot cx+dw+mpl-3,cy+dmpt+1
d3d_dot cx+dw+mpl-3,cy+dmpt+2
lfapn$=qMenu(i).name `Last Found Arrow Parent Name, used to prevent overdraw of the same parent arrow throughout the loop
endif
next n
endif
d3d_endtext
next i
if qMenu(qmri).parent="root"
for n=1 to qMenu(0).count `Loop through each each index
if qMenu(n).visible=1 `If submenu is visible and is not equal to the menu in the main loop (to prevent an infinite loop), continue
`mmsgbox("1")
qChildList(0).gc=qChildList(0).gc+1
DrawMenu(qMenu(n).group,qMenu(n).x,qMenu(n).y,1)
endif
next n
endif
endif
if mouseclick()=0 `If the mouse button is up and it leaves the menu radius
Global cmi=0 `Context menu i, increments as long as the rmb is held down
cmc=0 `See global declaration for more information
return$=""
endif
if mouseclick()=1 && tsm=qChildList(0).gc && mhc=0 && cmc=0
ClearAllMenus()
endif
if cma=1
for i=1 to qMenu(0).count `Loop through each each index, 1-i(0). The index 0 always stores the total
if qMenu(i).group=group$ && qMenu(i).parent="root"
a=qChildList(0).gc
Global tsm=a `Total Sub Menus, when tsm==qChildList(0).gc then root and all sub menus have been drawn
qChildList(0).gc=0
mhc=0 `See global declaration for more information
i=qMenu(0).count `break
endif
next i
endif
endfunction
`----------------------------------------------------
` Update Menu
`----------------------------------------------------
function Menu_Update()
font(1)
if qMenu(0).count>0 `Check to see if there is a menu to draw
for i=1 to qMenu(0).count `This loop identifies the group name that is associated with the default (root) menu and then draws it
if qMenu(i).parent="root"
DrawMenu(qMenu(i).group,0,0,1)
i=qMenu(0).count `break
endif
next i
endif
endfunction
function colourD3D(num)
if num=0 then d3d_color 0,0,0,255 `text
if num=1 then d3d_color 191,191,191,255 `body
if num=2 then d3d_color 0,0,0,255 `menu border
if num=3 then d3d_color 128,128,128,255 `handle
if num=4 then d3d_color 255,0,0,25 `hover mask
endfunction
function AddToChildList(index)
array insert at bottom qChildList()
i=qChildList(0).count+1 `Find the current array count and add 1
qChildList(0).count=i `And make that the new count
qChildList(i).index=index `Add the index found of the equivilant group to the child list, this index is one of the elements of the group that the mouse is currently hovering over.
endfunction
function AddToChildGroupCount()
array insert at bottom qChildList()
i=qChildList(0).gc+1 `Find the current array count and add 1
qChildList(0).gc=i `And make that the new count
endfunction
function ClearChildMenus()
for n=1 to qMenu(0).count `This loop resets the visibility of all sub menus
if qMenu(n).visible=1
qMenu(n).visible=0
endif
next n
endfunction
function ClearAllMenus() `This loop resets the visibility of all menus
cma=0 `See global declaration for more information
ClearChildMenus()
endfunction
Function SetupMenu()
Menu_Make()
Add_Menu("root","Element A","test group")
Add_Menu("root","Element B","test group")
Add_Menu("root","Element C","test group")
Add_Menu("root","Element D","test group")
Add_Menu("root","Element E","test group")
Add_Menu("root","Element F","test group")
Add_Menu("root","Element G","test group")
Add_Menu("Element B","Sub Element Ba","sub test group B")
Add_Menu("Element B","Sub Element Bb","sub test group B")
Add_Menu("Element B","Sub Element Bc","sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Ba","sub sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Bb","sub sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Bc","sub sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Bd","sub sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Be","sub sub test group B")
Add_Menu("Sub Element Ba","Sub Sub Element Bf","sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Ba","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Bb","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Bc","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Bd","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Be","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Bf","sub sub sub test group B")
Add_Menu("Sub Sub Element Ba","Sub Sub Sub Element Bg","sub sub sub test group B")
Add_Menu("Element E","Sub Element Ea","sub test group E")
Add_Menu("Element E","Sub Element Eb","sub test group E")
Add_Menu("Element E","Sub Element Ec","sub test group E")
EndFunction
This appears to work for me. I do get problems if I use a display resolution that doesn't match my LCD's native resolution, but I would expect that.
Cheers,
Cloggy
