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.
[pbcode]
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
Next
EndIf : y = Pops.y + 3
For t = 1 To Pops.Max : If Pops.Pick = t Then DrawImage Pops.PopUp + 20 ,Pops.x+spc-2 ,y+1 ,1
y = y + Pops.FontHeight
Next
EndFunction
[/pbcode]
`----------- end of code
Nice.. Keep those snippets coming !
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
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.
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