Mouse key pad

[XpMe_v1.2]

Here is a different way to enter text information.

Pop Up Mouse key pad For entering up To 20 letters.
        is visible when Right Mouse is clicked.
             hides when Enter is clicked.
Draggable top bar.
With returned values.

PlayBASIC Code: [Select]

` This code may be added to for more options by making it taller
` to add more button controls. But it does a good job by itself.
Global PadOffOn = 0
Global Drag     = 0
Global Dragger  = 90
Global BackSpc  = 93
Global Enter    = 96
Global Img      = 100
Global Xkey     = 100
Global Ykey     = 100
Global Info$    = ""
Global EnteredInfo$ = "EMPTY"
Global oldfont = GetFreeFont() : LoadFont "Courier New"  ,oldfont,16,0  `normal text
Global newfont = GetFreeFont() : LoadFont "Courier New"  ,newfont,16,3  `Combined Bold + Italics
`----------------------
OpenScreen 640,480,32,1
TitleScreen "MOUSE KEY PAD"
CenterScreen
BuildKeyPad()
`----------------------
Repeat
Cls RGB(222,222,200)
Say(3,10, RGB(255,255,255),RGB(95,95,95) ,"Hold and drag top bar by pressing the left mouse button and dragging over it.")
Say(3,30, RGB(255,255,255),RGB(95,95,95) ,"Texas")
Say(3,50, RGB(255,255,255),RGB(95,95,95) ,"Entered Information.... " + EnteredInfo$)
If PadOffOn = 0 Then Say(3,80, RGB(255,255,255),RGB(95,95,95) ,"Right Mouse Click to show Key Pad"    )
If PadOffOn = 1 Then Say(3,80, RGB(255,255,255),RGB(95,95,95) ,"Click ENTER key to close the Key Pad" )
Say(3,110, RGB(255,255,255),RGB(95,95,95) ,"fps " + Str$( FPS() ) )
But = MouseButton()
Mxx = MouseX()
Myy = MouseY()
    If Drag = 1 Then Xkey = Mxx - 88 : Ykey = Myy - 9  `if left mouse is down then keep up with it
If PadOffOn = 0
     If But = 2
              Xkey = Mxx - 88 : Ykey = Myy - 9 `if right mouse is down then get new X,Y position + Enables visibility
              PadOffOn = 1                     `  and stop it from getting any  new X,Y positions
     EndIf
EndIf
If PadOffOn = 1
DrawImage Img ,Xkey,Ykey ,1
CheckAndDrawHiLi(Mxx,Myy,But)      `check for mouse over buttond and highlight as needed
ChecksForDragPad(Mxx,Myy,But)      `check if mouse is over top drag bar and positions the X,Y
If Drag = 1 Then DrawImage Dragger+2 ,Xkey,Ykey, 1 : Entered(Info$) `drag colored image bar is shown if mouse = 1
EndIf
Sync
Until EnterKey()
End
`---------------------- shapes maker
Function Cube(xx,yy ,ww,dd, cc1,cc2)
BoxC xx   ,yy   ,ww   ,dd   ,1, cc1
BoxC xx+1 ,yy+1 ,ww-1 ,dd-1 ,1, cc2
EndFunction
`---------------------- text maker
Function Say(xx,yy ,cc1,cc2 ,Txt$)
Ink cc1 : Text xx+1 ,yy+1   ,Txt$
Ink cc2 : Text xx,yy,Txt$
EndFunction
`---------------------- create images  (builds big image while getting small images.(saves repeating code) )
Function BuildKeyPad()
SetFont newfont
zx=15 :zy=15 :x=zx :y=zy :w=176 :D=242 :tip=18 :bot=18
Cube( x+1  ,y+1 ,x+w+1 ,y+d+1       ,RGB(9,9,9) ,RGB(199,199, 99) )
Cube( x    ,y   ,x+w   ,y+d         ,RGB(9,9,9) ,RGB(169,139, 99) )

For e = 1 To 3 : cc = RGB(200,160,140) : If e = 1 Then cc = RGB(222,222,102)
                                         If e = 2 Then cc = RGB(142,222,142)
Cube( x+1  ,y+1 ,x+w+1 ,y+tip+1     ,RGB(9,9,9) ,RGB(199,199, 99) )          `Top bar
Cube( x    ,y   ,x+w   ,y+tip       ,RGB(9,9,9) ,cc )
 Say( x+4  ,y                       ,RGB(255,255,255) ,RGB(1,1,1) ,"Mouse Key Pad" )
                                         If e = 1 Then GetImage Dragger+1 ,x,y, x+w,y+tip
                                         If e = 2 Then GetImage Dragger+2 ,x,y, x+w,y+tip
Next

Cube( x+1  ,y-bot+d+1 ,x+w+1 ,y+d+1 ,RGB(9,9,9) ,RGB(199,199, 99) )    `Bottom entered information bar
Cube( x    ,y-bot+d   ,x+w   ,y+d   ,RGB(9,9,9) ,RGB(244,214, 74) )

n=0:xx=zx+4:x=xx:y=zy+22 :w=15:d=18:spc=2
For t = 0 To 94
For e = 1 To 3 : cc = RGB(222,222,220) : If e = 1 Then cc = RGB(222,222,102)   `All small buttons
                                         If e = 2 Then cc = RGB(142,222,142)
Cube( x  ,y, x+w,y+d ,RGB(  9,  9,  9) ,cc )
 Say( x+3,y          ,RGB(255,255,255) ,RGB( 95, 95, 95) ,Chr$(32+t) )
                                         If e = 1 Then GetImage Img+1+t     ,x,y, x+w,y+d
                                         If e = 2 Then GetImage Img+1+t+100 ,x,y, x+w,y+d
Next
x=x+w+spc : Inc n: If n=10 Then n=0 :x=xx :y=y+d+spc
Next

For e = 1 To 3  : cc = RGB(222,222,220) : If e = 1 Then cc = RGB(222,222,102)
                                          If e = 2 Then cc = RGB(142,222,142)
Cube( x+4  ,y, x+w+12,y+d ,RGB(  9,  9,  9) ,cc )
 Say( x+7  ,y             ,RGB(255,255,255) ,RGB( 95, 95, 95) ,"<<" )          `back space button
                           If e = 1 Then GetImage BackSpc+1 ,x+4,y, x+w+12,y+d
                           If e = 2 Then GetImage BackSpc+2 ,x+4,y, x+w+12,y+d
Next

For e = 1 To 3  : cc = RGB(222,222,220) : If e = 1 Then cc = RGB(222,222,102)
                                          If e = 2 Then cc = RGB(142,222,142)
Cube( x+34  ,y, x+w+68,y+d ,RGB(  9,  9,  9) ,cc )
 Say( x+40  ,y             ,RGB(255,255,255) ,RGB( 95, 95, 95) ,"enter" )      ` enter button
                           If e = 1 Then GetImage Enter+1 ,x+34,y, x+w+68,y+d
                           If e = 2 Then GetImage Enter+2 ,x+34,y, x+w+68,y+d
Next
zx=15 :zy=15 :x=zx :y=zy :w=176 :D=242:  GetImage Img ,x,y, x+11+w,y+11+d        `BIG image
SetFont oldfont
EndFunction
`---------------------- bottom bar to hold text you have entered
Function Entered(Inf$)
Say(Xkey+4,Ykey+224 ,RGB(177,177,99) ,RGB(5,5,5) ,Inf$ )
EndFunction
`---------------------- mouse clicks input
Function CheckAndDrawHiLi(Mx,My,Bt)
If Drag = 1 Then Exitfunction  `exit if drag is enabled
`--- all small keys
 xx=Xkey+ 4 : x=xx : w=15
  y=Ykey+22 :        d=18 : spc=2 : n=0
If My>Ykey And My<Ykey+d Then DrawImage Dragger+1 ,Xkey,Ykey, 1
For t = 0 To 94
If My > y   And My < y+d
If Mx > x+4 And Mx < x+w
             If Bt = 0 Then DrawImage Img+1+t     ,x ,y ,1   : ee = 1 : Entered(Info$) : Sync: ExitFor
             If Bt = 1
                            If Len(Info$) < 21 Then Info$ = Info$ + Chr$(32+t)
                            DrawImage Img+1+t+100 ,x ,y ,1            : Entered(Info$) : Sync
                            Repeat
                            Until MouseButton() = 0          : ee = 1 : ExitFor
             EndIf
EndIf
EndIf : x=x+w+spc
Inc n : If n=10 Then n=0 :x=xx :y=y+d+spc
Next  : If ee = 1 Then Exitfunction
`--- backspace key
x=Xkey+93 : y=Ykey+202 : w=23 :D=18
If My > y And My < y+d And Mx > x And Mx < x+w
              If Bt = 0 Then DrawImage BackSpc+1  ,x ,y ,1
                 m = Len(Info$)
              If m > 0 And Bt = 1
                               Info$ = Left$(Info$, m-1)
                               DrawImage BackSpc+2 ,x ,y ,1 : Entered(Info$) : Sync
                               Repeat
                               Until MouseButton() = 0
              EndIf
EndIf
`--- enter key
x=Xkey+123 : y=Ykey+202 : w=49 :D=18
If My > y And My < y+d And Mx > x And Mx < x+w
              If Bt = 0 Then DrawImage Enter+1  ,x ,y ,1
              If Bt = 1
                             EnteredInfo$ = "EMPTY" : If Len(Info$) > 0 Then EnteredInfo$ = Info$

Login required to view complete source code

[XpMe_v1.2]

A : followed the letter d      
have been replaced by     happy  :D  faces    
which should be  a    
: followed the letter d      
in those locations.
Must be the forum program doing that.
I had to separate them in this new post just to tell you what they are.

[tomazmb]

Hello XpMe v1.2,

Can you proceed a bit slower, I can't study so many of your examples, my head hurt! :D

It's a great example and it's fun!

Have a nice day,

Tomaz

P.S. I noticed before that forum does strange things to posted source codes. I guess we'll see a lot of smiles in the future! ;)