News:

Function Finder  Find all the functions within source code files

Main Menu

MenuGUI

Started by Jeku, February 01, 2005, 05:22:05 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

Jeku

February 01, 2005, 05:22:05 PM Last Edit: November 08, 2012, 03:47:40 PM by kevin
Hey all,

I've created a nice looking menu system you can use in your PB programs.  Good for level editors and that sort.

I'm pretty new to PB, so there may be some stuff here that could be made more efficient.  Also I'm aware that there could be more comments, but I hope you can follow it :)

EDIT:
The indentation is wacked on the forum, if you want a copy I'll email it to you.

PlayBASIC Code: [Select]
; PROJECT : MenuGUI
; AUTHOR  : Jake Jensen
; CREATED : 01/02/2005
; EDITED  : 01/02/2005
; ---------------------------------------------------------------------

// window init
TitleScreen "MenuGUI"

// types
// menuGUI type
Type Menu
   Exist
   Id$
   ParentId$
   Text$
   Width
EndType

// constants
// menuGUI contant
Constant MENUS = 8

// booleans
bMouseClicked = False
// menuGUI global
Global bOverMenu = False

// integers
// menuGUI integers
Global menuSelected = 0
Global length = 0
Global selX = 0

// initialize menuGUI
// 10 menus (change this number accordingly)
Dim MainMenus(MENUS) As Menu

For i = 1 To MENUS
   MainMenus(i).Exist = False
   MainMenus(i).ParentId$ = ""
Next

// init main menu
MainMenus(1).Exist = True
MainMenus(1).Id$ = "main_file"
MainMenus(1).Text$ = "File"
MainMenus(1).Width = 75
MainMenus(2).Exist = True
MainMenus(2).Id$ = "main_edit"
MainMenus(2).Text$ = "Edit"
MainMenus(2).Width = 75
MainMenus(3).Exist = True
MainMenus(3).Id$ = "main_help"
MainMenus(3).Text$ = "Help"
MainMenus(3).Width = 75
// init submenus
MainMenus(4).Exist = True
MainMenus(4).Id$ = "file_new"
MainMenus(4).ParentId$ = "main_file"
MainMenus(4).Text$ = "New"
MainMenus(5).Exist = True
MainMenus(5).Id$ = "file_open"
MainMenus(5).ParentId$ = "main_file"
MainMenus(5).Text$ = "Open"
MainMenus(6).Exist = True
MainMenus(6).Id$ = "-"
MainMenus(6).ParentId$ = "main_file"
MainMenus(6).Text$ = "-"
MainMenus(7).Exist = True
MainMenus(7).Id$ = "file_exit"
MainMenus(7).ParentId$ = "main_file"
MainMenus(7).Text$ = "Exit"
MainMenus(8).Exist = True
MainMenus(8).Id$ = "help_about"
MainMenus(8).ParentId$ = "main_help"
MainMenus(8).Text$ = "About"

Do
   Cls 0
   
   // check if menu item was clicked
   menu_Id$ = DoMenu()
   If ((bMouseClicked = False) And (menu_Id$ <> ""))
  // file_exit
  If (menu_Id$ = "file_exit")
     End
  EndIf

  // this mouse watcher will stop clicks after menu closes
  bMouseClicked = True
   EndIf
   
   // if nothing is being clicked, reset mouse watcher
   If ((bMouseClicked = True) And (MouseButton() = 0))
  bMouseClicked = False
   EndIf
   
   Sync
Loop

Function DoMenu()
   // draw menus
   num_submenus = 0
   Ink RGB(0, 0, 0)
   x = 1
   For i = 1 To MENUS
  If ((MainMenus(i).Exist = True) And (MainMenus(i).ParentId$ = ""))
     BoxC x, 0, (MainMenus(i).Width + x), 20, 1, RGB(200, 200, 200)
     Text (x + 5), (0 + 3), MainMenus(i).Text$
     x = (MainMenus(i).Width + x)
  EndIf
   Next
   // draw grey to edge of screen
   BoxC x, 0, GetScreenWidth(), 20, 1, RGB(200, 200, 200)
   // detect mouse on main menus
   x = 1
   For i = 1 To MENUS
  If ((MainMenus(i).Exist = True) And (MainMenus(i).ParentId$ = ""))
     If ((MouseX() >= x) And (MouseX() <= (MainMenus(i).Width + x)) And (MouseY() >= 0) And (MouseY() <= 20))
      BoxC (x + 1), 1, (MainMenus(i).Width + (x - 1)), 19, 1, RGB(0, 0, 200)
        Ink RGB(255, 255, 255)
        Text (x + 5), (0 + 3), MainMenus(i).Text$       
      num_submenus = 0
      menuSelected = i
      selX = x
      For j = 1 To MENUS
         If ((MainMenus(j).Exist = True) And (MainMenus(j).ParentId$ = MainMenus(i).Id$))
        num_submenus = (num_submenus + 1)
         EndIf
      Next
      length = ((num_submenus + 1) * 20)
      bOverMenu = True
       EndIf
     x = (MainMenus(i).Width + x)
    EndIf
   Next
      
   // if mouse is over main menu, handle submenus
   If (bOverMenu = True)
    x = selX
    y = 20
    If ((MouseX() >= x) And (MouseX() <= (MainMenus(menuSelected).Width + x)) And (MouseY() >= 0) And (MouseY() <= length))
       menu_Id$ = MainMenus(i).Id$
       Ink RGB(0, 0, 0)
       // draw its submenus
       For j = 1 To MENUS
      If ((MainMenus(j).Exist = True) And (MainMenus(j).ParentId$ = MainMenus(menuSelected).Id$))
         // draw

Login required to view complete source code



  EDITED (2012-11-09): Bellow is slightly tweaked versions of the code

PlayBASIC Code: [Select]
; PROJECT : MenuGUI
; AUTHOR  : Jake Jensen
; CREATED : 01/02/2005
; EDITED  : 01/02/2005
; ---------------------------------------------------------------------

// window init
TitleScreen "MenuGUI"

// types
// menuGUI type
Type Menu
   Exist
   Id$
   ParentId$
   Text$
   Width
EndType

// constants
// menuGUI contant
Constant MENUS = 8

// booleans
bMouseClicked = False
// menuGUI global
Global bOverMenu = False

// integers
// menuGUI integers
Global menuSelected = 0
Global length = 0
Global selX = 0

// initialize menuGUI
// 10 menus (change this number accordingly)
Dim MainMenus(MENUS) As Menu


// init main menu
MainMenus(1).Exist = True
MainMenus(1).Id$ = "main_file"
MainMenus(1).Text$ = "File"
MainMenus(1).Width = 75
MainMenus(2).Exist = True
MainMenus(2).Id$ = "main_edit"
MainMenus(2).Text$ = "Edit"
MainMenus(2).Width = 75
MainMenus(3).Exist = True
MainMenus(3).Id$ = "main_help"
MainMenus(3).Text$ = "Help"
MainMenus(3).Width = 75
// init submenus
MainMenus(4).Exist = True
MainMenus(4).Id$ = "file_new"
MainMenus(4).ParentId$ = "main_file"
MainMenus(4).Text$ = "New"
MainMenus(5).Exist = True
MainMenus(5).Id$ = "file_open"
MainMenus(5).ParentId$ = "main_file"
MainMenus(5).Text$ = "Open"
MainMenus(6).Exist = True
MainMenus(6).Id$ = "-"
MainMenus(6).ParentId$ = "main_file"
MainMenus(6).Text$ = "-"
MainMenus(7).Exist = True
MainMenus(7).Id$ = "file_exit"
MainMenus(7).ParentId$ = "main_file"
MainMenus(7).Text$ = "Exit"
MainMenus(8).Exist = True
MainMenus(8).Id$ = "help_about"
MainMenus(8).ParentId$ = "main_help"
MainMenus(8).Text$ = "About"

Do
   Cls 0
   
   // check if menu item was clicked
   menu_Id$ = DoMenu()
   If ((bMouseClicked = False) And (menu_Id$ <> ""))

     // file_exit
     If (menu_Id$ = "file_exit")
        End
     EndIf

  // this mouse watcher will stop clicks after menu closes
  bMouseClicked = True
   EndIf
   
   // if nothing is being clicked, reset mouse watcher
   If ((bMouseClicked = True) And (MouseButton() = 0))
        bMouseClicked = False
   EndIf
   
   Sync
Loop





Function DoMenu()
   // draw menus
   
   Mouse_X =MouseX()
   Mouse_Y =MouseY()
   Mouse_Button=MouseButton()
   
   num_submenus = 0
   Ink RGB(0, 0, 0)
   x = 1
   For i = 1 To MENUS
     If (MainMenus(i).Exist = True)
        if (MainMenus(i).ParentId$ = "")
           BoxC x, 0, (MainMenus(i).Width + x), 20, 1, RGB(200, 200, 200)
           Text (x + 5), (0 + 3), MainMenus(i).Text$
           x += MainMenus(i).Width
      endif
     EndIf
   Next

   // draw grey to edge of screen
   BoxC x, 0, GetScreenWidth(), 20, 1, RGB(200, 200, 200)

   // detect mouse on main menus
   x = 1
   Ink RGB(255, 255, 255)
   For i = 1 To MENUS
     If ((MainMenus(i).Exist = True) And (MainMenus(i).ParentId$ = ""))
       If ((Mouse_X >= x) And (Mouse_X <= (MainMenus(i).Width + x)) And (Mouse_Y >= 0) And (Mouse_Y <= 20))
         BoxC (x + 1), 1, (MainMenus(i).Width + (x - 1)), 19, 1, RGB(0, 0, 200)
         Text (x + 5), (0 + 3), MainMenus(i).Text$       
         num_submenus = 0
         menuSelected = i
         selX = x
         For j = 1 To MENUS
            If MainMenus(j).Exist = True
               if (MainMenus(j).ParentId$ = MainMenus(i).Id$)
                    num_submenus = (num_submenus + 1)
               endif
            EndIf
         Next
         length = ((num_submenus + 1) * 20)
         bOverMenu = True
       EndIf
     x = (MainMenus(i).Width + x)
    EndIf

Login required to view complete source code



**
Automaton Games - Home of WordTrix 2.0, WordZap, and GameBasic
Jeku's Music - Easy listening electronic...
**

kevin

#1
February 01, 2005, 05:36:31 PM Last Edit: February 01, 2005, 05:39:28 PM by kevin
That's nice...  avoids the need to subclass the PB window with rob's dll..  Very cool..

Since true type text is such a bottle neck, thign slike this can really benefit from using their own font, converted to a bitmap font..

If you add this to the start,  it'll convert the default font into a bitmapped version.  The pixels will be of colour $111111  .. So just off black

makebitmapfont 1,$111111

Jeku

#2
February 01, 2005, 08:29:46 PM
Cool, thanks for the tip :)  That sped it up almost 3 fold.  Is there any easy way to be able to switch between font colours?  If not, I would suggest lightening the blue of the menu mouseover background to RGB(100, 100, 255)... then it looks good :)
**
Automaton Games - Home of WordTrix 2.0, WordZap, and GameBasic
Jeku's Music - Easy listening electronic...
**

Draco9898

#3
February 02, 2005, 12:19:52 AM Last Edit: May 20, 2013, 01:50:50 AM by kevin
Hi Jeku, nice code, I tried to make a GUI, but it turned out like money snot :)

As for multiple font colors, just make multiple fonts  :D
IE: MyFont(1); MyFont(2)

Here is a nice little snippet I wrote to make "cool" looking gradient styled text, it's kinda sloppy I think, but its pretty ok:

PlayBASIC Code: [Select]
`Load the Font And shade it
Psub CreateFont(FontSize)
   DeleteFont 1: GameFont=GetFreeFont()
   LoadFont "Arial bold",GameFont,FontSize,0
   MakeBitmapFont GameFont,$ff
   CreateImage 1,FontSize*2,FontSize*2: RenderToImage 1
   For X=1 To FontSize*2
  If X>5
     If GrnON=0 Then Green=Green+24
     If Green>255 Then Green=255
  EndIf
  LineC 0,0+x,FontSize*2,0+x,RGB(Green,215,Green)
   Next X
   RenderToScreen: BlendBitmapFont GameFont,1: SetFont GameFont
   DeleteImage 1
EndPsub



DualCore Intel Core 2 processor @ 2.3 ghz, Geforce 8600 GT (latest forceware drivers), 2 gigs of ram, WIN XP home edition sp2, FireFox 2.

"You'll no doubt be horrified to discover that PlayBasic is a Programming Language." -Kevin

jimwon

#4
February 09, 2009, 04:28:27 AM
This is really good. If you don't mind I shall pinch this and use it in one of my projects - crediting you of course. I prefer menus that pop up when you depress the right mouse button and perform the selected function when you release the right mouse button, like the good 'ol Amiga. I made a few changes to get this to happen -

In the main loop change:

menu_Id$ = DoMenu()

To:

If MouseButton()=2
menu_Id$ = DoMenu()
EndIf

And in the DoMenu() function change:

If (MouseButton() = 1)
// menu item clicked
menu_Id$ = MainMenus(j).Id$
// close the menu
bOverMenu = False
EndIf

To:

If (MouseButton() = 0)
// menu item clicked
menu_Id$ = MainMenus(j).Id$
// close the menu
bOverMenu = False
EndIf

Jeku

#5
February 23, 2009, 05:52:14 PM
QuoteIf you don't mind I shall pinch this and use it in one of my projects

Of course, it would be my pleasure to see someone else use this code in a project :)
**
Automaton Games - Home of WordTrix 2.0, WordZap, and GameBasic
Jeku's Music - Easy listening electronic...
**
Print
Go Up Pages1
User actions