News:

Function Finder  Find all the functions within source code files

Main Menu

4 way menu

Started by XpMe_v1.2, February 04, 2009, 10:57:01 AM

Previous topic - Next topic

XpMe_v1.2

Yet another way to do a menu. :o
4 possible locations (left,right,top,bottom) using 1 image to contain the menu
and 1 image button to open it and 1 image button to close it.
and 1 image button to highlight opening it and 1 image button to highlight closing it.
Fell free to use the code and or change it to your needs.
You must provide your own code for making selections when the menu appears part of the code
since menus can be used a lot of different ways.

PlayBASIC Code: [Select]
Randomize 57
Global Xball# = 50.0
Global Yball# = 50.0
Global Xspeed# = 5.0
Global Yspeed# = 5.0
Global Xdir = 1
Global Ydir = 1
global Wball# = 10
global Hball# = 10
`-------
Type the_LRUD_Bars
Title$,Button$
lBrown,dRed,Red,Green,lGreen,dBlue,Blue,Yellow,lYellow,White,lWhite,Black,dBlack
fnt1,fnt2
x,y,w,h
Bx,By,Bw,Bh
img,but,butOver,butHiLiClose
speed,active,inout
location
EndType
Dim Bar As the_LRUD_Bars
`-------set varys
Bar.Title$ = "MAIN MENU"
Bar.Button$ = "MENU"
Bar.lBrown = RGB(203,146, 69)
Bar.dRed = RGB(100, 0, 0)
Bar.Red = RGB(255, 0, 0)
Bar.Green = RGB( 0,128, 0)
Bar.lGreen = RGB( 88,209, 99)
Bar.dBlue = RGB( 27, 40,105)
Bar.Blue = RGB( 0, 0,255)
Bar.Yellow = RGB(255,255, 0)
Bar.lYellow = RGB(255,255,128)
Bar.White = RGB(255,255,255)
Bar.lWhite = RGB(245,245,245)
Bar.Black = RGB( 0, 0, 0)
Bar.dBlack = RGB( 5, 5, 5)
Bar.fnt1 = GetFreeFont() : LoadFont "COURIER NEW" ,Bar.fnt1 ,28 ,1 : Ink Bar.lGreen : PrepareFxFont Bar.fnt1
Bar.fnt2 = GetFreeFont() : LoadFont "COURIER NEW" ,Bar.fnt2 ,20 ,1 : Ink Bar.Green : PrepareFxFont Bar.fnt2
Bar.w = 200
Bar.h = 200
Bar.Bw = 25
Bar.Bh = 72
Bar.img = NewFXImage(Bar.w ,Bar.h)
Bar.but = NewFXImage(Bar.Bw ,Bar.Bh)
Bar.butOver = NewFXImage(Bar.Bw ,Bar.Bh)
Bar.butHiLiClose = NewFXImage(26,17)
Create_ButtonHiLiClose(0)
Create_Menu()
Create_Button()
Create_ButtonHiLiClose(1)
Bar.speed = 3
Bar.active = 0
Bar.inout = 0
`---
`menu location
Bar.location = 1 : set_Menu_Location(Bar.location) ` LEFT side
`---
`3 other possible locations below
`Bar.location = 2 : set_Menu_Location(Bar.location) ` RIGHT side
`Bar.location = 3 : set_Menu_Location(Bar.location) ` TOP side
`Bar.location = 4 : set_Menu_Location(Bar.location) ` BOTTOM side
`---
`------------------------------
`------------------------------
Function Create_Menu()
` creates the menu
SetFont Bar.fnt1
RenderToImage Bar.img
Cls Bar.dBlack
BoxC 1, 1, Bar.w - 2 ,Bar.h - 2 ,False ,Bar.White
ShadeBox 2, 2, Bar.w - 2 ,Bar.h - 2 ,Bar.dBlack ,Bar.dBlack ,Bar.Blue ,Bar.Blue
ShadeBox 6, 6, Bar.w - 6 ,Bar.h - 6 ,Bar.lWhite ,Bar.lWhite ,Bar.lYellow ,Bar.lYellow
ShadeBox 6,25, Bar.w - 6 ,30 ,Bar.dBlack ,Bar.dBlack ,Bar.Blue ,Bar.Blue
CenterText Bar.w / 2 + 13 , 3 ,Bar.Title$
DrawImage Bar.butHiLiClose , Bar.x + 7 , Bar.y + 7 ,True
RenderToScreen
EndFunction
`------------------------------
`------------------------------
Function Create_Button()
SetFont Bar.fnt2 ` changes the button shape as needed
Select Bar.location
Case 1 ,2 : Bar.Bw = 25 : Bar.Bh = 72
Case 3 ,4 : Bar.Bw = 72 : Bar.Bh = 25
EndSelect
GetImage Bar.but ,0,0,Bar.Bw,Bar.Bh
RenderToImage Bar.but
Cls Bar.dBlack
Select Bar.location
Case 1 ,2
BoxC 1,1, Bar.Bw - 2 ,Bar.Bh - 2 ,False ,Bar.White
ShadeBox 2,2, Bar.Bw - 2 ,Bar.Bh - 2 ,Bar.dBlack ,Bar.dBlack ,Bar.Blue ,Bar.Blue
ShadeBox 4,4, Bar.Bw - 4 ,Bar.Bh - 4 ,Bar.lGreen ,Bar.lGreen ,Bar.lYellow ,Bar.lYellow
For t = 1 To Len(Bar.Button$)
a$ = Mid$(Bar.Button$ ,t ,1) : Text 7 , 5 + d , a$ : d = d + 15
Next
Case 3 ,4
BoxC 1,1, Bar.Bw - 2 ,Bar.Bh - 2 ,False ,Bar.White
ShadeBox 2,2, Bar.Bw - 2 ,Bar.Bh - 2 ,Bar.dBlack ,Bar.dBlack ,Bar.Blue ,Bar.Blue
ShadeBox 4,4, Bar.Bw - 4 ,Bar.Bh - 4 ,Bar.lGreen ,Bar.lGreen ,Bar.lYellow ,Bar.lYellow
Text 15 ,3 ,Bar.Button$
EndSelect
CopyImage Bar.but,Bar.butOver
RenderToImage Bar.butOver : BoxC 4,4, Bar.Bw - 5 ,Bar.Bh - 5 ,False ,Bar.Green
BoxC 3,3, Bar.Bw - 4 ,Bar.Bh - 4 ,False ,Bar.lGreen
BoxC 2,2, Bar.Bw - 3 ,Bar.Bh - 3 ,False ,Bar.lYellow
BoxC 1,1, Bar.Bw - 2 ,Bar.Bh - 2 ,False ,Bar.Yellow : RenderToScreen
EndFunction
`------------------------------
`------------------------------
Function Create_ButtonHiLiClose(hi)
` close menu button ` if hi = 0 then draw it(dull) to be stamped to the menu
` if hi = 1 then draw it(highlighted) to be placed over the buttons hot area
SetFont Bar.fnt2
RenderToImage Bar.butHiLiClose
Cls Bar.dBlack
BoxC 1, 1, 24 ,15 ,False ,Bar.Yellow
BoxC 2, 2, 23 ,14 ,False ,Bar.Blue
BoxC 4, 4, 22 ,13 ,True ,Bar.White
If Hi = 1 Then BoxC 4, 4, 22 ,13 ,True ,Bar.Yellow
BoxC 6, 9, 20 ,11 ,True ,Bar.dBlack
RenderToScreen
EndFunction
`------------------------------
`------------------------------
Function set_Menu_Location(n)
` if you change the menu location then this function will redo the x and y locations
Create_Button() ` <<<< changes the button shape if needed
Select n
Case 1 : Bar.x = -Bar.w : Bar.y = GetScreenHeight() / 2 - Bar.h / 2
Bar.Bx = Bar.x + Bar.w : Bar.By = Bar.y + Bar.h / 2 - Bar.Bh / 2
Case 2 : Bar.x = GetScreenWidth() : Bar.y = GetScreenHeight() / 2 - Bar.h / 2
Bar.Bx = Bar.x - Bar.Bw : Bar.By = Bar.y + Bar.h / 2 - Bar.Bh / 2
Case 3 : Bar.x = GetScreenWidth() / 2 - Bar.w / 2 : Bar.y = -Bar.h
Bar.Bx = Bar.x + Bar.w / 2 - Bar.Bw / 2 : Bar.By = 0
Case 4 : Bar.x = GetScreenWidth() / 2 - Bar.w / 2 : Bar.y = GetScreenHeight()
Bar.Bx = Bar.x + Bar.w / 2 - Bar.Bw / 2 : Bar.By = Bar.y - Bar.Bh
EndSelect
EndFunction
`------------------------------
`------------------------------
Function show_In_Out_Menu(n ,mb,mx,my)
If Bar.inout = 0
DrawImage Bar.but , Bar.Bx , Bar.By ,True
If mx > Bar.Bx And mx < Bar.Bx + Bar.Bw And my > Bar.By And my < Bar.By + Bar.Bh Then DrawImage Bar.butOver ,Bar.Bx ,Bar.By ,True
EndIf
DrawImage Bar.img , Bar.x , Bar.y ,True
Login required to view complete source code


...XpMe v1.2

http://tilemusic.com/

XpMe_v1.2

#1
Here is a redone version that loads and uses PNG images for the menu.  ;D

PlayBASIC Code: [Select]
Randomize 57
Global Path$ = CurrentDir$()
`-------
Global Xball# = 50.0
Global Yball# = 50.0
Global Xspeed# = 5.0
Global Yspeed# = 5.0
Global Xdir = 1
Global Ydir = 1
Global Wball# = 10
Global Hball# = 10
`-------
Type the_LRUD_Bars
Title$,Button$
lBrown,dRed,Red,Green,lGreen,dBlue,Blue,Yellow,lYellow,White,lWhite,Black,dBlack
fnt1,fnt2
x,y,w,h
Bx,By,Bw,Bh
img,but,butOver,butHiLiClose
Vbut(4)
VbutW(2)
VbutH(2)
Mbut(3)
speed,active,inout
location
EndType
Dim Bar As the_LRUD_Bars
`-------set varys
Bar.Title$ = "MAIN MENU"
Bar.Button$ = "MENU"
Bar.lBrown = RGB(203,146, 69)
Bar.dRed = RGB(100, 0, 0)
Bar.Red = RGB(255, 0, 0)
Bar.Green = RGB( 0,128, 0)
Bar.lGreen = RGB( 88,209, 99)
Bar.dBlue = RGB( 27, 40,105)
Bar.Blue = RGB( 0, 0,255)
Bar.Yellow = RGB(255,255, 0)
Bar.lYellow = RGB(255,255,128)
Bar.White = RGB(255,255,255)
Bar.lWhite = RGB(245,245,245)
Bar.Black = RGB( 0, 0, 0)
Bar.dBlack = RGB( 5, 5, 5)
Bar.fnt1 = GetFreeFont() : LoadFont "COURIER NEW" ,Bar.fnt1 ,28 ,1 : Ink Bar.lGreen : PrepareFxFont Bar.fnt1
Bar.fnt2 = GetFreeFont() : LoadFont "COURIER NEW" ,Bar.fnt2 ,20 ,1 : Ink Bar.Green : PrepareFxFont Bar.fnt2
SetFont Bar.fnt2
`------------------------------
` visible button
Bar.but = NewFXImage(1,1)
Bar.butOver = NewFXImage(1,1)
` load 4 images for visible buttons
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu5.PNG", i : Bar.Vbut(1) = i : Bar.VbutW(1) = GetImageWidth(i) : Bar.VbutH(1) = GetImageHeight(i)
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu6.PNG", i : Bar.Vbut(2) = i
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu7.PNG", i : Bar.Vbut(3) = i : Bar.VbutW(2) = GetImageWidth(i) : Bar.VbutH(2) = GetImageHeight(i)
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu8.PNG", i : Bar.Vbut(4) = i
` visible button select
Create_Button()
`------------------------------
` load the menu image
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu0.PNG", i : Bar.img = i : Bar.w = GetImageWidth(i) : Bar.h = GetImageHeight(i)
`------------------------------
` load the highlighted 'X' close button image
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu4.PNG", i : Bar.butHiLiClose = i
`------------------------------
` load menu highlight button images
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu1.PNG", i : Bar.Mbut(1) = i
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu2.PNG", i : Bar.Mbut(2) = i
i = NewFXImage(1,1) : LoadFxImage Path$ + "Menu3.PNG", i : Bar.Mbut(3) = i
`------------------------------
`---
Bar.speed = 3
Bar.active = 0
Bar.inout = 0
`---
`menu location
Bar.location = 1 : set_Menu_Location(Bar.location) ` LEFT side
`---
`3 other possible locations below
`Bar.location = 2 : set_Menu_Location(Bar.location) ` RIGHT side
`Bar.location = 3 : set_Menu_Location(Bar.location) ` TOP side
`Bar.location = 4 : set_Menu_Location(Bar.location) ` BOTTOM side
`---
`------------------------------
`------------------------------
Function Create_Button()
Select Bar.location ` changes the button shape as needed
Case 1 ,2 : Bar.Bw = Bar.VbutW(1) : Bar.Bh = Bar.VbutH(1)
Case 3 ,4 : Bar.Bw = Bar.VbutW(2) : Bar.Bh = Bar.VbutH(2)
EndSelect
Select Bar.location
Case 1 ,2 : CopyImage Bar.Vbut(1) , Bar.but : CopyImage Bar.Vbut(2) , Bar.butOver
Case 3 ,4 : CopyImage Bar.Vbut(3) , Bar.but : CopyImage Bar.Vbut(4) , Bar.butOver
EndSelect
EndFunction
`------------------------------
`------------------------------
Function set_Menu_Location(n)
` if you change the menu location then this function will redo the x and y locations
Create_Button() ` <<<< changes the button shape if needed
Select n
Case 1 : Bar.x = -Bar.w : Bar.y = GetScreenHeight() / 2 - Bar.h / 2
Bar.Bx = Bar.x + Bar.w : Bar.By = Bar.y + Bar.h / 2 - Bar.Bh / 2
Case 2 : Bar.x = GetScreenWidth() : Bar.y = GetScreenHeight() / 2 - Bar.h / 2
Bar.Bx = Bar.x - Bar.Bw : Bar.By = Bar.y + Bar.h / 2 - Bar.Bh / 2
Case 3 : Bar.x = GetScreenWidth() / 2 - Bar.w / 2 : Bar.y = -Bar.h
Bar.Bx = Bar.x + Bar.w / 2 - Bar.Bw / 2 : Bar.By = 0
Case 4 : Bar.x = GetScreenWidth() / 2 - Bar.w / 2 : Bar.y = GetScreenHeight()
Bar.Bx = Bar.x + Bar.w / 2 - Bar.Bw / 2 : Bar.By = Bar.y - Bar.Bh
EndSelect
EndFunction
`------------------------------
`------------------------------
Function show_In_Out_Menu(n ,mb,mx,my)
If Bar.inout = 0
DrawImage Bar.but , Bar.Bx , Bar.By ,True
If mx > Bar.Bx And mx < Bar.Bx + Bar.Bw And my > Bar.By And my < Bar.By + Bar.Bh Then DrawImage Bar.butOver ,Bar.Bx ,Bar.By ,True
EndIf
DrawImage Bar.img , Bar.x , Bar.y ,True
Select Bar.inout
Case 0 : If mb = 2 And mx > Bar.Bx And mx < Bar.Bx + Bar.Bw And my > Bar.By And my < Bar.By + Bar.Bh Then Bar.inout = 1
Case 1
Select Bar.location
Case 1
If Bar.x + Bar.w < Bar.w
Bar.x = Bar.x + Bar.speed : Bar.active = 1
Else
Bar.inout = 2 : Bar.active = 2
EndIf
Case 2
If Bar.x > GetScreenWidth() - Bar.w
Bar.x = Bar.x - Bar.speed : Bar.active = 1
Else
Bar.inout = 2 : Bar.active = 2
EndIf
Case 3
If Bar.y + Bar.h < Bar.h - 2
Bar.y = Bar.y + Bar.speed : Bar.active = 1
Else
Bar.inout = 2 : Bar.active = 2
EndIf
Case 4
If Bar.y > GetScreenHeight() - Bar.h + 2
Bar.y = Bar.y - Bar.speed : Bar.active = 1
Else
Bar.inout = 2 : Bar.active = 2
EndIf
EndSelect
Case 2
Login required to view complete source code


...XpMe v1.2

http://tilemusic.com/

kevin

#2
 Why not zip up the project with media ?, much easier on users

XpMe_v1.2

#3
Download this zip for all 9 images and the source code.

-LOCATION TO DOWNLOAD-

----------------------------------------------
http://www.tilemusic.com
----------------------------------------------
...XpMe v1.2

http://tilemusic.com/

XpMe_v1.2

#4
This version uses PlayDialogs.dll for loading (PNG-BMP-JPG) images.
It also uses the message box command.
There you go.

-LOCATION TO DOWNLOAD-

----------------------------------------------
http://www.tilemusic.com
----------------------------------------------
...XpMe v1.2

http://tilemusic.com/