Sorry your browser is not supported!

You are using an outdated browser that does not support modern web technologies, in order to use this site please update to a new browser.

Browsers supported include Chrome, FireFox, Safari, Opera, Internet Explorer 10+ or Microsoft Edge.

Code Snippets / a better menu system

Author
Message
CloseToPerfect
21
Years of Service
User Offline
Joined: 20th Dec 2002
Location: United States
Posted: 17th Jan 2003 06:52
global menuexists
global textcolor
global menucolor
menuexists = 0
dim menu(10)as string
dim itemexists(10)
dim item(10,10) as string
dim itemactive(10,10)
dim menuopen(10)
textcolor = 0,0
menucolor = rgb(210,210,210),0
`create menus and add items in menus, I limited menus to 10 and items to 10 per menu
`If you need more just change size of the arrays above
create_menu("File")

create_menu_item("File","New")
create_menu_item("File","Open")
create_menu_item("File","Save")
create_menu_item("File","Save As")
create_menu_item("File","Exit")
set_item("File","Save",0)
set_item("File","Save As",0)

create_menu("Edit")
create_menu_item("Edit","Undo")
create_menu_item("Edit","Cut")
create_menu_item("Edit","Copy")
create_menu_item("Edit","Paste")

create_menu("Help")
create_menu_item("Help","About")

`create a backdrop
for i = 1 to 100
ink rgb(rnd(255),rnd(255),rnd(255)),0
circle rnd(640),rnd(480),rnd(100)
x = rnd(640)
y = rnd(480)
line_box(x,y,x+rnd(100),y+rnd(100))
next i
get image 1,0,0,639,479,1


do
cls
paste image 1,0,0
display_menu()
if mouse_click_menu() = "New" then message_box("menu item","New","selected")
if mouse_click_menu() = "Open" then message_box("menu item","Open","selected")
if mouse_click_menu() = "Save" then message_box("menu item","Save","selected")
if mouse_click_menu() = "Save As" then message_box("menu item","Save As","selected")
if mouse_click_menu() = "Exit" then end
if mouse_click_menu() = "Undo" then message_box("menu item","Undo","selected")
if mouse_click_menu() = "Cut" then message_box("menu item","Cut","selected")
if mouse_click_menu() = "Copy" then message_box("menu item","Copy","selected")
if mouse_click_menu() = "Paste" then message_box("menu item","Paste","selected")
if mouse_click_menu() = "About" then message_box("Windows menu Emulator","version 1.3","by John Chase")
loop

function set_item(menu$,item$, active)
for i = 1 to menuexists
if menu$ = menu(i)
for j = 1 to itemexists(i)
if item$ = item(i,j) then itemactive(i,j) = active
next j
endif
next i
endfunction

function display_menu()
ink menucolor,0
box 0,0,screen width(),18
ink rgb(255,255,255), 0
line_box(0,0,screen width()-1,18)
ink textcolor,0
for i = 0 to menuexists
set cursor i*50+1,1
print menu(i+1)
if menuopen(i) = 1 then open_menu(menu(i))
next i
endfunction

function open_menu(name$)
for i=1 to menuexists
if menu(i) = name$
ink menucolor,0
box i*50-50,20,i*50+20,itemexists(i)*20+15
ink rgb(255,255,255),0
line_box(i*50-50,20,i*50+20,itemexists(i)*20+15)
ink textcolor,0
for j=1 to itemexists(i)
if itemactive(i,j) = 1
ink textcolor,0
set cursor i*50-49,j*20
print item(i,j)
endif
if itemactive(i,j) = 0
ink rgb(175,175,175),0
set cursor i*50-49,j*20
print item(i,j)
ink textcolor,0
endif
next j
endif
next i
endfunction

function create_menu(name$)
menuexists = menuexists + 1
menu(menuexists) = name$
endfunction

function create_menu_item(menu$,itemname$)
for i=1 to menuexists
if menu(i) = menu$
j = itemexists(i) + 1
itemexists(i) = j
item(i,j) = itemname$
itemactive(i,j) = 1
endif
next i
endfunction

function mouse_click_menu()
`click on menu to open submenu
if mouseclick() = 1
if mousey i * 50 - 50 and mousex() i * 50 or mousex() itemexists(i) *20 + 20 then menuopen(i) = 0
endif
next i
`click item in submenu
for i = 1 to menuexists
if menuopen(i) = 1

for j = 1 to itemexists(i)
if mousey() > j * 20 and mousey() positionx and mousex() positiony and mousey() 0
paste image 20000, positionx, positiony
exitfunction
endif
loop
endfunction

function line_box(x,y,x1,y1)
line x,y,x,y1
line x1,y,x1,y1
line x,y,x1,y
line x,y1,x1,y1
endfunction
CloseToPerfect
21
Years of Service
User Offline
Joined: 20th Dec 2002
Location: United States
Posted: 17th Jan 2003 06:53
bad forum tring againglobal menuexists
global textcolor
global menucolor
menuexists = 0
dim menu(10)as string
dim itemexists(10)
dim item(10,10) as string
dim itemactive(10,10)
dim menuopen(10)
textcolor = 0,0
menucolor = rgb(210,210,210),0
`create menus and add items in menus, I limited menus to 10 and items to 10 per menu
`If you need more just change size of the arrays above
create_menu("File")

create_menu_item("File","New")
create_menu_item("File","Open")
create_menu_item("File","Save")
create_menu_item("File","Save As")
create_menu_item("File","Exit")
set_item("File","Save",0)
set_item("File","Save As",0)

create_menu("Edit")
create_menu_item("Edit","Undo")
create_menu_item("Edit","Cut")
create_menu_item("Edit","Copy")
create_menu_item("Edit","Paste")

create_menu("Help")
create_menu_item("Help","About")

`create a backdrop
for i = 1 to 100
ink rgb(rnd(255),rnd(255),rnd(255)),0
circle rnd(640),rnd(480),rnd(100)
x = rnd(640)
y = rnd(480)
line_box(x,y,x+rnd(100),y+rnd(100))
next i
get image 1,0,0,639,479,1


do
cls
paste image 1,0,0
display_menu()
if mouse_click_menu() = "New" then message_box("menu item","New","selected")
if mouse_click_menu() = "Open" then message_box("menu item","Open","selected")
if mouse_click_menu() = "Save" then message_box("menu item","Save","selected")
if mouse_click_menu() = "Save As" then message_box("menu item","Save As","selected")
if mouse_click_menu() = "Exit" then end
if mouse_click_menu() = "Undo" then message_box("menu item","Undo","selected")
if mouse_click_menu() = "Cut" then message_box("menu item","Cut","selected")
if mouse_click_menu() = "Copy" then message_box("menu item","Copy","selected")
if mouse_click_menu() = "Paste" then message_box("menu item","Paste","selected")
if mouse_click_menu() = "About" then message_box("Windows menu Emulator","version 1.3","by John Chase")
loop

function set_item(menu$,item$, active)
for i = 1 to menuexists
if menu$ = menu(i)
for j = 1 to itemexists(i)
if item$ = item(i,j) then itemactive(i,j) = active
next j
endif
next i
endfunction

function display_menu()
ink menucolor,0
box 0,0,screen width(),18
ink rgb(255,255,255), 0
line_box(0,0,screen width()-1,18)
ink textcolor,0
for i = 0 to menuexists
set cursor i*50+1,1
print menu(i+1)
if menuopen(i) = 1 then open_menu(menu(i))
next i
endfunction

function open_menu(name$)
for i=1 to menuexists
if menu(i) = name$
ink menucolor,0
box i*50-50,20,i*50+20,itemexists(i)*20+15
ink rgb(255,255,255),0
line_box(i*50-50,20,i*50+20,itemexists(i)*20+15)
ink textcolor,0
for j=1 to itemexists(i)
if itemactive(i,j) = 1
ink textcolor,0
set cursor i*50-49,j*20
print item(i,j)
endif
if itemactive(i,j) = 0
ink rgb(175,175,175),0
set cursor i*50-49,j*20
print item(i,j)
ink textcolor,0
endif
next j
endif
next i
endfunction

function create_menu(name$)
menuexists = menuexists + 1
menu(menuexists) = name$
endfunction

function create_menu_item(menu$,itemname$)
for i=1 to menuexists
if menu(i) = menu$
j = itemexists(i) + 1
itemexists(i) = j
item(i,j) = itemname$
itemactive(i,j) = 1
endif
next i
endfunction

function mouse_click_menu()
`click on menu to open submenu
if mouseclick() = 1
if mousey<15
for i = 1 to menuexists
if mousex() > i * 50 - 50 and mousex() < i* 50 then menuopen(i) = 1
next i
endif
endif
`move off submenu to close submenu
for i = 1 to menuexists
if menuopen(i) = 1
if mousex() > i * 50 or mousex() < i * 50 - 50 or mousey() > itemexists(i) *20 + 20 then menuopen(i) = 0
endif
next i
`click item in submenu
for i = 1 to menuexists
if menuopen(i) = 1

for j = 1 to itemexists(i)
if mousey() > j * 20 and mousey() < j * 20 + 15
ink rgb(255,255,255), 0
line_box(i*50-50,j*20,i*50+20,j*20+15)
if mouseclick() = 1 and itemactive(i,j) = 1 then returnval$ = item(i,j) else returnval$ = "not active"
endif
next j
endif
next i
endfunction returnval$

function message_box(text1$,text2$,text3$)
sizex=200
sizey=100
positionx = screen width() / 2 - sizex / 2
positiony = screen height() / 2 - sizey / 2
get image 20000, positionx, positiony, positionx + sizex*2 +1, positiony + sizey*2 + 1,1
ink menucolor,0
box positionx, positiony, positionx + sizex , positiony + sizey
ink rgb(255,255,255), 0
line positionx,positiony,positionx+sizex,positiony
line positionx,positiony,positionx,positiony+sizey
line positionx+sizex,positiony,positionx+sizex,positiony+sizey
line positionx,positiony+sizey,positionx+sizex,positiony+sizey
ink textcolor,0
center text positionx + sizex / 2, positiony, text1$
center text positionx + sizex / 2, positiony + 25, text2$
center text positionx + sizex / 2, positiony + 50, text3$
center text positionx + sizex / 2, positiony + 75, "press any key"
do
if mouseclick() = 1
if mousex() > positionx and mousex() < positionx+sizex
if mousey() > positiony and mousey() < positiony+sizey
paste image 20000, positionx, positiony
exitfunction
endif
endif
endif
if scancode() > 0
paste image 20000, positionx, positiony
exitfunction
endif
loop
endfunction

function line_box(x,y,x1,y1)
line x,y,x,y1
line x1,y,x1,y1
line x,y,x1,y
line x,y1,x1,y1
endfunction

CloseToPerfect
21
Years of Service
User Offline
Joined: 20th Dec 2002
Location: United States
Posted: 17th Jan 2003 06:55
make sure you get the first global on the first line. this forum is a pain in the a$$

[img]pic [/img]

OneTouch
21
Years of Service
User Offline
Joined: 23rd Jan 2003
Location:
Posted: 27th Jan 2003 17:27
I do bekive that if you use the "code" button, you will be able to get all the code in one area.

However, I get errors that say line 48 needs a varibale.

if mouse_click_menu() = "New" then message_box("menu item","New","selected")
if mouse_click_menu() = "Open" then message_box("menu item","Open","selected")
if mouse_click_menu() = "Save" then message_box("menu item","Save","selected")
if mouse_click_menu() = "Save As" then message_box("menu item","Save As","selected")
if mouse_click_menu() = "Exit" then end
if mouse_click_menu() = "Undo" then message_box("menu item","Undo","selected")
if mouse_click_menu() = "Cut" then message_box("menu item","Cut","selected")
if mouse_click_menu() = "Copy" then message_box("menu item","Copy","selected")
if mouse_click_menu() = "Paste" then message_box("menu item","Paste","selected")
if mouse_click_menu() = "About" then message_box("Windows menu Emulator","version 1.3","by John Chase")

Did I copy the code corectly?


Veneticus
21
Years of Service
User Offline
Joined: 29th Jan 2003
Location:
Posted: 30th Jan 2003 06:16
CtP: Excellent code, thank you very much.

OT: You've double-copied his code - get rid of the first half, up until it starts over again at
global menuexists

Login to post a reply

Server time is: 2024-04-19 09:26:33
Your offset time is: 2024-04-19 09:26:33