Text PopUps

[XpMe_v1.2]

Move you mouse over the text and have a text box(home made)
appear till you move mouse off.                   Set for 800x600rez.
Is this useful for anyone?  
`--------------
`--------------start of sample

PlayBASIC Code: [Select]

Type TipsTextHotSpots
Txt     As String   ` on screen text
Msg     As String   ` TipText
x       As Integer  ` on screen and TipText X locations
y       As Integer  ` on screen and TipText Y locations
DnCnt   As Integer  ` Change this value (per TipText) as you decrease or increase the line count
Max     As Integer  ` max on screen text and TipText
`colors
Cshadow,Cedge,Cinner,PtxtBk,PtxtUp,VtxtBk,VtxtUp 
EndType

    Dim Txts(3,10) As TipsTextHotSpots  ` Hot Spots ... on screen text - and TipText text

n = 0 : Txts(n, 0).Max = 3              ` on screen x,y text locations - x,y locations for pop ups displays
n = 1 : Txts(n, 0).Txt = "M. J. Fox"                                                 ` on screen text
        Txts(n, 0).x     = 399                                                       ` on screen text x location
        Txts(n, 0).y     = 16                                                        ` on screen text y location
        Txts(n, 0).DnCnt = 3                                                         ` TipText text count
        Txts(n, 1).Msg = " I am the town's loan shark. "                             ` TipText text
        Txts(n, 2).Msg = " Do you have anything of value on you ? "                  ` TipText text
        Txts(n, 3).Msg = " I can offer you the best prices on whatever you have ! "  ` TipText text
n = 2 : Txts(n, 0).Txt   = "Johnny B. Goodrich"                                      ` on screen text
        Txts(n, 0).x     = 14                                                        ` on screen text x location
        Txts(n, 0).y     = 156                                                       ` on screen text y location
        Txts(n, 0).DnCnt = 2                                                         ` TipText text count
        Txts(n, 1).Msg   = " Welcome to my village. "                                ` TipText text
        Txts(n, 2).Msg   = " I am the town drunk. "                                  ` TipText text
n = 3 : Txts(n, 0).Txt   = "Dean S. Weaver"                                          ` on screen text
        Txts(n, 0).x     = 580                                                       ` on screen text x location
        Txts(n, 0).y     = 558                                                       ` on screen text y location
        Txts(n, 0).DnCnt = 3                                                         ` TipText text count
        Txts(n, 1).Msg   = " This village is mine. "                                 ` TipText text
        Txts(n, 2).Msg   = " Do not stay here any longer than you need to "          ` TipText text
        Txts(n, 3).Msg   = " or you will not live regret it. "                       ` TipText text
        Txts(0, 0).Cshadow = RGB( 22, 22, 22) ` TipText box  shadow color
        Txts(0, 0).Cedge   = RGB(217,211, 77) ` TipText box  edge   color
        Txts(0, 0).Cinner  = RGB(170,170,170) ` TipText box  inner  color
        Txts(0, 0).PtxtBk  = RGB(220,220,220) ` TipText text under  text  color
        Txts(0, 0).PtxtUp  = RGB( 17, 17, 17) ` TipText text over   text  color
        Txts(0, 0).VtxtBk  = RGB( 37, 37,122) ` Visible Text text   under text color
        Txts(0, 0).VtxtUp  = RGB(167,167,255) ` Visible Text text   over  text color

`--------------
OpenScreen 800,600,32,1
TitleScreen "TIP TEXT"

`--------------
Repeat
Cls RGB(55,55,155) :      Txs(7,2,"press left mouse button to quit",RGB(7,7,7),RGB(217,217,11))
                          Txs(7,2,"press left mouse button to quit",RGB(7,7,7),RGB(217,217,11))
For n = 1 To Txts(0,0).Max
             Txs(Txts(n,0).x , Txts(n,0).y, Txts(n,0).Txt , Txts(0,0).VtxtBk , Txts(0,0).VtxtUp) `show on screen text
Next
   mx = MouseX()
   my = MouseY()
CheckTipTextXY(mx,my)                     ` check mouse over on screen text for pop ups
Sync
Until LeftMouseButton()
END

`--------------
Function Boxs(bx,by,bw,bh,be)
BoxC bx + 2 ,by + 2 ,bx + bw + 3 ,by + bh + be + 5 ,1, Txts(0,0).Cshadow   ` draw box shadow
BoxC bx     ,by     ,bx + bw + 1 ,by + bh + be + 3 ,1, Txts(0,0).Cedge     ` draw box wrapper
BoxC bx + 1 ,by + 1 ,bx + bw     ,by + bh + be + 2 ,1, Txts(0,0).Cinner    ` draw box inner
EndFunction

`--------------
Function Txs(tx,ty, txt$, coBak,coFor)
Ink coBak : Text tx+1, ty+1 ,txt$ : Ink coFor : Text tx , ty ,txt$
EndFunction

`-------------- check mouse over on screen text for pop ups
Function CheckTipTextXY(ox,oy)
For n = 1 To Txts(0,0).Max
w = GetTextWidth( Txts(n,0).Txt) : h = GetTextHeight(Txts(n,0).Txt)  ` get on screen text width + height
` check mouse x + on screen text width  AND  y + on screen text height for TipText hot area
` If Mouse is over a hot area Then display TipText
If ox>Txts(n,0).x And ox<Txts(n,0).x+w And oy>Txts(n,0).y And oy<Txts(n,0).y+h Then TipTextMessage(n,ox,oy+11) :ExitFor
Next
EndFunction

`-------------- display TipText
Function TipTextMessage(Num,x,y)
                                 h = GetTextHeight(Txts(Num,1).Msg) ` drop down text height spacing
For n = 1 To Txts(Num,0).DnCnt : a = GetTextWidth( Txts(Num,n).Msg) : If i<a Then i=a`get the longest text length value
Next
w = i    :    e = h * Txts(Num,0).DnCnt - h    :   k = h * Txts(Num,0).DnCnt
bk = w / 2
xx = x - bk : If xx < 0 Then xx = 0
yy = y
If xx+w > GetScreenWidth()  Then xx = GetScreenWidth()  - w - 1       ` force  tips to
If yy+k > GetScreenHeight() Then yy = GetScreenHeight() - k - e - 24  ` stay on screen
Boxs(xx,yy,w,h,e)
For n = 1 To Txts(Num,0).DnCnt
If Len(Txts(Num,n).Msg) > 0
        Txs(xx ,yy + hh, Txts(Num,n).Msg ,Txts(0,0).PtxtBk ,Txts(0,0).PtxtUp) `draw text IF length is > 0
EndIf
hh=hh+h
Next
EndFunction

`--------------end of sample

[kevin]

yeah that's nice !

[empty]

Indeed! :)

[tomazmb]

Hello XpMe v1.2,

I didn't noticed this example before, but it is really nice. Hope you'll never lose an inspiration to produce this programming gems. :)

Have a nice day,

Tomaz