TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Input

Version: 1.0

Information

Uploaded: 3rd Sep 2004 16:20

Modified: 1st Jan 1970 01:00

Author: XpMe

Summary

PopUp Menu ( NO DLLs required )

Full Description

This is a Pop Up Menu (no sub menus) contained in 1 function. NO DLLs required. Call to set the varible values. Call to build the images. Call to turn on. Call to show and get input. Right mouse click if not visible to make visible. When visible... Move mouse inside image to hilight text. Left mouse click on text to select then hide image. Left mouse click outside image to hide it. Displays.. Text(hilighted if mouse is over) Check Mark(if you have made a selection with the mouse) Small Image(if you have included image names to load) Values returned on selections appear at top of screen and updated on mouse click selections. Also made simple random boxes appear below popup to show that the popup can be displayed and return values while other things go on. Frames per second also displayed. I suggest you put this function in it's own file since it is about 130 lines long. Sub menus not included. Sub menus would make for even more code. I suggest to make another popup and have it appear when the selection for a submenu is made. It uses 6 colors for the menu and menu text. Built in control to keep popup inside the screen. IF the font size ( Pop.Siz = 12 ) number is a larger number then you will get a larger popup menu. IF you make it too large then remember that you are using images and need to avoid making things too large or you will get an off screen get error. This includes Pop.Max being set too big also. Tested several times(at 640x 480y rez.) before posting. ...XpMe

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: PopUp

Rem Created: 9/2/2004 5:03:23 PM

Rem ***** Main Source File *****

` IF the font size ( Pop.Siz = 12 ) number is a larger number then you will get a larger popup menu.

` IF you make it too large then remember that you are using images and need to avoid making things

` too large or you will get an off screen error. This includes Pop.Max being set too big also.

TYPE PopUpList

Path AS STRING   ` file path

TmpBitMap AS INTEGER  ` temp bitmap number to be used and then deleted

Img AS INTEGER  ` popup image number PLUS the next 30 numbers(for text hilight) if Pop.Max is set to 30

offon AS INTEGER  ` 0 = not visible / 1 = visible / -99 = set all popup varibles / -1 = build popup images

Delay AS INTEGER  ` delay button click

X AS INTEGER  ` left   of popup

Y AS INTEGER  ` top    of popup

W AS INTEGER  ` width  of popup

D AS INTEGER  ` height of popup

Spc AS INTEGER  ` text up-down spacing

Max AS INTEGER  ` max number of text

Pick AS INTEGER  ` selected text

HiLi AS INTEGER  ` hilight text when mouse is over

c AS INTEGER  ` colors

Mark AS STRING   ` check mark

Txt AS STRING   ` text list

Fnt AS STRING   ` text font

Siz AS INTEGER  ` text font size

ImName AS STRING   ` small image name      To fit on screen USE approx. 10x10y images

offset AS INTEGER  ` small image offset value

ENDTYPE

Pop AS PopUpList

DIM Co(6,3)   AS PopUpList           `colors    array

DIM Tx(30)    AS PopUpList           `text list array

DIM SmImg(30) AS PopUpList           `small image display array

Pop.offon = -99 : Pop.TmpBitMap = 3 : Pop.Path = GET DIR$() + "\"

PopUp()

SYNC ON : SYNC RATE 0 : SET IMAGE COLORKEY 0,0,0

PopUp()    ` yes it is called again

REPEAT     ` PopUp will disappear if you RIGHT mouse click anywhere.

mx = MOUSEX() : my = MOUSEY() : bt = MOUSECLICK()

cls RGB(Co(0,1).c,Co(0,2).c,Co(0,3).c)

DoSomeActionUnderThePopUp()

n = 3 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0

TEXT 8,462, STR$(SCREEN FPS()) + " fps"

TEXT 8,  2 ,"SELECTED NUM = " + STR$(Pop.Pick) + "    VALUE = " + Tx(Pop.Pick).Txt ` PopUp 2 returned Values

TEXT 8, 16 ,"RIGHT mouse Click to show popup."

TEXT 8, 30 ,"Click popup text to get a value and hide the popup."

TEXT 8, 46 ,"Click outside the popup to hide the popup"

PopUp()    ` PopUp will disappear if you LEFT mouse click outside the image

SYNC

UNTIL ESCAPEKEY()

END

`------------------------------------------------------------

FUNCTION DoSomeActionUnderThePopUp()

n = rnd(5)+1  : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0  ` DO THIS WHILE THE

BOX 50+RND(150), 90+RND(150) ,155+RND(150) ,155+RND(150)  ` POPUP IS ON or OFF

ENDFUNCTION

`------------------------------------------------------------

FUNCTION PopUp()

mx = MOUSEX() : my = MOUSEY() : bt = MOUSECLICK()

`----------  IF POPUP IS OFF AND YOU RIGHT MOUSE CLICKED THEN TURN IT ON AND POSITION POPUP IMAGE

IF bt = 2 AND Pop.offon = 0

Pop.X = mx-Pop.W/2

Pop.Y = mY-6

x = Pop.X : IF x < 0 THEN x = 0

y = Pop.Y : IF y < 0 THEN y = 0

r = Pop.W : IF x + r > SCREEN WIDTH()  THEN x = SCREEN WIDTH() - r

d = Pop.D : IF y + d > SCREEN HEIGHT() THEN y = SCREEN HEIGHT()- d

Pop.X = x : Pop.Y = y

Pop.offon = 1 : Pop.Delay = TIMER() + 300 : EXITFUNCTION

ENDIF

`----------    SET POPUP VARIBLES

IF Pop.offon = -99

n = 0 : Co(n,1).c = 150 :Co(n,2).c = 150 :Co(n,3).c = 110

n = 1 : Co(n,1).c = 9   :Co(n,2).c = 9   :Co(n,3).c = 9

n = 2 : Co(n,1).c = 220 :Co(n,2).c = 220 :Co(n,3).c = 220

n = 3 : Co(n,1).c = 240 :Co(n,2).c = 240 :Co(n,3).c = 240

n = 4 : Co(n,1).c = 255 :Co(n,2).c = 255 :Co(n,3).c = 255

n = 5 : Co(n,1).c =  10 :Co(n,2).c =  10 :Co(n,3).c =  10

n = 6 : Co(n,1).c =  44 :Co(n,2).c = 111 :Co(n,3).c = 44

n = 1 : Tx(n).Txt = "DVD FILE BROWSER"

n = 2 : Tx(n).Txt = "PLAY that DVD"

n = 3 : Tx(n).Txt = "_"             ` This letter causes a line to appear instead of text

n = 4 : Tx(n).Txt = "_"             ` the program will skip the line if "_" is found.

n = 5 : Tx(n).Txt = "Volume Control"

n = 6 : Tx(n).Txt = "Mute"

Pop.Max = n

n = 1 : SmImg(n).ImName = Pop.Path + "3.bmp"    ` To fit on screen USE approx. 10x10y images

n = 5 : SmImg(n).ImName = Pop.Path + "1.bmp"

n = 6 : SmImg(n).ImName = Pop.Path + "2.bmp"

FOR t = 1 TO Pop.Max : IF LEN(SmImg(t).ImName) > 0 THEN Pop.offset = 15 : EXIT ` offset the text if any image included

NEXT t

Pop.Img   = 100

Pop.X     = 10

Pop.Y     = 10

Pop.W     = 0

Pop.D     = 0

Pop.Pick  = 0

Pop.HiLi  = 0

Pop.Mark = CHR$(35) ` <- 35 = # character Change this number for other Check Mark symbols

Pop.Fnt = "ARIAL"    ` the font

Pop.Siz = 12         ` the font size  If larger then you will get a larger popup menu

Pop.Delay = TIMER()

Pop.offon = -1         : EXITFUNCTION

ENDIF

`----------  CREATE POPUP IMAGES

IF Pop.offon = -1

BitNum = CURRENT BITMAP()  : CREATE BITMAP Pop.TmpBitMap ,640,480  : CLS RGB(0,0,0)

Fnt$ = TEXT FONT$()      : Tsiz = TEXT SIZE()  ` store current font info to be restored later

SET TEXT FONT Pop.Fnt : SET TEXT SIZE Pop.Siz

w = 0  : a = 0 : FOR t = 1 TO 30 :  w = TEXT WIDTH( Tx(t).Txt) : IF w > a THEN a = w

NEXT t           : wi = a

hi = TEXT HEIGHT(Tx(1).Txt)

Pop.W = wi + 18 + Pop.offset

y = Pop.Y  : Pop.Spc = hi

FOR t = 1 TO Pop.Max

n = 1 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 :  BOX Pop.X + 1  ,y + 1 ,Pop.X + Pop.W     ,y + hi+2

n = 2 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 :  BOX Pop.X + 1  ,y + 1 ,Pop.X + Pop.W - 2 ,y + hi+1

IF Tx(t).Txt = "_"

n = 4 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X + 1  ,y + 3 ,Pop.X + Pop.W - 2 ,y + 3

n = 5 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X + 1  ,y + 4 ,Pop.X + Pop.W - 2 ,y + 4

n = 4 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X + 1  ,y + 5 ,Pop.X + Pop.W - 2 ,y + 5

ELSE

IF LEN(SmImg(t).ImName) > 0

g = Pop.Img + Pop.Max + 2 : LOAD IMAGE SmImg(t).ImName ,g ,1 : PASTE IMAGE g ,Pop.X + 13 ,y ,1

ENDIF

n = 4 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : TEXT Pop.X + 14 + Pop.offset ,y + 1 ,Tx(t).Txt

n = 5 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : TEXT Pop.X + 13 + Pop.offset ,y     ,Tx(t).Txt

ENDIF

INC y,hi

NEXT t

n = 3 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X              , Pop.Y , Pop.X             , y

n = 3 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X + Pop.W - 2  , Pop.Y , Pop.X + Pop.W - 2 , y

n = 3 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X              , Pop.Y , Pop.X + Pop.W - 1 , Pop.Y

n = 3 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : LINE Pop.X              , y     , Pop.X + Pop.W - 1 , y

Pop.D = y + 2

GET IMAGE Pop.Img, Pop.X ,Pop.Y ,Pop.X + Pop.W ,y + 2 ,1

SPRITE Pop.Img,0,0,Pop.Img : Pop.W = SPRITE WIDTH(Pop.Img) : Pop.D = SPRITE HEIGHT(Pop.Img) : DELETE SPRITE Pop.Img

y = Pop.Y

FOR t = 1 TO Pop.Max                                                      : CLS RGB(0,0,0)

IF Tx(t).Txt <> "_" THEN n = 6 : INK RGB(Co(n,1).c,Co(n,2).c,Co(n,3).c),0 : TEXT Pop.X + 13 ,y ,Tx(t).Txt

GET IMAGE Pop.Img + t ,Pop.X ,y ,Pop.X + Pop.W , y + Pop.Spc , 1

NEXT t

CLS RGB(0,0,0) :            TEXT Pop.X + 5 ,y ,Pop.Mark

GET IMAGE Pop.Img + Pop.Max + 1 ,Pop.X ,y ,Pop.X + Pop.Spc , y + Pop.Spc , 1

SET TEXT FONT Fnt$ : SET TEXT SIZE Tsiz ` restore older stored font info

DELETE BITMAP Pop.TmpBitMap : SET CURRENT BITMAP BitNum : Pop.offon = 0 : EXITFUNCTION

ENDIF

`----------

IF Pop.offon = 1

IF Pop.Delay < TIMER()

bt = MOUSECLICK()

mx = MOUSEX()

my = MOUSEY()

IF bt = 1

IF mx < Pop.X THEN Pop.offon = 0 : EXITFUNCTION ` hide popup

IF my < Pop.Y THEN Pop.offon = 0 : EXITFUNCTION ` if you left mouse

IF mx > Pop.X + Pop.W THEN Pop.offon = 0 : EXITFUNCTION  ` click outside

IF my > Pop.Y + Pop.D THEN Pop.offon = 0 : EXITFUNCTION  ` of it.

ENDIF

y = Pop.Y : PASTE IMAGE Pop.Img ,Pop.X,Pop.Y ,1

FOR t = 1 TO Pop.Max

IF mx > Pop.X AND mx < Pop.X + Pop.W AND my > y AND my < y + Pop.Spc

PASTE IMAGE Pop.Img + t ,Pop.X+ Pop.offset  ,y ,1  ` if mouse is over text

ENDIF                                              ` then text will hilight there

IF Pop.Pick = t

PASTE IMAGE Pop.Img + Pop.Max + 1 ,Pop.X ,y ,1     ` if Pop.Pick is selected

ENDIF

INC y ,Pop.Spc

NEXT t

IF mx > Pop.X AND mx < Pop.X + Pop.W AND my > Pop.Y AND my < Pop.Y + Pop.D

y = Pop.Y

FOR t = 1 TO Pop.Max

IF my > y AND my < y + Pop.Spc ` if mouse is over text and

IF bt = 1                                                    ` you have LEFT clicked the

IF LEN(Tx(t).Txt) > 0                                        ` mouse and text is > "" and

IF Tx(t).Txt <> "_" THEN Pop.Pick = t : Pop.offon = 0 : EXIT ` <> "_" then the popup will

ENDIF                                                        ` close and you will receive

ENDIF                                                        ` two values returned in

ENDIF                                                        ` Pop.Pick  AND  Tx(Pop.Pick).Txt

CodeBase - PopUp Menu

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	XpMe
CodeBase Entries:	1