TheGameCreators - CodeBase - Windows style menu

Return to the CodeBase listing

Category: Input / Output

Version: 1.0

Information

Uploaded: 24th Oct 2004 16:48

Modified: 1st Jan 1970 01:00

Author: dark coder

Summary

This almost replicates the windows menu system but its all coded in dbp :)

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

sync on

autocam off

make_menu()

add_drop("File") : `drop 1

add_drop("Edit") : `drop 2

add_drop("Create") : `drop 2

add_sub_drop(1,"Load") : ` sub drop 1

add_sub_drop(1,"Save") : ` sub drop 2

add_sub_drop(1,"Delete") : ` sub drop 1

add_sub_drop(1,"Exit") : ` sub drop 3

add_sub_drop(2,"Undo") : ` sub drop 1

add_sub_drop(2,"Redo") : ` sub drop 1

add_sub_drop(3,"Model") : ` sub drop 1

add_sub_drop(3,"Music") : ` sub drop 1

add_sub_sub_drop(3,1,"Cube") : `sub sub drop 1

add_sub_sub_drop(3,1,"Sphere") : `sub sub drop 1

add_sub_sub_drop(3,1,"Cylinder") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 1") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 2") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 3") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 4") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 5") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 6") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 7") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 8") : `sub sub drop 1

add_sub_sub_drop(3,2,"Loop 9") : `sub sub drop 1

add_sub_sub_drop(1,1,"Model") : `sub sub drop 1

add_sub_sub_drop(1,1,"Sound") : `sub sub drop 1

add_sub_sub_drop(1,1,"Music") : `sub sub drop 1

add_sub_sub_drop(1,1,"Model") : `sub sub drop 1

add_sub_sub_drop(1,1,"Bitmap") : `sub sub drop 1

position camera 0,1000,0

set camera fov 5

point camera 0,0,0

make object cube 1,1

`color object 999,rgb(255,255,255)

return$=update_menu()

if return$="Exit" then end

sync

loop

`==================================

function drop_count()

count=count1(0)

endfunction count

`==================================

function make_menu()

dim names1(50) as string

dim names2(50,50) as string

dim names3(50,50,50) as string

dim count1(10)

dim count2(50)

dim count3(50,50)

set text font "tahoma"

set text size 14

endfunction

`==================================

function add_drop(name as string)

count1(0)=count1(0)+1

names1(count1(0))=name

endfunction

`==================================

function add_sub_drop(pos,name as string)

count2(pos)=count2(pos)+1

names2(pos,count2(pos))=name

endfunction

`==================================

function add_sub_sub_drop(pos,down,name as string)

count3(pos,down)=count3(pos,down)+1

names3(pos,down,count3(pos,down))=name

endfunction

`==================================

function update_menu()

mg=count1(9)

mx=mousex()

my=mousey()

count1(10)=mg

mg=mouseclick()

count1(9)=mg

mc=0

if mg=1 and count1(10)=0 then mc=1

check=0

colour(1) : box 0,0,screen width(),18

colour(2) : line 0,18,screen width(),18

colour(4) : line 0,19,screen width(),19

`================= DROP

wid=5

if count1(0)>0

for i=1 to count1(0)

tl=text width(names1(i))

t2=text height(names1(i))

text wid,1,names1(i)

line wid,text height(mid$(names1(i),1)),wid+text width(mid$(names1(i),1))-1,text height(mid$(names1(i),1))

`=========

wrt=wid+text width(names1(i))

if mx>wid-5 and mx<wrt and my>0 and my<20

colour(3) : line wid-5,0,wrt,0 : line wid-5,0,wid-5,17 : colour(2) : line wrt,0,wrt,17 : line wid-5,17,wrt,17

if mc=1 then colour(2) : line wid-5,0,wrt,0 : line wid-5,0,wid-5,17 : colour(3) : line wrt,0,wrt,17 : line wid-5,17,wrt,17

colour(4)

if count1(1)>0 then count1(1)=i : count1(2)=wid : count1(5)=wrt

if mc=1

check=1

count1(1)=i

count1(6)=0

count1(2)=wid

if count2(count1(1),0)=0 then return$=names1(i)

endif

`=========

wid=wid+text width(names1(i))+15

next i

endif

`======================

`================= SUB DROP

if count2(count1(1),0)>0

wid=count1(2)

he=20+(count2(count1(1),0)*15)

wrt=count1(5)

colour(2) : line wid-5,0,wrt,0 : line wid-5,0,wid-5,17 : colour(3) : line wrt,0,wrt,17 : line wid-5,17,wrt,17

wid=count1(2)-5

colour(1) : box wid,20,wid+100,he

colour(2) : line wid,he-1,wid+99,he-1 : line wid+99,20,wid+99,he

colour(3) : line wid,21,wid+100,21 : line wid+1,20,wid+1,he

colour(4) : line wid,he,wid+100,he : line wid+100,20,wid+100,he

h=20

for i=1 to count2(count1(1),0)

colour(4)

count1(3)=0

if mx>wid-3 and mx<wid+97 and my>(i*15) and my<15+(i*15)

check=1

count1(3)=i

if mc=1 then count1(6)=i : count1(8)=h

if mc=1 and count3(count1(1),count1(6))=0 then return$=names2(count1(1),i) : count1(1)=0

endif

if i=count1(3) then colour(2) : box wid+3,7+(i*15),wid+98,18+(i*15) :  colour(5)

text wid+5,h,names2(count1(1),i)

a=wid+96

if count3(count1(1),i)>0

h=h+7

dot a,h : dot a-1,h : dot a-2,h : dot a-3,h : dot a-1,h+1 : dot a-1,h-1

dot a-2,h+1 : dot a-2,h+2 : dot a-2,h-1 : dot a-2,h-2 : dot a-3,h+3

dot a-3,h-1 : dot a-3,h-2 : dot a-3,h-3 : dot a-3,h+1 : dot a-3,h+2

h=h-7

endif

colour(4)

h=h+15

next i

endif

`======================

`================= SUB SUB DROP

if count3(count1(1),count1(6))>0

colour(1)

h=7+count1(6)*15

he=5+(count1(6)*15)+(count3(count1(1),count1(6))*15)

`h=5+count1(6)*15

box wid+100,5+count1(6)*15,wid+200,5+(count1(6)*15)+(count3(count1(1),count1(6))*15)

wid=wid+100

colour(2) : line wid,he-1,wid+99,he-1 : line wid+99,h,wid+99,he

colour(3) : line wid,h-1,wid+99,h-1 : line wid,h,wid,he

colour(4) : line wid,he,wid+100,he : line wid+100,h,wid+100,he

for i=1 to count3(count1(1),count1(6))

colour(4)

count1(3)=0

if mx>wid-3 and mx<wid+97 and my>(i*15) and my<15+(i*15)

check=1

count1(3)=i

if mc=1 then return$=names3(count1(1),count1(6),i) : count1(1)=0 : count1(6)=0

endif

if i=count1(3) then colour(2) : box wid+3,7+(i*15),wid+97,18+(i*15) :  colour(5)

text wid+5,h-2,names3(count1(1),count1(6),i)

colour(4)

h=h+15

next i

endif

`======================

if mc=1 and check=0 then count1(1)=0 : count1(6)=0

endfunction return$

`==================================

function colour(num)

if num=1 then ink get_colour(4),0

if num=2 then ink get_colour(16),0

if num=3 then ink get_colour(20),0

if num=4 then ink get_colour(21),0

if num=5 then ink rgb(255,255,255),0

endfunction

function get_colour(num)

local col as dword

load dll "user32.dll",1

col = call dll(1,"GetSysColor", num)

delete dll 1

col = rgb(rgbb(col), rgbg(col), rgbr(col))

endfunction col

`==================================

Download

Please login to download

Comments

No comments yet.

Author Name:	dark coder
CodeBase Entries:	2

CodeBase - Windows style menu

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments