UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: XpMe_v1.2 on February 04, 2009, 10:57:01 AM

Title: 4 way menu
Post by: XpMe_v1.2 on February 04, 2009, 10:57:01 AM
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.

[pbcode]

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
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
            If mx > Bar.x + 7 And mx < Bar.x + 32
           If my > Bar.y + 7 And my < Bar.y + 23
                                  DrawImage Bar.butHiLiClose ,Bar.x + 7 ,Bar.y + 7 ,True
                                  BoxC mx+12,my+12 ,mx+284,my+31 ,True , RGB(190,202,106)
                                  BoxC mx+12,my+12 ,mx+284,my+31 ,False, RGB( 10, 22, 10)
                                  Text mx+14,my+12 ,"Right mouse click to close."
            If mb = 2 Then Bar.inout = 3 : Bar.active = 1
            EndIf    
            EndIf
 Case 3  
           Select Bar.location
          Case 1      
                 If Bar.x + Bar.w > 0
                    Bar.x = Bar.x - Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf  
          Case 2
                 If Bar.x < GetScreenWidth()
                    Bar.x = Bar.x + Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          Case 3      
                 If Bar.y + Bar.h > 0
                    Bar.y = Bar.y - Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          Case 4      
                 If Bar.y < GetScreenHeight()
                    Bar.y = Bar.y + Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          EndSelect
EndSelect
EndFunction  
`------------------------------
`------------------------------  
Function Menu_Active(n ,mb,mx,my)
                                ` lets you do something if menu is active
Static number  
If Bar.active > 0
                  Box Bar.x + 150 , Bar.y + 90  , Bar.x + 188 , Bar.y + 133 , True
           CenterText Bar.x + 100 , Bar.y + 135 , "mouse click me!"
                 Text Bar.x +  88 , Bar.y + 88  , number
EndIf
If Bar.active = 2
If mx > Bar.x + 150 And mx < Bar.x + 188
If my > Bar.y +  90 And my < Bar.y + 133
                            BoxC Bar.x + 150 , Bar.y + 90  , Bar.x + 188 , Bar.y + 133 , True  ,Bar.Yellow  
                             BoxC Bar.x + 150 , Bar.y + 90  , Bar.x + 188 , Bar.y + 133 , False ,Bar.Red
                             If mb > 0 Then Inc number
EndIf
EndIf
EndIf      
EndFunction  
`------------------------------
`------------------------------
Function change_Bar_location()  
                             ` pressing the function keys 1 to 4 will reset location if not currently active
If Bar.inout = 0  
  If FunctionKeys(1) = True Then Bar.location = 1 : set_Menu_Location(Bar.location)
  If FunctionKeys(2) = True Then Bar.location = 2 : set_Menu_Location(Bar.location)
  If FunctionKeys(3) = True Then Bar.location = 3 : set_Menu_Location(Bar.location)
  If FunctionKeys(4) = True Then Bar.location = 4 : set_Menu_Location(Bar.location)
EndIf      
EndFunction
`------------------------------
`------------------------------
Function show_some_animation()  
                             ` show some background animation
select Xdir
   case 0 :   xx# = Xball# - Xspeed#
           if xx# - Wball# < 0.0 then               xx# = Xball# : Xdir = 1 : Ydir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Xball# = xx#
   case 1 :   xx# = Xball# + Xspeed#
           if xx# + Wball# > GetScreenWidth() then  xx# = Xball# : Xdir = 0 : Ydir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Xball# = xx#
endselect
select Ydir
   case 0 :   yy# = Yball# - Yspeed#
           if yy# - Hball# < 0.0 then               yy# = Yball# : Ydir = 1 : Xdir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Yball# = yy#
   
   case 1 :   yy# = Yball# + Yspeed#
           if yy# + Hball# > GetScreenHeight() then yy# = Yball# : Ydir = 0 : Xdir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Yball# = yy#
endselect
ellipsec Xball#,Yball# ,Wball#,Hball# ,true , RGB(128,64,0)
ellipsec Xball#,Yball# ,Wball#,Hball# ,false, RGB(  8, 4,0)
EndFunction  
`------------------------------
`--------------------------------------------------------------------------------------
`------------------------------ the MAIN LOOP -------
SetFPS 60
Repeat
mb = MouseButton()
mx = MouseX()
my = MouseY()
ShadeBox 0,0,GetScreenWidth()    ,GetScreenHeight()          ,Bar.Black,Bar.dRed ,Bar.dBlack ,Bar.dBlack
 CenterText GetScreenWidth() / 2 ,GetScreenHeight() / 2 - 44 ,"right mouse click on the word 'MENU' to show and use the menu."  
 CenterText GetScreenWidth() / 2 ,GetScreenHeight() / 2 + 44 ,"press the FUNCTION KEYS 1-2-3-4 to change menu location when menu is hidden."  
       Text 5,5 ,"fps = " + Str$(FPS())
show_some_animation()                       `<- remove this line if you don't want to see a bouncing ball
  show_In_Out_Menu(Bar.location ,mb,mx,my) `<- this line is for showing the menu
       Menu_Active(Bar.location ,mb,mx,my) `<- this line is for your menu input  
Sync
change_Bar_location()                       `<- remove this line if you don't want to make location changes
Until SpaceKey()

[/pbcode]

Title: Re: 4 way menu
Post by: XpMe_v1.2 on February 05, 2009, 12:57:37 PM
Here is a redone version that loads and uses PNG images for the menu.  ;D

[pbcode]
 
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
            If mx > Bar.x + 1 And mx < Bar.x + 13
           If my > Bar.y + 1 And my < Bar.y + 13  
          Select Bar.location
          Case 2 : zx = -300
          EndSelect
                                  DrawImage Bar.butHiLiClose ,Bar.x + 3 ,Bar.y + 4 ,True
                                  BoxC mx+12+zx,my+12 ,mx+284+zx,my+31 ,True , RGB(190,202,106)
                                  BoxC mx+12+zx,my+12 ,mx+284+zx,my+31 ,False, RGB( 10, 22, 10)
                                  Text mx+14+zx,my+12 ,"Right mouse click to close."
            If mb = 2 Then Bar.inout = 3 : Bar.active = 1
            EndIf    
            EndIf
 Case 3  
           Select Bar.location
          Case 1      
                 If Bar.x + Bar.w > 0
                    Bar.x = Bar.x - Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf  
          Case 2
                 If Bar.x < GetScreenWidth()
                    Bar.x = Bar.x + Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          Case 3      
                 If Bar.y + Bar.h > 0
                    Bar.y = Bar.y - Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          Case 4      
                 If Bar.y < GetScreenHeight()
                    Bar.y = Bar.y + Bar.speed
                 Else
                      Bar.inout = 0 : Bar.active = 0
                 EndIf
          EndSelect
EndSelect
EndFunction  
`------------------------------
`------------------------------
Function change_Bar_location()  
                             ` pressing the function keys 1 to 4 will reset location if not currently active
If Bar.inout = 0  
  If FunctionKeys(1) = True Then Bar.location = 1 : set_Menu_Location(Bar.location)
  If FunctionKeys(2) = True Then Bar.location = 2 : set_Menu_Location(Bar.location)
  If FunctionKeys(3) = True Then Bar.location = 3 : set_Menu_Location(Bar.location)
  If FunctionKeys(4) = True Then Bar.location = 4 : set_Menu_Location(Bar.location)
EndIf      
EndFunction
`------------------------------
`------------------------------
Function show_some_animation()  
                             ` show some background animation
select Xdir
   case 0 :   xx# = Xball# - Xspeed#
           if xx# - Wball# < 0.0 then               xx# = Xball# : Xdir = 1 : Ydir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Xball# = xx#
   case 1 :   xx# = Xball# + Xspeed#
           if xx# + Wball# > GetScreenWidth() then  xx# = Xball# : Xdir = 0 : Ydir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Xball# = xx#
endselect
select Ydir
   case 0 :   yy# = Yball# - Yspeed#
           if yy# - Hball# < 0.0 then               yy# = Yball# : Ydir = 1 : Xdir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Yball# = yy#
   
   case 1 :   yy# = Yball# + Yspeed#
           if yy# + Hball# > GetScreenHeight() then yy# = Yball# : Ydir = 0 : Xdir = rndrange(0,1) : Xspeed# = rndrange#(5,16) + 0.2 : Yspeed# = rndrange#(5,16) + 0.2
              Yball# = yy#
endselect
ellipsec Xball#,Yball# ,Wball#,Hball# ,true , RGB(128,64,0)
ellipsec Xball#,Yball# ,Wball#,Hball# ,false, RGB(  8, 4,0)
EndFunction    
`------------------------------
`------------------------------  
Function Menu_Active(n ,mb,mx,my)
                                ` lets you do something if menu is active
If Bar.active = 2
Select Bar.location
Case 2 : zx = -344
EndSelect   
    x = Bar.x + 7
If mx > x And mx < x + GetImageWidth(Bar.Mbut(1))
   y = Bar.y + 19
   If my > y And my < y + GetImageHeight(Bar.Mbut(1))
                                                  drawimage Bar.Mbut(1) ,x,y, 0
                                                   If mb = 0
                                                             BoxC mx+12+zx,my+12 ,mx+355+zx,my+33 ,True , Bar.lYellow
                                                            BoxC mx+12+zx,my+12 ,mx+355+zx,my+33 ,False, Bar.lWhite
                                                            Text mx+19+zx,my+12 ,"Right mouse click to end program."
                                                  endif
                                                   If mb = 2 Then end
   EndIf
   y = Bar.y + 38
   If my > y And my < y + GetImageHeight(Bar.Mbut(2))
                                                  drawimage Bar.Mbut(2) ,x,y, 0
                                                   If mb > 0
                                                             Select Bar.location
                                                               Case 4 : zy = -9
                                                             EndSelect
                                                             BoxC mx+12+zx,my+12+zy ,mx+217+zx,my+33+zy ,True , Bar.lYellow
                                                            BoxC mx+12+zx,my+12+zy ,mx+217+zx,my+33+zy ,False, Bar.lWhite
                                                            Text mx+19+zx,my+12+zy ,"4 way MENU program."
                                                  endif  
   EndIf
   y = Bar.y + 57
   If my > y And my < y + GetImageHeight(Bar.Mbut(3))
                                                  drawimage Bar.Mbut(3) ,x,y, 0
                                                   If mb > 0
                                                             Select Bar.location
                                                               Case 4 : zy = -48
                                                             EndSelect   
                                                             BoxC mx+12+zx,my+12+zy ,mx+517+zx,my+50+zy ,True , Bar.lYellow
                                                            BoxC mx+12+zx,my+12+zy ,mx+517+zx,my+50+zy ,False, Bar.lWhite
                                                            Text mx+19+zx,my+12+zy, "Your programs directory"
                                                            Text mx+19+zx,my+30+zy, ProgramDir$()
   EndIf                                          endif
EndIf
EndIf
EndFunction  
`------------------------------
`--------------------------------------------------------------------------------------
`------------------------------ the MAIN LOOP -------
SetFPS 60
Repeat
mb = MouseButton()
mx = MouseX()
my = MouseY()
ShadeBox 0,0,GetScreenWidth()    ,GetScreenHeight()          ,Bar.Black,Bar.dRed ,Bar.dBlack ,Bar.dBlack
 CenterText GetScreenWidth() / 2 ,GetScreenHeight() / 2 - 44 ,"right mouse click on the word 'MENU' to show and use the menu."  
 CenterText GetScreenWidth() / 2 ,GetScreenHeight() / 2 + 44 ,"press the FUNCTION KEYS 1-2-3-4 to change menu location when menu is hidden."  
       Text 5,5 ,"fps = " + Str$(FPS())
show_some_animation()                       `<- remove this line if you don't want to see a bouncing ball
  show_In_Out_Menu(Bar.location ,mb,mx,my) `<- this line is for showing the menu
       Menu_Active(Bar.location ,mb,mx,my) `<- this line is for your menu input  
Sync
change_Bar_location()                       `<- remove this line if you don't want to make location changes
Until SpaceKey()
[/pbcode]

Title: Re: 4 way menu
Post by: kevin on February 06, 2009, 11:06:31 PM
 Why not zip up the project with media ?, much easier on users
Title: Re: 4 way menu
Post by: XpMe_v1.2 on February 07, 2009, 08:45:21 AM
Download this zip for all 9 images and the source code.

-LOCATION TO DOWNLOAD-

----------------------------------------------
http://www.tilemusic.com (http://www.tilemusic.com)
----------------------------------------------
Title: Re: 4 way menu
Post by: XpMe_v1.2 on February 10, 2009, 06:27:16 PM
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 (http://www.tilemusic.com)
----------------------------------------------