VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cSimpleSlider"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Event ValueChanged(ByVal NewValue As Double)

Private Radius As Double
Private mX As Double, mY As Double, mWidth As Double, mHeight As Double
Private VStartX As Double, VCurX As Double, VWidth As Double
Private mMin As Double, mMax As Double
Public Caption As String

Private WithEvents CenterDrag As cControlPoint
Attribute CenterDrag.VB_VarHelpID = -1

Public Sub Init(ControlPoints As cControlPoints, ByVal X As Double, ByVal Y As Double, ByVal Width As Double, ByVal Height As Double, _
                Optional ByVal Min As Double, Optional ByVal Max As Double = 100, Optional ByVal Value As Double)
  mX = X: mY = Y: mWidth = Width: mHeight = Height 'buffer the outer-Rect dimensions
  
  Radius = Height / 3.9 'calculate the BallRadius, based on the given height
  
  VStartX = X + Width * 0.25: VWidth = Width * 0.69  'finally some "slider-area-related" precalculations
  
  'the ControlPoint-Add, which is used here as the interaction-point on the SliderBall (including MouseOver-Highlighting)
  Set CenterDrag = ControlPoints.Add("CenterDrag" & ObjPtr(Me), VStartX, Y + Height / 2, &H8888, Radius)
  
  mMin = Min
  mMax = Max
  Me.Value = Value
End Sub

Public Property Get Min() As Double
  Min = mMin
End Property
Public Property Let Min(ByVal NewValue As Double)
  If mMin = NewValue Then Exit Property
  mMin = NewValue
  Value = Value
End Property

Public Property Get Max() As Double
  Max = mMax
End Property
Public Property Let Max(ByVal NewValue As Double)
  If mMax = NewValue Then Exit Property
  mMax = NewValue
  Value = Value
End Property

Public Property Get Value() As Double
  Value = mMin + (VCurX - VStartX) / VWidth * (mMax - mMin)
End Property
Public Property Let Value(ByVal NewValue As Double)
Dim NewX As Double
  NewX = VStartX + (NewValue - mMin) * VWidth / (mMax - mMin)
  If VCurX = NewX Then Exit Property

  If NewX < VStartX Then NewX = VStartX
  If NewX > VStartX + VWidth Then NewX = VStartX + VWidth
  
  VCurX = NewX
  CenterDrag.X = NewX
  RaiseEvent ValueChanged(Value)
End Property

Public Sub Draw(CC As cCairoContext)
  CC.Save
    DrawControlBody CC
    DrawTextCaption CC
    DrawSliderBall CC
  CC.Restore
End Sub

Private Sub DrawControlBody(CC As cCairoContext)
Dim Pat As cCairoPattern
  CC.Save 'draw the "body-face" of the Sliders area
    CC.TranslateDrawings 0.5, 0.5 'this ensures, that our smaller LineWidths (below 2) become "Pixel-Aligned"
    
    'the outer rounded-rectangle
    CC.RoundedRect mX, mY, mWidth, mHeight, mHeight / 3.3, True
      Set Pat = Cairo.CreateLinearPattern(0, mY, _
                                          0, mY + mHeight)
      Pat.AddGaussianStops_ThreeColors &HF0F0F0, &HF8F8F8, &HDBDBDB, 1, 1, 1, 0.2
    CC.Fill True, Pat
      CC.SetLineWidth 0.9 'here we have such a smaller LineWidth, which is now drawn "within" a Pixel-Coord
      CC.SetSourceColor &H808090, 0.75
    CC.Stroke

    'the slider-area
    CC.RoundedRect VStartX - Radius, mY + (mHeight - 2 * Radius) / 2, VWidth + 2 * Radius, 2 * Radius, Radius * 1.2
      Set Pat = Cairo.CreateLinearPattern(0, mY + (mHeight - 2 * Radius) / 2, _
                                          0, mY + (mHeight - 2 * Radius) / 2 + 2 * Radius)
      Pat.AddGaussianStops_ThreeColors &HDBDBDB, &HF8F8F8, &HF0F0F0, 1, 1, 1, 0.9
    CC.Fill , Pat
    
    'the used-value-area within the slider-area
    CC.RoundedRect VStartX - Radius, mY + (mHeight - 2 * Radius) / 2, VCurX - VStartX + 2 * Radius, 2 * Radius, Radius * 1.2
      CC.SetSourceColor &H55BBBB, 0.15
    CC.Fill
  CC.Restore
End Sub

Private Sub DrawTextCaption(CC As cCairoContext, Optional ByVal WithDropShadow As Boolean = True)
  CC.Save
    CC.SelectFont "Tahoma", 8.5, &H485858
    CC.TranslateDrawings mX + Int(mHeight * 0.5) + 1, mY + Int((mHeight - CC.GetFontHeight) * 0.5) + 1
      If WithDropShadow Then
        CC.Save
          CC.TranslateDrawings 1, 1
          
          CC.SetLineCap CAIRO_LINE_CAP_ROUND
          CC.SetLineJoin CAIRO_LINE_JOIN_ROUND
          
          CC.TextOut 0, 0, Caption, , 0.04, True
            CC.SetLineWidth 3
          CC.Stroke
          CC.TextOut 0, 0, Caption, , 0.09, True
          CC.Fill
        CC.Restore
      End If
    CC.TextOut 0, 0, Caption, , 0.99  'this is the final "on-top-Textout" which takes place in either case
  CC.Restore
End Sub

Private Sub DrawSliderBall(CC As cCairoContext)
Dim Pat As cCairoPattern

  'the "glowing ball" code does basically the same things as the Turorials "Gradient-Demo" (in the cShapeEllipse-Class)
  CC.TranslateDrawings CenterDrag.X, CenterDrag.Y 'all of the below drawings will now work relative to the Center-Point of the ball
  CC.RotateDrawingsDeg -30 'adjust the "light-angle"
  
  'first the "glowing-main-corpus"
  CC.Save 'we wrap this code-block in an additional Save/Restore, since we want to use additional transforms
    CC.RotateDrawingsDeg 33 'here we de-rotate, since the  glowing-effect should be more or less vertically
    CC.Arc 0, 0, Radius
      Set Pat = Cairo.CreateRadialPattern(0, -Radius * 0.16, Radius * 1.66, _
                                          0, Radius * 0.61, 0)
      Pat.AddGaussianStops_TwoColors RGB(99, 0, 0), RGB(255, 220, 140), 1, 1
    CC.Fill , Pat
  CC.Restore
  
  'now the shine
  CC.Save 'we wrap this code-block in an additional Save/Restore, since we want to use additional transforms
    CC.TranslateDrawings 0, -Radius * 0.5 'as said, now we center the whole thing half a radius-distance upwards first

    CC.ScaleDrawings 0.8, 0.55 'and as in 1.) we apply an extra-shrinking of the ellipse in y-direction, but other than in 1.) we use scales below 1, since we want to draw it smaller than the main-ellipse
    
    CC.Arc 0, 0, Radius '<-now as always, the same Path-Definition-Call is possible, due to our "extra-transformations" above
      Set Pat = Cairo.CreateRadialPattern(0, 0, Radius, 0, -Radius * 0.25, 0) 'the center of the shine is slightly shifted upwards (over the 5th paramter)
      Pat.AddGaussianStops_TwoColors RGB(200, 255, 255), vbWhite, 0, 0.95
    CC.Fill , Pat
  CC.Restore
End Sub

Private Sub CenterDrag_PositionChanging(NewX As Double, NewY As Double)
  NewY = CenterDrag.Y
  If NewX < VStartX Then NewX = VStartX
  If NewX > VStartX + VWidth Then NewX = VStartX + VWidth
  
  VCurX = NewX

  RaiseEvent ValueChanged(Value)
End Sub





