Pop Up Menu

[XpMe_v1.2]

Home made Pop Up Menu. Right mouse click to show.
Left mouse inside box on text to select with values returned
and displayed on example screen   or.... Left mouse click outside
box to hide pop up.
You can vary font size to change the pop up box size.
The box also is self centered and all of it stays on screen.
With optional solid line"__________"  separation and optional
small image loading(code will create colored boxes images if
no file bmp image is loaded. Increase text and lines or decrease
text and lines  as desired by changing the Pops.Max varible.
Looks nice and if fast.

PlayBASIC Code: [Select]

Type Popper
Txt        As String   ` pop up text
Pick       As Integer  ` selected text
Max        As Integer
PopUp      As Integer  ` popup image number AND loaded popup images
BmpON      As Integer  ` 1 = on  0 = off
Show       As Integer
x          As Integer
y          As Integer
oldFont    As Integer
FontName   As String
Font       As Integer
FontSize   As Integer
FontType   As Integer
FontWidth  As Integer
FontHeight As Integer
EndType
Dim Pops As Popper
Pops.Max = 7
Dim Ptxt(Pops.Max) As Popper
Create()
Repeat
DoSomeActionUnderThePopUp()
TextInfo()
       bt=MouseButton()
        mx=MouseX()
        my=MouseY()
DoPopUp(mx,my,bt)
Sync
Until SpaceKey()
End
`-------------------- CREATE POPUP Varibles
Function CreateTheVaribles()
Pops.oldFont   = GetCurrentFont()        ` store current font info to be restored later
Pops.FontName$ = "Ariel"                 ` CHANGE THIS AS NEEDED
Pops.Font      = GetFreeFont()           ` CHANGE THIS if NEEDED
Pops.FontSize  = 18                      ` CHANGE THIS AS NEEDED
Pops.FontType  = 0                       ` CHANGE THIS AS NEEDED  and ALL the below  Ptxt(n).Txt   AS NEEDED
           n = 1 : Ptxt(n).Txt = "DVD Tree Makers"
           n = 2 : Ptxt(n).Txt = "Grow that shrub"
           n = 3 : Ptxt(n).Txt = "@"               ` This letter causes a line to appear instead of text
           n = 4 : Ptxt(n).Txt = "@"               ` the program will skip the line if "@" is found.
           n = 5 : Ptxt(n).Txt = "Water Control"
           n = 6 : Ptxt(n).Txt = "@"
           n = 7 : Ptxt(n).Txt = "Muddy"
Pops.PopUp    = 100                                ` big Pop up Box number
EndFunction
`-------------------- CREATE POPUP IMAGES            Load the "Ariel" font as popFont, size 24, in the normal style
Function Create()
CreateTheVaribles()
Pops.BmpON = 1       ` 1 = on(images are to be loaded)    0 = off(no images loaded)
wh = Pops.FontSize-2
If Pops.BmpON = 1
`------      the images to be loaded must to match the text line number. If it is to be a line then no image will be
`------      loaded or required. This code only needs  "1.bmp" , "2.bmp" , "5.bmp" , "7.bmp"  to be loaded.
`------      load images at font size - 2  for best fit  ( image x size = wh-2   image y size = wh-2 )
`For t = 1 To Pops.Max
`If Ptxt(t).Txt <> "@" Then LoadImage CurrentDir$() + Str$(t) + ".bmp", Pops.PopUp + t
`Next
`------ use these below Colored boxes if you do not load any images
`------ or REMOVE the NEXT 3 LINES below when you do have images to load
For t = 1 To Pops.Max
If Ptxt(n).Txt <> "@" Then Cls RGB(Rnd(190)+23,Rnd(190)+10,Rnd(210)+20) : GetImage Pops.PopUp + t, 1,1,wh,wh
Next
EndIf
`------
`------
Cls RGB(0,0,0)
LoadFont Pops.FontName ,Pops.Font ,Pops.FontSize ,Pops.FontType          ` you selected font+size+style
 SetFont Pops.Font                                                       ` Set the pop up Font
w = 0 : a = 0
For t = 1 To Pops.Max : w = GetTextWidth(Ptxt(t).Txt) : If w > a Then a = w
Next  : Pops.FontWidth  = a                                              ` pop text width  max
        Pops.FontHeight = GetTextHeight(Ptxt(1).Txt)                     ` pop text heigth max
 psiz = Pops.FontSize
  spc = 6
If Pops.BmpON = 0 Then wide = Pops.FontWidth + psiz + spc + spc
If Pops.BmpON = 1 Then wide = Pops.FontWidth + psiz + psiz + spc + spc
BoxC 0,0 ,wide     ,Pops.FontHeight * Pops.Max     + spc ,1,RGB(  5,  5,  5)
BoxC 1,1 ,wide - 1 ,Pops.FontHeight * Pops.Max - 1 + spc ,1,RGB(222,222,222)
ho = Pops.FontHeight / 2
y = 3   : Lit = RGB(255,255,255) : Drk = RGB(100,100,100) : Grn = RGB(10,160,10)
For t = 1 To Pops.Max      : txx$ = Ptxt(t).Txt
If txx$ =  "@"
                    BoxC 2 , y+ho-1 ,wide-spc+2 , y+ho+2 ,1 ,Lit  ` draw lines
                   LineC 3 , y+ho   ,wide-spc+1 , y+ho      ,Drk
EndIf
If txx$ <> "@"
    If Pops.BmpON = 1 And Ptxt(n).Txt <> "@" Then DrawImage Pops.PopUp + t, psiz ,y ,1 ` draw loaded image
    If Pops.BmpON = 1 Then zzz = psiz + psiz + spc
    If Pops.BmpON = 0 Then zzz = psiz
                       Say(zzz + 1 , y   ,Lit, Ptxt(t).Txt)
                       Say(zzz     , y-1 ,Grn, Ptxt(t).Txt)                                  ` get highighted text while
GetImage Pops.PopUp+100+t ,zzz     , y-1, zzz+GetTextWidth(Ptxt(t).Txt),y-1+Pops.FontHeight  ` building the big pop up box
                       Say(zzz     , y-1 ,Drk, Ptxt(t).Txt)
EndIf
y = y + Pops.FontHeight
Next
 GetImage Pops.PopUp ,0,0 ,wide,Pops.FontHeight * Pops.Max + spc   ` get the big pop up box
Cls RGB(0,0,0)
EllipseC 6,6 ,4,4 ,1, RGB(255,255,255)
EllipseC 5,5 ,3,3 ,1, RGB(200,  5,  5)
GetImage Pops.PopUp + 20 ,0,0 ,10,10   ` get the Check Mark
SetFont Pops.oldFont   ` restore the original font
EndFunction
`-------------------- Print colored text
Function Say(tx,ty,ccc,txt$)
Ink ccc : Text tx,ty, txt$
EndFunction
`------------------------------------------------------------  DO THIS WHILE THE POPUP IS ON or OFF
Function DoSomeActionUnderThePopUp()
x=Rnd(150)+10 : y=Rnd(210)+120 : Cls RGB(110,210, 210)
w=Rnd(400)+10 : d=Rnd(200)+10  : BoxC x,y,x+w,y+d ,1, RGB(Rnd(150)+40 , Rnd(150)+40 , Rnd(150)+40)
EndFunction
`------------------------------------------------------------
Function TextInfo()
Say( 10,  2 ,RGB(9,9,9) ,Str$(FPS()) + " fps")
Say(240,  2 ,RGB(9,9,9) ,"SELECTED NUM = " + Str$(Pops.Pick) + "       VALUE = " + Ptxt(Pops.Pick).Txt) `PopUp 2 returned Values
Say(280,530 ,RGB(9,9,9) ,"RIGHT mouse Click to show popup.")
Say(280,550 ,RGB(9,9,9) ,"LEFT  mouse Click popup text to get a value and hide the popup.")
Say(280,570 ,RGB(9,9,9) ,"LEFT  mouse Click outside the popup to hide the popup.")
EndFunction
`-------------------------- pb = 2 = right mouse button || pb = 1 = left mouse button
Function DoPopUp(px,py,pb)
If pb = 2
   Pops.Show = 1    ` 1 = enable pop up   AND Center the Pop Up
   pw = GetImageWidth( Pops.PopUp) : wi = GetScreenWidth() :    Pops.x = px - pw / 2
                                                             If Pops.x + pw > wi Then Pops.x = wi - pw
                                                             If Pops.x < 0 Then Pops.x = 0
   ph = GetImageHeight(Pops.PopUp) : hi = GetScreenHeight():    Pops.y = py - ph / 2
                                                             If Pops.y + ph > hi Then Pops.y = hi - ph - 8
                                                             If Pops.y < 0 Then Pops.y = 0
                                                             Exitfunction
EndIf
If pb = 1
   If px < Pops.x Or px > Pops.x + GetImageWidth( Pops.PopUp)
   If py < Pops.y Or py > Pops.y + GetImageHeight(Pops.PopUp) Then Pops.Show = 0 ` hide Pop up
   EndIf
EndIf
                   If Pops.Show = 0 Then Exitfunction    ` if 0 then exit function to keep pop up off screen
spc = 6 :     DrawImage Pops.PopUp ,Pops.x,Pops.y ,0     ` show the  pop up box  then check for 4 possible mouse clicks
If px > Pops.x And px < Pops.x + GetImageWidth(Pops.PopUp)
y = Pops.y + 3
For t = 1 To Pops.Max
If py > y And py < y + Pops.FontHeight And Ptxt(t).Txt <> "@"
        psiz = Pops.FontSize : zzz = psiz                    : If Pops.BmpON = 1 Then zzz = psiz + psiz + spc
        DrawImage Pops.PopUp + 100 + t ,zzz + Pops.x ,y-1 ,0 : If pb = 1 Then Pops.Pick = t : Pops.Show = 0
EndIf : y = y + Pops.FontHeight

Login required to view complete source code

`----------- end of code

[kevin]

Nice..   Keep those snippets coming !

[tomazmb]

Hello,

It's nice indeed. Having FPS at > 500. I think it is very fast and the code is very readable. Thanks. Happy new Year!

Have a nice day,

Tomaz

[XpMe_v1.2]

I get between 520 - 530  fps   with a 3gig pentium 4  and  1gig duel memory using a ATI 7500 card. With Xp Sp2.
Nice to know it doesn't slow down with another computer and that it will work after you have moved the code to your computer.

[tomazmb]

Hello,

My computer is AMD64 - 2800+, 1Gig RAM DDR PC3200, ATI9800 Pro 128 MB, using XP Pro SP2, DirectX 9.0c. So we have basicly almost the same specification.

Have a nice day,

Tomaz