PopUp Menu ( NO DLLs required )

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

                                    ` 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
         INC y ,Pop.Spc
         NEXT t
         ENDIF
ENDIF
ENDIF
ENDFUNCTION