Make and use Slider Bars images

[XpMe_v1.2]

Create and use slider bars  with an optional save to be used with my post listed after this source code.
Uses the mouse. With on screen values.

PlayBASIC Code: [Select]

`---------------- SLIDERS CREATOR AND (Optional) Saver ----------------
Dim Info$(5)
    Info$(0) = "  Mouse is outside of Button area "
    Info$(1) = "  Mouse is  INSIDE of Button area "
    Info$(2) = "  Mouse is  INSIDE of Button area "
    Info$(3) = " with mouse pressed"
    Info$(4) = "Press ENTER key TO QUIT"
    Info$(5) = "Mouse Pressed  Value = "
                           `  >> Note...  If the direction is to be left to right then...
                           `  >> The source code for   .x  is setup only for either 120 or 220 <<
                           `  >> Note...  If the direction is to be up   to down  then...
                           `  >> The source code for   .y  is setup only for either 120 or 220 <<
                           `  >> The source code for .Max  is setup only for either Max = 100 or Max = 200
                           `     to match the length of either .x or .y
                           `     Remember not to draw off screen if you change the .x and .y numbers
Type Sliders
   Cnt As Integer  ` number of Slider Buttons
  Tilt As Integer  ` position of the Sliders     0 = up-down or  1 = left-right
     x As Integer  ` left Slider pos
     y As Integer  ` top  Slider pos
     w As Integer  ` width  of Slider
     d As Integer  ` height of Slider
  Deep As Integer  ` depth  of Slider
   Max As Integer  ` Max Slider read
 press As Integer  ` used for mouse info   0 = outside slider bar   1 = inside hover   2 = inside mouse down
 value As Integer  ` Slider returned value(if .MAX=200 then its just right to set MUSIC volume without converting)
imgBar As Integer  ` Slider bar image numbers 0 -  2
 imgUD As Integer  ` center button image Up Down
ButUDw As Integer  ` width  of Slider Button
ButUDd As Integer  ` height of Slider Button
 imgLR As Integer  ` center button image Left Right
ButLRw As Integer  ` width  of Slider Button
ButLRd As Integer  ` height of Slider Button
Fpath  As String   ` Start Up File Path
EndType
Dim Ss(6) As Sliders
Ss(0).Cnt = 6
n = 0 : Ss(n).Fpath = CurrentDir$()
n = 0 : Ss(n).imgUD = 1 : Ss(n).ButUDw = 14 : Ss(n).ButUDd = 10
        Ss(n).imgLR = 2 : Ss(n).ButLRw = 10 : Ss(n).ButLRd = 14
For n = 1 To Ss(0).Cnt
Ss(n).Tilt  = ReadData() : Ss(n).x     = ReadData() : Ss(n).y      = ReadData()
Ss(n).w     = ReadData() : Ss(n).d     = ReadData() : Ss(n).Max    = ReadData()
Ss(n).press = ReadData() : Ss(n).value = ReadData() : Ss(n).imgBar = ReadData()
Ss(n).Deep  = 4 ` shadow depth
Next
Data 0 ,  10 , 250 ,  18 , 220 , 200 , 0 , 100 , 10
Data 0 ,  50 , 250 ,  18 , 220 , 200 , 0 , 100 , 20
Data 1 , 100 , 250 , 220 ,  18 , 200 , 0 , 100 , 30
Data 1 , 100 , 310 , 220 ,  18 , 200 , 0 , 100 , 40
Data 0 , 430 , 270 ,  18 , 120 , 100 , 0 ,  50 , 50
Data 1 , 500 , 380 , 120 ,  18 , 100 , 0 ,  50 , 60
`----------------------
Type SlidersColors
`shadow`outer edge`inner edge`inside`bar line`bar line shadow
Color1 , Color2 , Color3 , Color4 , Color5 , Color6
EndType
Dim Co(3) As SlidersColors
`---
n = 1 : Co(n).Color1 = RGB( 25, 25, 25)
        Co(n).Color2 = RGB(255,255,  0)
        Co(n).Color3 = RGB(255,  0,  0)
        Co(n).Color4 = RGB(149,206,130)
        Co(n).Color5 = RGB(  5,  5,  5)
        Co(n).Color6 = RGB( 55,115, 55)
n = 2 : Co(n).Color1 = RGB( 25, 25, 25)
        Co(n).Color2 = RGB(225,225,  0)
        Co(n).Color3 = RGB(225,  0,  0)
        Co(n).Color4 = RGB(120,180,100)
        Co(n).Color5 = RGB(  5,  5,  5)
        Co(n).Color6 = RGB( 45,100, 45)
n = 3 : Co(n).Color1 = RGB( 25, 25, 25)
        Co(n).Color2 = RGB(205,205,  0)
        Co(n).Color3 = RGB(205,  0,  0)
        Co(n).Color4 = RGB( 88,140, 50)
        Co(n).Color5 = RGB(  5,  5,  5)
        Co(n).Color6 = RGB( 25, 70, 25)
`----------------------
MakeSliderButtons()
    MakeSliderBar()
    DoTheMAINloop()
`-----------------------
Function ShowSliderInfo()
y = 10 :         Text 14 ,-2, "fps = " + Str$( FPS() )
                 Text 217,-2, Info$(4)
For n = 1 To Ss(0).Cnt
For e = 0 To 2 : If Ss(n).press = e Then Mhover$ = Info$(e) + Str$(n)
                 If Ss(n).press = 2 Then Mhover$ = Mhover$ + Info$(3)
Next e         : Text 9 , y    , Info$(5) + Str$( Ss(n).press ) + Mhover$
vv = Ss(n).value
If Ss(n).MAX = 200 Then vv = vv / 2
                 Text 9 , y + 12 , "Mouse Slider " + Str$(n) + " Value = " + Str$( vv )
y=y+28
Next n
EndFunction
`----------------
Function MakeSliderBar()
For n = 1 To Ss(0).Cnt : BarBoxes( n , 0 , 1)
                         BarBoxes( n , 1 , 2)
                         BarBoxes( n , 2 , 3)
Next
EndFunction
`-----------------------
Function BarBoxes(Num, n ,c)
Cls RGB(0,0,0) : x = Ss(Num).x
                 y = Ss(Num).y
                 w = Ss(Num).x + Ss(Num).w
                 d = Ss(Num).y + Ss(Num).d
                 p = Ss(Num).Deep
                 BoxC x+1 , y+1 , w + p , d + p ,1,Co©.Color1     ` shadow depth
                 BoxC x-1 , y-1 , w + 1 , d + 1 ,1,Co©.Color2     ` outer edge
                 BoxC x   , y   , w     , d     ,1,Co©.Color3     ` inner edge
                 BoxC x+1 , y+1 , w - 1 , d - 1 ,1,Co©.Color4     ` inside
If Ss(Num).Tilt = 0
   r = Ss(Num).w / 2
   m = x+r-1 : dn = y + 10
   BoxC m-1, dn-1 , m+3 , dn + Ss(Num).Max ,1,Co©.Color6
   BoxC m  , dn   , m+2 , dn + Ss(Num).Max ,1,Co©.Color5
   For e = dn To dn + Ss(Num).Max Step 5 : BoxC  m-3 , e-1 , m+5 , e+1 ,1, Co©.Color6
                                          LineC  m-2 , e   , m+4 , e      ,Co©.Color5
   Next
EndIf
If Ss(Num).Tilt = 1
   u = Ss(Num).d / 2
   m = y+u-1 : wi = x + 10
   BoxC wi-1, m-1 , wi + Ss(Num).Max , m+3 ,1,Co©.Color6
   BoxC wi  , m   , wi + Ss(Num).Max , m+2 ,1,Co©.Color5
   For e = wi To wi + Ss(Num).Max Step 5 : BoxC e-1 , m-3 , e+1 , m+5 ,1,Co©.Color6
                                          LineC e   , m-2 , e   , m+4   ,Co©.Color5
   Next
EndIf :    GetImage Ss(Num).imgbar + n , x-1 , y-1 , w + p , d + p
EndFunction
`-----------------------
Function MakeSliderButtons()
Cls RGB(0,0,0)
BoxC 2 , 2 , Ss(0).ButUDw   , Ss(0).ButUDd    ,1,Co(1).Color1
BoxC 0 , 0 , Ss(0).ButUDw-1 , Ss(0).ButUDd-1  ,1,Co(1).Color2
BoxC 1 , 1 , Ss(0).ButUDw-2 , Ss(0).ButUDd-2  ,1,Co(1).Color3
BoxC 2 , 2 , Ss(0).ButUDw-3 , Ss(0).ButUDd-3  ,1,Co(1).Color4
 GetImage Ss(0).imgUD , 0,0 , Ss(0).ButUDw    ,  Ss(0).ButUDd
`----
Cls RGB(0,0,0)
BoxC 2 , 2 , Ss(0).ButLRw   , Ss(0).ButLRd   ,1,Co(1).Color1
BoxC 0 , 0 , Ss(0).ButLRw-1 , Ss(0).ButLRd-1 ,1,Co(1).Color2
BoxC 1 , 1 , Ss(0).ButLRw-2 , Ss(0).ButLRd-2 ,1,Co(1).Color3
BoxC 2 , 2 , Ss(0).ButLRw-3 , Ss(0).ButLRd-3 ,1,Co(1).Color4
 GetImage Ss(0).imgLR , 0,0 , Ss(0).ButLRw   ,  Ss(0).ButLRd
EndFunction
`-----------------------

Login required to view complete source code

[XpMe_v1.2]

Code to load and use slider bars  if saved  from the above post.
Uses the mouse. With on screen returned values.

PlayBASIC Code: [Select]

 `---------------- SLIDERS LOADER ----------------
Dim Info$(5)
    Info$(0) = "  Mouse is outside of Button area "
    Info$(1) = "  Mouse is  INSIDE of Button area "
    Info$(2) = "  Mouse is  INSIDE of Button area "
    Info$(3) = " with mouse pressed"
    Info$(4) = "Press ENTER key TO QUIT"
    Info$(5) = "Mouse Pressed  Value = "
                           `  >> Note...  If the direction is to be left to right then...
                           `  >> The source code for   .x  is setup only for either 120 or 220 <<
                           `  >> Note...  If the direction is to be up   to down  then...
                           `  >> The source code for   .y  is setup only for either 120 or 220 <<
                           `  >> The source code for .Max  is setup only for either Max = 100 or Max = 200
                           `     to match the length of either .x or .y
Type Sliders
   Cnt As Integer  ` number of Slider Buttons
  Tilt As Integer  ` position of the Sliders     0 = up-down or  1 = left-right
     x As Integer  ` left Slider pos
     y As Integer  ` top  Slider pos
     w As Integer  ` width  of Slider
     d As Integer  ` height of Slider
   Max As Integer  ` Max Slider read
 press As Integer  ` used for mouse info   0 = outside slider bar   1 = inside hover   2 = inside mouse pressed down
 value As Integer  ` Slider returned value(if .MAX=200 then its just right to set MUSIC volume without converting)
imgBar As Integer  ` Slider bar image numbers 0 -  2
 imgUD As Integer  ` center button image Up Down
 imgLR As Integer  ` center button image Left Right
Fpath  As String   ` Start Up File Path
EndType
Dim Ss(6) As Sliders
    Ss(0).Cnt = 6
n = 0 : Ss(n).Fpath = CurrentDir$()
        Ss(n).imgUD = 1
        Ss(n).imgLR = 2
For n = 1 To Ss(0).Cnt
Ss(n).Tilt  = ReadData() : Ss(n).x     = ReadData() : Ss(n).y      = ReadData()
Ss(n).w     = ReadData() : Ss(n).d     = ReadData() : Ss(n).Max    = ReadData()
Ss(n).press = ReadData() : Ss(n).value = ReadData() : Ss(n).imgBar = ReadData()
Next
Data 0 , 10  , 250 , 18  , 220 , 200 , 0 , 100 , 10
Data 0 , 50  , 250 , 18  , 220 , 200 , 0 , 100 , 20
Data 1 , 100 , 250 , 220 ,  18 , 200 , 0 , 100 , 30
Data 1 , 100 , 310 , 220 ,  18 , 200 , 0 , 100 , 40
Data 0 , 430 , 270 ,  18 , 120 , 100 , 0 ,  50 , 50
Data 1 , 500 , 380 , 120 ,  18 , 100 , 0 ,  50 , 60
`----------------
OpenScreen 800,600,32,1 : CenterScreen : TitleScreen "Slider Bars"
Ink RGB(255,255,255)    : CenterText 400 ,290, "....LOADING SLIDER BARS...."
Sync
`----------------  Load The Sliders ----------------
For t = 1 To Ss(0).Cnt : For e = 0 To 2
Fi$ = Ss(0).Fpath + "Slider_" + Str$(t) + "_Image" + Str$(e) + ".sly"
If FileExist(Fi$) Then LoadData(Fi$ ,Ss(t).imgBar + e)
Next e : Next t
Fi$ = Ss(0).Fpath + "Slider_1_Button.sly" : If FileExist(Fi$) Then LoadData(Fi$ ,Ss(0).imgUD)
Fi$ = Ss(0).Fpath + "Slider_2_Button.sly" : If FileExist(Fi$) Then LoadData(Fi$ ,Ss(0).imgLR)
Cls RGB(0,0,0) 
`---------------- THE MAIN LOOP ----------------
Ink RGB(0,0,99) ` text info color
Repeat
bt = MouseButton() : If bt = 2 Then Exit
mx = MouseX()
my = MouseY()
 For Nm = 1 To Ss(0).Cnt : XYcheckSlider(bt,mx,my, Nm) : Next Nm
Cls RGB(190,170,140)
ShowSliderInfo()
ShowTheSliders()
Sync
Until EnterKey()
End
`----------------
Function ShowTheSliders()
For n = 1 To Ss(0).Cnt : DrawImage Ss(n).imgbar + Ss(n).press , Ss(n).x , Ss(n).y ,1
If Ss(n).Tilt = 0
x = Ss(n).x + 3
m = Ss(n).Max - Ss(n).value
y = Ss(n).y + m + 6    : DrawImage Ss(0).imgUD , x , y ,1
EndIf
If Ss(n).Tilt = 1
x = Ss(n).x + Ss(n).value + 6
y = Ss(n).y + 3        : DrawImage Ss(0).imgLR , x , y ,1
EndIf
Next n
EndFunction
`----------------
Function ShowSliderInfo()
y = 10 :         Text 14 ,-2, "fps = " + Str$( FPS() )
                 Text 217,-2, Info$(4)
For n = 1 To Ss(0).Cnt
For e = 0 To 2 : If Ss(n).press = e Then Mhover$ = Info$(e) + Str$(n)
                 If Ss(n).press = 2 Then Mhover$ = Mhover$ + Info$(3)
Next e         : Text 9 , y    , Info$(5) + Str$( Ss(n).press ) + Mhover$
vv = Ss(n).value
If Ss(n).MAX = 200 Then vv = vv / 2
                 Text 9 , y + 12 , "Mouse Slider " + Str$(n) + " Value = " + Str$( vv )
y=y+28
Next n
EndFunction
`----------------
Function XYcheckSlider(Bmouse,Bx,By,Num)
If Ss(Num).Tilt = 0
                                       Ss(Num).press = 0                        ` outside
If Bx > Ss(Num).x And Bx < Ss(Num).x + Ss(Num).w
If By > Ss(Num).y And By < Ss(Num).y + Ss(Num).d
                                       Ss(Num).press = 1                        ` hover
      If Bmouse > 0
                                       v = By - Ss(Num).y
                                       v = Ss(Num).Max - v + 10
                                    If v < 0 Then v = 0
                                    If v > Ss(Num).Max Then v = Ss(Num).Max
                                       Ss(Num).value = v
                                       Ss(Num).press = 2                        ` down
      EndIf
EndIf
EndIf
EndIf
`---
If Ss(Num).Tilt = 1
                                       Ss(Num).press = 0                        ` outside
If Bx > Ss(Num).x And Bx < Ss(Num).x + Ss(Num).w
If By > Ss(Num).y And By < Ss(Num).y + Ss(Num).d
                                       Ss(Num).press = 1                        ` hover
      If Bmouse > 0
                                       v = Bx - Ss(Num).x - 10
                                    If v < 0 Then v = 0
                                    If v > Ss(Num).Max Then v = Ss(Num).Max
                                       Ss(Num).value = v
                                       Ss(Num).press = 2                        ` down
      EndIf
EndIf
EndIf
EndIf
EndFunction
`----------------
Function LoadData(BmpFileName$,ImageNumber)
                                               idx = GetFreeFile()
                        ReadFile BmpFileName$ ,idx
                                a$=ReadString$(idx) : wi = Val(a$)
                                a$=ReadString$(idx) : hi = Val(a$)
For y=1 To hi : For x=1 To wi : a$=ReadString$(idx) : cc = Val(a$) :  DotC x,y, cc  : Next : Next : CloseFile idx
GetImage ImageNumber ,1,1, wi+1,hi+1
EndFunction
`----------------------- end of code

[tomazmb]

Hello,

I remember this source code from DB forum. It's very nice, one thing:

PlayBASIC Code: [Select]

`-----------------------
Function BarBoxes(Num, n ,c)
Cls RGB(0,0,0) : x = Ss(Num).x
y = Ss(Num).y
w = Ss(Num).x + Ss(Num).w
d = Ss(Num).y + Ss(Num).d
p = Ss(Num).Deep
BoxC x+1 , y+1 , w + p , d + p ,1,Co©.Color1 ` shadow depth
BoxC x-1 , y-1 , w + 1 , d + 1 ,1,Co©.Color2 ` outer edge
BoxC x , y , w , d ,1,Co©.Color3 ` inner edge
BoxC x+1 , y+1 , w - 1 , d - 1 ,1,Co©.Color4 ` inside
If Ss(Num).Tilt = 0
r = Ss(Num).w / 2
m = x+r-1 : dn = y + 10
BoxC m-1, dn-1 , m+3 , dn + Ss(Num).Max ,1,Co©.Color6
BoxC m , dn , m+2 , dn + Ss(Num).Max ,1,Co©.Color5
For e = dn To dn + Ss(Num).Max Step 5 : BoxC m-3 , e-1 , m+5 , e+1 ,1, Co©.Color6
LineC m-2 , e , m+4 , e ,Co©.Color5
Next
EndIf
If Ss(Num).Tilt = 1
u = Ss(Num).d / 2
m = y+u-1 : wi = x + 10
BoxC wi-1, m-1 , wi + Ss(Num).Max , m+3 ,1,Co©.Color6
BoxC wi , m , wi + Ss(Num).Max , m+2 ,1,Co©.Color5
For e = wi To wi + Ss(Num).Max Step 5 : BoxC e-1 , m-3 , e+1 , m+5 ,1,Co©.Color6
LineC e , m-2 , e , m+4 ,Co©.Color5
Next
EndIf : GetImage Ss(Num).imgbar + n , x-1 , y-1 , w + p , d + p
EndFunction
`-----------------------

I had to replace all characters © with "("c")". It gave me errors on syntax errors...not recognizing the © character. It's not your fault, the forum automatically convert "("c")" into © without quotation marks.  Now it work. Good job. Thank you. For comparison. Your program in DB Pro gave me >1150 FPS in fullscreen mode, in PB I have > 500 FPS in windowed mode.

But I still don't get the save part. What should I unrem ? Which result should I see (now I don't see slidebars) ? I know there are there, because when I roll over them, I get the mesage from Info$(n). In DB Pro version I see it, but the position of the slidebars is always neutral - the default one. Is this the way it should be ?

Have a nice day,

Tomaz

[XpMe_v1.2]

It is         Co©.Color1       not the © character inside        Co(     ).Color1
thats how the code was done.

in PB I get  +- 350 FPS   in the windowed mode. I prefer Play Basic over DBpro.
I have yet to try any full screen mode in Play Basic

The slider bars can have their on screen positions(X,Y) changed in the code to wherever you wish to put them. You can change the code to add more or less also.

In the function...     Function DoTheMAINloop()
you will find near the end of the function
Until EnterKey()
           SaveAll()      ` un - Rem  this line to save your new slider buttons when you exit
End

This  SaveAll()  command should be have a rem mark  like this  ` SaveAll()
I must of left it out on just before posting it.  

If it has ` in front of  SaveAll()   then it will not save any slider shapes
Remove the ` to save the shapes
The rem statement is to prevent saving the shapes unless you remove it.

Remove it in order to use it in the second source code provided.

The first source code creates shapes  to be saved for use in the second source code. Thats how I intended it. I know both looks almost the same.

And when it saves the files
-----
Until EnterKey()
           SaveAll()      ` un - Rem  this line to save your new slider buttons when you exit
End
-----
the program >> ends <<.

I have looked at and ran both source codes and haven't seen any dissapearing slider bars. I'll run it more and if I see it happen then i'll fix it and re post it.
The SYNC command may be required somewhere if it does show up.

The bars stays where they are when first visible (You can always move them in code).
The little buttons inside the slider bars move when the mouse is pressed on to the little buttons and you drag it. Colors change when you hover ar press down on them.
Results are returned as text.

The above may answer your questions.

[XpMe_v1.2]

I went back to the above 1st post and edited it to now include.....
REM SaveAll() ` un - Rem this line to save your new slider buttons when you exit

Now it does have a REM statment


remove it to save your images as (example) "Slider_1_Button.sly"
data files to be reloaded in the second source code.

[tomazmb]

Hello XpMe v1.2,

Problem solved. I'm feeling stupid. I didn't have both source codes in same place (folder), but in different folder... :o
Now works the same as in DB Pro example (I also prefer PB over DB Pro).
Thanks for helping me.  :)

Have a nice day,

Tomaz

[XpMe_v1.2]

My fault for not saying to make sure you have the saved data files in the same directory as the 2nd source code.
Thanks for using it.