This is done as a mini project for Kimosabi mainly, but posting here as its a pretty usefull snippet...
randomize timer()
`Setup some menu specifics
#constant menuButtonWidth 128
#constant menuButtonHeight 32
#constant menuAlphaOut 96.0
#constant menuAlphaOver 255.0
#constant menuImageRangeStart 1000
`The box color, customizeable
global boxBackColor as DWORD : boxBackColor = rgb(128, 128, 128)
global boxTextColor as DWORD : boxTextColor = rgb(1, 0, 0)
`Set the font wanted for the menu
set text font "Courier New"
set text size 16
set text transparent
set text to bold
`Define a menu node. This is used for every menu entry
Type menuNode
title$
command$
isHeader as boolean
alpha#
imgID as integer
EndType
`Array to store all the menu data
Dim Menu() as menuNode
empty array Menu()
`Create a random set of menu's. 'i' is the number of headers. 'j' is the number of entries under each header
for i = 1 to 4
AddMenuItem("Header "+str$(i), 1)
for j = 1 to rnd(15)+5
AddMenuItem("Entry "+str$(j), 0)
next j
next i
`Display all the menu's
col = -1
array index to top Menu()
while array index valid(Menu())
if Menu().isHeader
inc col
row = 0
center text menuButtonWidth*0.5+col*menuButtonWidth, row * text height(Menu().title$), Menu().title$
inc row
else
center text menuButtonWidth*0.5+col*menuButtonWidth, row * text height(Menu().title$), Menu().title$
inc row
endif
next array index Menu()
endwhile
`Wait for key so user can see all the menu items, next stage is to create the buttons.
wait key
`Prepare to display menu's in real time
sync on
sync rate 0
backdrop on
color backdrop rgb(0,0,0)
cls
`Create all buttons
i = menuImageRangeStart
col = -1
row = 0
array index to top Menu()
while array index valid(Menu())
if Menu().isHeader OR col < 0
inc col,1
row = 0
endif
makeButtonImage(i, Menu().title$, Menu().isHeader, col, row)
inc row
inc i, 1
`Move onto next menu item
next array index Menu()
endwhile
`setup an object in the background to make the menu look more on-top
load image "C:Program FilesDark Basic SoftwareDark Basic ProfessionalMediaTexturesoak_door.BMP", 1
make object plain 1, 20, 20
texture object 1, 1
position object 1, 0, 0, 0
point object 1, 0, 1, 0
autocam off
#constant cDist 4.0
#constant cHeight 6.0
cAngle# = 0.0
position camera sin(cAngle#) * cDist, cHeight, cos(cAngle#) * cDist
point camera 0,0,0
`Create hidden mouse pointer sprite
mSprite = menuImageRangeStart-1
get image mSprite, 0, 0, 1, 1, 1
sprite mSprite, 0, 0, mSprite
hide sprite mSprite
`Remembers the menu being shown
showMenu as integer
showMenu = 0
`Command Clicked on
commandToDo$ = ""
`Display Text
set text font "Arial"
set text size 32
set text to normal
`Code for detecting average framerate
frameTime# = 1.0
startTime = timer()
do
frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
startTime = timer()
`Move camera
inc cAngle#, frameTime# * 0.003
position camera sin(cAngle#) * cDist, cHeight, cos(cAngle#) * cDist
point camera 0,0,0
`Display the command pressed
text screen width() - text width(commandToDo$), screen height() - text height(commandToDo$), commandToDo$
`Start the menu display routine, firstly - the mouse and column initialisation
col = 0
mX = mousex()
mY = mousey()
sprite mSprite, mX, mY, mSprite
`index to top so we can loop through the menu array list
array index to top Menu()
while array index valid(Menu())
`Headers required different actions to normal entries - hence this test here..
if Menu().isHeader
inc col
`Detect if mouse is over new header
if sprite collision(mSprite, Menu().imgID)
showMenu = col
endif
`Highlight this header if the mouse is over, otherwise return it to normal
if showMenu = col
targetAlpha = menuAlphaOver
else
targetAlpha = menuAlphaOut
endif
`Curve the alpha to make the exchange smooth
Menu().alpha# = curveValue(targetAlpha, Menu().alpha#, 100.0 / frameTime#)
`set the alpha for this header
set sprite alpha Menu().imgID, Menu().alpha#
else
`Similar to above, if this menu entry is in the showing column, test for the mouse over, otherwise fade it to hidden
if showMenu = col
`If the mouse if over, set target alpha to the over transparent-ness, otherwise set the target to the see-through transparent-ness
if sprite collision(mSprite, Menu().imgID)
targetAlpha = menuAlphaOver
`alsp while the mouse is over, check for clicks..
if mouseclick() = 1
commandToDo$ = Menu().command$
showMenu = -1
endif
else
targetAlpha = menuAlphaOut
endif
`Curve the alpha to the target value to make smooth exchange
Menu().alpha# = curveValue(targetAlpha, Menu().alpha#, 100.0 / frameTime#)
else
`Curve the alpha to the target value to make smooth exchange
Menu().alpha# = curveValue(0, Menu().alpha#, 200.0 / frameTime#)
endif
`Set this menu items alpha
set sprite alpha Menu().imgID, Menu().alpha#
endif
`move to next item
next array index Menu()
endwhile
sync
loop
end
`This function adds a new menu item to the end of the list.
function AddMenuItem(t$, header as boolean)
array insert at bottom Menu()
`Store the title caption
Menu().title$ = t$
`Record if this menu item is a header or not
`Default alpha value is the faded out value for headers, for menu items its zero (transparent)
if header
Menu().isHeader = 1
Menu().alpha# = menuAlphaOut
else
Menu().isHeader = 0
Menu().alpha# = 0
endif
`create a random command - this needs replacing with something meaningfull later
cmd$ = ""
for i = 1 to 4+rnd(20)
cmd$ = cmd$ + chr$(97+rnd(26))
next i
Menu().command$ = cmd$
endfunction
`This function makes buttons by drawing a box with the back color, then the text with the next color and then getting the image.
function makeButtonImage(img, txt$, isHeader as boolean, c, r)
ink boxBackColor, 0
box 0, 0, menuButtonWidth, menuButtonHeight
ink boxTextColor, 0
center text menuButtonWidth*0.5, (menuButtonHeight - text height(txt$)) * 0.5, txt$
get image img, 0, 0, menuButtonWidth, menuButtonHeight
sprite img, c*menuButtonWidth, r*menuButtonHeight, img
if isHeader
set sprite alpha img, menuAlphaOut
else
set sprite alpha img, 0
endif
Menu().imgID = img
endfunction
Appologies if this has already been done - but I learned a lot from it
Comments welcome.
PS: I also (rarely for me) put comments in the code! I never do this
hehe....
EDIT: Screeny now
My Website:
