GFSlider/GFSlidercls.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = ‑1 'True
  Persistable = 0 'NotPersistable
  DataBindingBehavior = 0 'vbNone
  DataSourceBehavior  = 0 'vbNone
  MTSTransactionMode  = 0 'NotAnMTSObject
END
Attribute VB_Name = "GFSlidercls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2002 by Louis.
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDOWN = &H201
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDOWN = &H204
Const WM_MOUSEMOVE = &H200
'SliderColorStruct ‑ color information for the GFSlider
Private Type SliderColorStruct
    ShadowLightColor As Long
    ShadowDarkColor As Long
    LightLightColor As Long
    LightDarkColor As Long
    ForeColor As Long
    BackColor As Long
End Type
'GFSliderStruct ‑ general information, properties
Private Type GFSliderStruct
    SliderPictureBox As PictureBox
    SliderColors As SliderColorStruct
    VOrHFlag As Boolean
    ValueChangeSmall As Single
    ValueChangeLarget As Single
    ValueSteps As Integer 'visible steps
    ValueMin As Single
    ValueMax As Single
    ValueStep As Single 'one step
End Type
Dim GFSliderStructVar As GFSliderStruct

Public Sub Initialize(ByRef GFSliderPictureBox As PictureBox)
    'on error resume next
    'preset
    GFSliderStructVar.SliderColors.ForeColor = &H80000012 'control text
    GFSliderStructVar.SliderColors.BackColor = &H8000000F 'control color
    GFSliderStructVar.SliderColors.ShadowLightColor = &H80000016 'light control shadow
    GFSliderStructVar.SliderColors.ShadowDarkColor = &H80000015 'dark control shadow
    GFSliderStructVar.SliderColors.LightLightColor = &H80000010 'control shadow
    GFSliderStructVar.SliderColors.LightDarkColor = &H80000012 'control text
    GFSliderStructVar.VOrHFlag = False
    GFSliderStructVar.ValueMin = 1!
    GFSliderStructVar.ValueMax = 10!
    GFSliderStructVar.ValueSteps = 10
    GFSliderStructVar.ValueStep = 1!
    'begin
    Set GFSliderStructVar.SliderPictureBox = GFSliderPictureBox
    Call GFSubClass( _
        GFSliderStructVar.SliderPictureBox, _
        GFSliderStructVar.SliderPictureBox.Name, _
        Me, True)
End Sub

Public Property Let VOrH(ByVal VOrHFlag As Boolean)
    'on error resume next
    If Not (GFSliderStructVar.VOrHFlag = VOrHFlag) Then
        GFSliderStructVar.VOrHFlag = VOrHFlag
        Call Redraw
    End If
End Property

Public Property Set VOrH() As Boolean
    'on error resume next
    VOrH = GFSliderStructVar.VOrHFlag
End Property

Public Property Let ValueSteps(ByVal Steps As Integer)
    'on error resume next
    If Not (GFSliderStructVar.ValueSteps = Steps) Then
        GFSliderStructVar.ValueSteps = Steps
        Call Redraw
    End If
End Property

Public Property Set ValueSteps() As Integer
    'on error resume next
    ValueSteps = GFSliderStructVar.ValueSteps
End Property

Public Property Let ValueMin(ByVal Value As Single)
    'on error resume next
    If Not (GFSliderStructVar.ValueMin = Value) Then
        GFSliderStructVar.ValueMin = Value
        Call Redraw
    End If
End Property

Public Property Set ValueMin() As Single
    'on error resume next
    ValueMin = GFSliderStructVar.ValueMin
End Property

Public Property Let ValueMax(ByVal Value As Single)
    'on error resume next
    If Not (GFSliderStructVar.ValueMax = Value) Then
        GFSliderStructVar.ValueMax = Value
        Call Redraw
    End If
End Property

Public Property Set ValueMax() As Single
    'on error resume next
    ValueMax = GFSliderStructVar.ValueMax
End Property

Public Property Let ValueStep(ByVal Step As Single)
    'on error resume next
    If Not (GFSliderStructVar.ValueStep = Step) Then
        GFSliderStructVar.ValueStep = Step
        Call Redraw
    End If
End Property

Public Property Set ValueStep() As Single
    'on error resume next
    ValueStep = GFSliderStructVar.ValueStep
End Property

Public Sub Refresh()
    'on error resume next
    Call Redraw
End Sub

Public Sub Redraw()
    'on error resume next
    If Not (GFSliderStructVar.SliderPictureBox Is Nothing) Then 'verify

    End If
End Sub

Public Sub GFSubClassWindowProc(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
    'on error resume next
    If Len(SourceDescription) = Len(GFSliderStructVar.SliderPictureBox.Name) Then 'check first to increase speed
        If SourceDescription = GFSliderStructVar.SliderPictureBox.Name Then
            Select Case Msg
            Case WM_LBUTTONDOWN
            Case WM_MOUSEMOVE
            Case WM_LBUTTONUP
            End Select
        End If
    End If
End Sub

Private Sub Class_Terminate()
    'on error resume next
    Call GFSubClass_UnSubclass( _
        GFSliderStructVar.SliderPictureBox.Name, _
        Me)
End Sub


[END OF FILE]