Click here to Skip to main content
Click here to Skip to main content
Articles » Languages » VB.NET » General » Downloads
 
Add your own
alternative version
Go to top

Cool Scrollbar - Scrollbar like Windows Media Player's

, 3 May 2005
A cool scrollbar control.
coolscrollbar.zip
bin
cbar.dll
HorizontalScrollBarLeftArrow.bmp
HorizontalScrollBarRightArrow.bmp
cbar.vbproj.user
Icon1.ico
testcbar.zip
testCBar.vbproj.user
testCBar.exe
osprogress.dll
cbar.dll
��'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

'/////PLEASE KEEP THIS AREA INTACT ****PLEASE KEEP THIS AREA INTACT****PLEASE KEEP THIS AREA INTACT**************** //

'/// ************************************************************************************************************** //

'/// Author:  Liu,Qi                                                                                                //

'/// Contact: reallqswbran@msn.com (NO SPAM, PLEASE)                                                                //

'///          P.O Box 439, Wuhan University, Wuhan 430072, Hubei, P.R.CHINA                                         //

'/// ************************************************************************************************************** //

'/// Control Class: CBar                                                                                            //

'/// Control Description:                                                                                           //

'///                    Scrollbar like Windows Media Player's, which has:                                           //

'///                    �l	Optional color displayed on thumb, in channel, and on control border                    //

'///                    �l	Hand cursor is displayed when mouse hovers over thumb                                   //  

'///                    �l	Thumb color is changed to "hover color" when mouse hovers over thumb                    //

'///                    �l	Clicking in channel moves thumb to that spot                                            //

'///                    �l	Left and right arrow buttons move thumb by one unit, and if kept pushed,                //

'///                        the thumb would keep moving                                                             //

'///                    �l	ValueChanged event is raised when value changes                                         //

'/// Control Events:                                                                                                //

'///                    ValueChanged: raised when scrollbar value changes                                           //

'/// Control Properties:                                                                                            //

'///                    [Behavior]                                                                                  //

'///                    Value: the current value of the scrollbar (long)                                            //

'///                    MinValue: minimum value of the scrollbar (long)                                             //

'///                    MaxValue: maximum value of the scrollbar (long)                                             //

'///                    [Appearance]                                                                                //

'///                    LeftArrow: left arrow image (bitmap)                                                        //

'///                    RightArrow: right arrow image (bitmap)                                                      //

'///                    LeftChannelBeginColor: begin color of the left channel brush (color)                        //

'///                    LeftChannelEndColor: end color of the left channel brush (color)                            //

'///                    RightChannelBeginColor: begin color of the right channel brush (color)                      //

'///                    RightChannelEndColor: end color of the right channel brush (color)                          //

'///                    ThumbFillColor: center color of the thumb area (color)                                      //

'///                    ThumbRectColor: surrounding color of the thumb area (color)                                 //

'///                    TrackBorderColor: color of the border of the track (color)                                  //

'/// _______________________________________________________________________________________________________________//

'/// History:

'///                    Oct 12, 2004: Initial release

'///                    Apr 25, 2005: Adds Vertical version and modifies thumb drawing

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////





Imports System.ComponentModel

Imports System.Drawing



Public Class [CBar]

    Inherits System.Windows.Forms.UserControl



#Region " Windows z�OS����Vhubv�N�x "



    Public Sub New()

        MyBase.New()



        '��u(f/ Windows z�OS����Vhb@_ŗv�0

        InitializeComponent()

        Me.SetStyle(ControlStyles.DoubleBuffer, True)

        Me.SetStyle(ControlStyles.Opaque, True)

        Me.SetStyle(ControlStyles.ResizeRedraw, True)



        'W( InitializeComponent() �u(NKTm�R�N�OURY�S



    End Sub



    'CBar ��Q� dispose N�nt~�N�R�h0

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

        If disposing Then

            If Not (components Is Nothing) Then

                components.Dispose()

            End If

        End If

        MyBase.Dispose(disposing)

    End Sub



    'Windows z�OS����Vhb@_ŗv�

    Private components As System.ComponentModel.IContainer



    'l�a: N�N��zf/ Windows z�OS����Vhb@_ŗv�

    'S�N�Ou( Windows z�OS����VhO�e9kd��z0

    'N
��Ou(N�x��VhO�e9[�0

    Friend WithEvents Timer1 As System.Timers.Timer

    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(CBar))

        Me.Timer1 = New System.Timers.Timer

        CType(Me.Timer1, System.ComponentModel.ISupportInitialize).BeginInit()

        '

        'Timer1

        '

        Me.Timer1.Interval = 70

        Me.Timer1.SynchronizingObject = Me

        '

        'CBar

        '

        Me.AccessibleDescription = resources.GetString("$this.AccessibleDescription")

        Me.AccessibleName = resources.GetString("$this.AccessibleName")

        Me.AutoScroll = CType(resources.GetObject("$this.AutoScroll"), Boolean)

        Me.AutoScrollMargin = CType(resources.GetObject("$this.AutoScrollMargin"), System.Drawing.Size)

        Me.AutoScrollMinSize = CType(resources.GetObject("$this.AutoScrollMinSize"), System.Drawing.Size)

        Me.BackgroundImage = CType(resources.GetObject("$this.BackgroundImage"), System.Drawing.Image)

        Me.Cursor = System.Windows.Forms.Cursors.Hand

        Me.Enabled = CType(resources.GetObject("$this.Enabled"), Boolean)

        Me.Font = CType(resources.GetObject("$this.Font"), System.Drawing.Font)

        Me.ImeMode = CType(resources.GetObject("$this.ImeMode"), System.Windows.Forms.ImeMode)

        Me.Location = CType(resources.GetObject("$this.Location"), System.Drawing.Point)

        Me.Name = "CBar"

        Me.RightToLeft = CType(resources.GetObject("$this.RightToLeft"), System.Windows.Forms.RightToLeft)

        Me.Size = CType(resources.GetObject("$this.Size"), System.Drawing.Size)

        CType(Me.Timer1, System.ComponentModel.ISupportInitialize).EndInit()



    End Sub



#End Region



#Region "Types"

    Private Structure ColorARGB

        Dim bAlpha As Byte

        Dim bRed As Byte

        Dim bGreen As Byte

        Dim bBlue As Byte

    End Structure



    Public Enum BarLayout

        Horizontal

        Vertical

    End Enum

#End Region



#Region "Member Variables"



    Private BitmapHeight As Byte = 12   'height of the arrow bitmap

    Private BitmapWidth As Byte = 25   'width of the arrow bitmap

    'Private ArcDia as Byte=BitmapWidth



    Private m_nMaxValue As Long = 100

    Private m_nMinValue As Long = 0

    Private m_nRealValue As Long = 0   'value of the scrollbar that will return

    Private m_nValue As Long = m_nRealValue - m_nMinValue 'Absolute value of current value



    Private m_nLargeChange As Long = (m_nMaxValue - m_nMinValue) / 10   'large change value



    '''<color properties>

    Private m_cBorderColor As Color = Color.White 'Border color

    Private m_cRightChannelBeginColor As Color = Color.Honeydew 'right track begin color

    Private m_cRightChannelEndColor As Color = Color.Gray 'right track end color

    Private m_cLeftChannelBeginColor As Color = Color.Green

    Private m_cLeftChannelEndColor As Color = Color.White



    Private m_cThumbFillColor As Color = Color.Blue

    Private m_cThumbRectColor As Color = Color.LightYellow

    '''</end color properties>



    Private m_imgLeftImage As Bitmap

    Private m_imgRightImage As Bitmap



    Private m_fThumbLeft As Single = 26.0F   'left value of Thumbleft

    Private m_bMouseOnThumb As Boolean = False

    Private m_bMouseDown As Boolean = False

    Private m_bArrowClicked As Boolean      'which button is clicked: Left-True; Right-False



    Private m_BarLayout As BarLayout = BarLayout.Horizontal 'layout, horizontal or vertical



    Private m_sBitmapSize As Size = New Size(BitmapWidth, BitmapHeight)

#End Region



#Region "Private Functions"

    '''<api functions>

    Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

    '''<\end api functions>



    'get color argb value

    Private Function GetARGB(ByVal inColor As Color) As ColorARGB

        Dim nARGB As Int32 = inColor.ToArgb

        Dim tmpColorARGB As ColorARGB



        With tmpColorARGB

            .bBlue = nARGB And &HF

            .bGreen = (nARGB >> 2) And &HF

            .bRed = (nARGB >> 2) And &HF

            .bAlpha = (nARGB >> 2) And &HF

        End With



        Return tmpColorARGB

    End Function



    Private Function CalValue() As Single

        If m_BarLayout = BarLayout.Horizontal Then

            Return BitmapWidth + 1 + (Me.Width - BitmapWidth * 3 - 2) * m_nValue / (m_nMaxValue - m_nMinValue)

        ElseIf m_BarLayout = BarLayout.Vertical Then

            Return Me.Height - (2 * BitmapHeight + 2 + (Me.Height - BitmapHeight * 3 + 2) * m_nValue / (m_nMaxValue - m_nMinValue))

            'Return (BitmapHeight + 1 + (Me.Height - BitmapHeight * 3 - 2) * m_nValue / (m_nMaxValue - m_nMinValue))

        Else

            Return 0

        End If

    End Function



    '''<draw background of the track>

    Private Function DrawTrackBackground() As Boolean



        Try

            Dim gTrack As Graphics = Me.CreateGraphics

            '            If (m_BarLayout = BarLayout.Vertical) Then

            '           gTrack.RotateTransform(270, Drawing2D.MatrixOrder.Append)

            '          End If

            '           If m_imgLeftImage Is Nothing And m_imgRightImage Is Nothing Then

            Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(CBar))



            If m_BarLayout = BarLayout.Horizontal Then

                m_imgLeftImage = CType(resources.GetObject("LeftArrow"), System.Drawing.Bitmap)

                m_imgRightImage = CType(resources.GetObject("RightArrow"), System.Drawing.Bitmap)

            Else

                m_imgLeftImage = CType(resources.GetObject("DownArrow"), System.Drawing.Bitmap)

                m_imgRightImage = CType(resources.GetObject("UpArrow"), System.Drawing.Bitmap)

            End If

            '          End If



            'draw track background

            gTrack.DrawRectangle(New Pen(m_cBorderColor), 0, 0, Me.Width - 1, Me.Height - 1)



            'draw image to each end of the track

            If m_BarLayout = BarLayout.Horizontal Then

                gTrack.DrawImage(m_imgLeftImage, 1, 1)

                gTrack.DrawImage(m_imgRightImage, Me.Width - BitmapWidth - 1, 1)

            ElseIf m_BarLayout = BarLayout.Vertical Then

                gTrack.DrawImage(m_imgLeftImage, 1, Me.Height - BitmapHeight - 1)

                gTrack.DrawImage(m_imgRightImage, 1, 1)

            End If



            'free memory

            gTrack.Dispose()



            Return True

        Catch e As Exception

            Debug.WriteLine(e.Message)

            Return False

        End Try



    End Function



    '''<draw left channel and right channel>

    Private Function DrawTrackChannels() As Boolean



        Dim rightBrush As New Drawing2D.LinearGradientBrush(ClientRectangle, m_cRightChannelBeginColor, m_cRightChannelEndColor, Drawing2D.LinearGradientMode.Vertical)

        Dim leftBrush As New Drawing2D.LinearGradientBrush(ClientRectangle, m_cLeftChannelBeginColor, m_cLeftChannelEndColor, Drawing2D.LinearGradientMode.BackwardDiagonal)

        If (m_BarLayout = BarLayout.Vertical) Then

            rightBrush = New Drawing2D.LinearGradientBrush(ClientRectangle, m_cRightChannelBeginColor, m_cRightChannelEndColor, Drawing2D.LinearGradientMode.Horizontal)

            leftBrush = New Drawing2D.LinearGradientBrush(ClientRectangle, m_cLeftChannelBeginColor, m_cLeftChannelEndColor, Drawing2D.LinearGradientMode.ForwardDiagonal)

        End If

        Dim gTrack As Graphics = Me.CreateGraphics

        Dim LeftChannel As RectangleF, RightChannel As RectangleF

        If (m_BarLayout = BarLayout.Horizontal) Then

            LeftChannel = New RectangleF(BitmapWidth + 1, 2, 0, BitmapHeight - 2)

        Else

            LeftChannel = New RectangleF(2, Me.Height - BitmapHeight - 1, BitmapWidth - 2, 0)

        End If

        Dim fTmpRightChannelWidth As Single



        If (m_BarLayout = BarLayout.Horizontal) Then

            LeftChannel.Width = CalValue() - BitmapWidth + BitmapHeight / 2 ' 20

            If LeftChannel.Width <= 0 Then LeftChannel.Width = BitmapHeight / 2

            fTmpRightChannelWidth = Me.Width - BitmapWidth * 2 - 2

            RightChannel = New RectangleF(BitmapWidth + 1, 1, fTmpRightChannelWidth, BitmapHeight)

        Else

            LeftChannel.Height = Me.Height - (CalValue() + 2 * BitmapHeight)

            If LeftChannel.Height <= 0 Then LeftChannel.Height = BitmapWidth / 2

            LeftChannel.Y = CalValue() + BitmapHeight

            fTmpRightChannelWidth = Me.Height - BitmapHeight * 2 - 2

            RightChannel = New RectangleF(1, BitmapHeight + 1, BitmapWidth, fTmpRightChannelWidth)

        End If



        gTrack.FillRectangle(rightBrush, RightChannel)

        gTrack.FillRectangle(leftBrush, LeftChannel)

        gTrack.DrawRectangle(New Pen(Color.Gray), LeftChannel.X, LeftChannel.Y, _

                                               LeftChannel.Width, LeftChannel.Height - 1)





        gTrack.Dispose()

        rightBrush.Dispose()

        leftBrush.Dispose()



    End Function



    '''<draw thumb>

    Private Function DrawThumb(Optional ByVal MouseOn As Boolean = False) As Single

        Dim gThumb As Graphics = Me.CreateGraphics

        Dim linePen As New Pen(Color.Gray, 1)  'pen to draw the edge of the area

        Dim fX(3) As Single



        'initialize edge values------------------------------------------------------------

        fX(0) = CalValue()

        If (m_BarLayout = BarLayout.Horizontal) Then

            fX(1) = fX(0) + BitmapHeight / 2

            fX(2) = fX(1) + (BitmapWidth - BitmapHeight) / 2 '7

        Else

            fX(1) = fX(0) + BitmapWidth / 2

            fX(2) = fX(1) + (BitmapHeight - BitmapWidth) / 2 '7

        End If

        '''------------------------------------------------------------------------



        'define path and brushes

        Dim rectPath As New Drawing2D.GraphicsPath 'path that will constitute the thumb area

        If (m_BarLayout = BarLayout.Horizontal) Then

            'Dim rect2Fill As New RectangleF(fX(1), 1.0F, BitmapWidth - BitmapHeight, BitmapHeight)  'center rectangle area of the thumb

            Dim rect2Fill As New RectangleF(fX(1), 1.0F, fX(2) - fX(0), BitmapHeight)  'center rectangle area of the thumb

            rectPath.AddArc(fX(0), 0.3F, BitmapHeight, BitmapHeight, 90, 180) 'left pie

            rectPath.AddRectangle(rect2Fill) 'center

            rectPath.AddArc(fX(2), 0.3F, BitmapHeight, BitmapHeight, 90, -180) 'right pie

        Else

            Dim rect2Fill As New RectangleF(1.0F, fX(2), BitmapWidth, 2 * fX(1) - fX(0) - fX(2))

            rectPath.AddArc(0.3F, 2 * fX(1) - fX(0), BitmapWidth, BitmapWidth, 0, 180) 'upper pie

            rectPath.AddRectangle(rect2Fill) 'center

            rectPath.AddArc(0.3F, fX(2) - fX(1) + fX(0), BitmapWidth, BitmapWidth, -180, 180) 'down pie

        End If

        Dim rectBrush As New Drawing2D.PathGradientBrush(rectPath)

        rectBrush.CenterColor = m_cThumbRectColor

        Dim rectColors As Color() = {m_cThumbFillColor, m_cThumbFillColor, m_cThumbFillColor, m_cThumbFillColor}

        rectBrush.SurroundColors = rectColors



        'draw the thumb

        If (m_BarLayout = BarLayout.Horizontal) Then

            gThumb.DrawArc(linePen, fX(0), 1.0F, BitmapHeight, BitmapHeight - 1, 90, 180)

            gThumb.DrawArc(linePen, fX(2), 1.0F, BitmapHeight, BitmapHeight - 1, -90, 180)

        Else

            gThumb.DrawArc(linePen, 1.0F, 2 * fX(1) - fX(0), BitmapWidth, BitmapWidth - 1, 0, 180)

            gThumb.DrawArc(linePen, 1.0F, fX(2) - fX(1) + fX(0), BitmapWidth, BitmapWidth - 1, 0, -180)

        End If

        gThumb.FillPath(rectBrush, rectPath)



        If MouseOn = True Then

            Dim fillColorARGB As ColorARGB = GetARGB(m_cThumbFillColor)

            Dim tmpfillColor As Color = Color.FromArgb(200, 255 - fillColorARGB.bRed, 255 - fillColorARGB.bGreen, 255 - fillColorARGB.bBlue)

            linePen.Color = tmpfillColor



            If (m_BarLayout = BarLayout.Horizontal) Then

                gThumb.DrawArc(linePen, fX(0), 1.0F, BitmapHeight, BitmapHeight - 1, 90, 180)

                gThumb.DrawArc(linePen, fX(2), 1.0F, BitmapHeight, BitmapHeight - 1, -90, 180)

                gThumb.DrawLine(linePen, fX(1), 1.0F, fX(1) + BitmapWidth - BitmapHeight, 1.0F)

                gThumb.DrawLine(linePen, fX(1), BitmapHeight, fX(1) + BitmapWidth - BitmapHeight, BitmapHeight)

            Else

                gThumb.DrawArc(linePen, 1.0F, 2 * fX(1) - fX(0), BitmapWidth, BitmapWidth - 1, 0, 180)

                gThumb.DrawArc(linePen, 1.0F, fX(2) - fX(1) + fX(0), BitmapWidth, BitmapWidth - 1, 0, -180)

                gThumb.DrawLine(linePen, 1.0F, fX(1), 1.0F, 2 * fX(1) - fX(0) - fX(2))

                gThumb.DrawLine(linePen, BitmapWidth, fX(1), BitmapWidth, 2 * fX(1) - fX(0) - fX(2))

            End If

        End If



        'free memory

        linePen.Dispose()

        rectPath.Dispose()

        rectBrush.Dispose()

        gThumb.Dispose()



        Return fX(0)



    End Function



    'sub to draw track

    Private Sub DrawTrack(Optional ByVal IsMouaseOnThumb As Boolean = False)

        DrawTrackBackground()

        DrawTrackChannels()

        m_fThumbLeft = DrawThumb(IsMouaseOnThumb)



    End Sub

#End Region



#Region "Events"

    Public Event ValueChanged()

#End Region



#Region "Properties"

    <CategoryAttribute("Appearance"), DescriptionAttribute("layout of the scrollbar")> _

    Public Property [ScrollbarLayout]() As BarLayout

        Get

            Return m_BarLayout

        End Get

        Set(ByVal newValue As BarLayout)

            m_BarLayout = newValue

            If m_BarLayout = BarLayout.Vertical Then

                BitmapHeight = 25

                BitmapWidth = 12

            ElseIf m_BarLayout = BarLayout.Horizontal Then

                BitmapHeight = 12

                BitmapWidth = 25

            End If

            Dim resizeevent As EventArgs

            Me.OnResize(resizeevent)

        End Set

    End Property





    <CategoryAttribute("Appearance"), DescriptionAttribute("left arrow image")> _

    Public Property [LeftArrow]() As Bitmap

        Get

            Return m_imgLeftImage

        End Get

        Set(ByVal newValue As Bitmap)

            m_imgLeftImage = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("right arrow image")> _

    Public Property [RightArrow]() As Bitmap

        Get

            Return m_imgRightImage

        End Get

        Set(ByVal newValue As Bitmap)

            m_imgRightImage = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Track Border Color")> _

    Public Property [TrackBorderColor]() As Color

        Get

            Return m_cBorderColor

        End Get

        Set(ByVal newValue As Color)

            m_cBorderColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Right Channel Begin Color")> _

    Public Property [RightChannelBeginColor]() As Color

        Get

            Return m_cRightChannelBeginColor

        End Get

        Set(ByVal newValue As Color)

            m_cRightChannelBeginColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Right Channel End Color")> _

    Public Property [RightChannelEndColor]() As Color

        Get

            Return m_cRightChannelEndColor

        End Get

        Set(ByVal newValue As Color)

            m_cRightChannelEndColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Left Channel End Color")> _

    Public Property [LeftChannelEndColor]() As Color

        Get

            Return m_cLeftChannelEndColor

        End Get

        Set(ByVal newValue As Color)

            m_cLeftChannelEndColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("left Channel begin Color")> _

    Public Property [LeftChannelBeginColor]() As Color

        Get

            Return m_cLeftChannelBeginColor

        End Get

        Set(ByVal newValue As Color)

            m_cLeftChannelBeginColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Thumb fill Color")> _

    Public Property [ThumbFillColor]() As Color

        Get

            Return m_cThumbFillColor

        End Get

        Set(ByVal newValue As Color)

            m_cThumbFillColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Appearance"), DescriptionAttribute("Thumb rect Color")> _

    Public Property [ThumbRectColor]() As Color

        Get

            Return m_cThumbRectColor

        End Get

        Set(ByVal newValue As Color)

            m_cThumbRectColor = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Behavior"), DescriptionAttribute("current value")> _

    Public Property [Value]() As Long

        Get

            Return m_nRealValue

        End Get

        Set(ByVal newValue As Long)

            'ensure that the value does not exceed the limits

            If newValue <= m_nMinValue Then

                m_nRealValue = m_nMinValue

                m_nValue = m_nRealValue - m_nMinValue

            ElseIf newValue >= m_nMaxValue Then

                m_nRealValue = m_nMaxValue

                m_nValue = m_nRealValue - m_nMinValue

            Else

                m_nRealValue = newValue

                m_nValue = m_nRealValue - m_nMinValue

            End If

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Behavior"), DescriptionAttribute("Max Value")> _

    Public Property [MaxValue]() As Long

        Get

            Return m_nMaxValue

        End Get

        Set(ByVal newValue As Long)

            m_nMaxValue = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Behavior"), DescriptionAttribute("Min Value")> _

    Public Property [MinValue]() As Long

        Get

            Return m_nMinValue

        End Get

        Set(ByVal newValue As Long)

            m_nMinValue = newValue

            DrawTrack()

        End Set

    End Property



    <CategoryAttribute("Behavior"), DescriptionAttribute("Large Change")> _

    Public Property [LargeChange]() As Long

        Get

            Return m_nLargeChange

        End Get

        Set(ByVal newValue As Long)

            If newValue > (m_nMaxValue - m_nMinValue) Then

                newValue = m_nMaxValue - m_nMinValue

            ElseIf newValue < 1 Then

                newValue = 1

            End If

            m_nLargeChange = newValue

        End Set

    End Property



#End Region



#Region "overrides"

    Protected Overrides Sub OnResize(ByVal e As System.EventArgs)

        'restrict the size

        If m_BarLayout = BarLayout.Horizontal Then

            If Me.Height <> BitmapHeight + 2 Then Me.Height = BitmapHeight + 2

            If Me.Width <= BitmapWidth * 3 + 3 Then Me.Width = BitmapWidth * 3 + 3

        ElseIf m_BarLayout = BarLayout.Vertical Then

            If Me.Height <= BitmapHeight * 3 Then Me.Height = BitmapHeight * 3

            If Me.Width <> BitmapWidth + 2 Then Me.Width = BitmapWidth + 2

        End If

        DrawTrack()

    End Sub



    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)

        DrawTrack()

    End Sub



    Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)

        If (m_BarLayout = BarLayout.Horizontal) Then

            If (e.X > m_fThumbLeft And e.X < m_fThumbLeft + BitmapWidth) Then

                If Not m_bMouseDown Then

                    m_bMouseOnThumb = True

                    m_fThumbLeft = DrawThumb(True)

                Else

                    If (e.X > 1.5 * BitmapWidth And e.X < Me.Width - 1.5 * BitmapWidth) Then 'within effective area of the TRACK CHANNEL

                        m_nValue = Int((e.X - 1.5 * BitmapWidth) * (m_nMaxValue - m_nMinValue) / (Me.Width - 3 * BitmapWidth - 2))

                        DrawTrack(True)

                    End If

                End If

            Else

                If m_bMouseOnThumb Then

                    m_bMouseOnThumb = False

                    m_fThumbLeft = DrawThumb()

                End If

            End If

            If e.X < BitmapWidth Or e.X > Me.Width - BitmapWidth Then

                Me.Cursor = Cursors.Arrow

            Else

                Me.Cursor = Cursors.Hand

            End If

        Else

            If (e.Y > m_fThumbLeft And e.Y < m_fThumbLeft + BitmapHeight) Then

                If Not m_bMouseDown Then

                    m_bMouseOnThumb = True

                    m_fThumbLeft = DrawThumb(True)

                Else

                    If (e.Y > 1.5 * BitmapHeight And e.Y < Me.Height - 1.5 * BitmapHeight) Then 'within effective area of the TRACK CHANNEL

                        m_nValue = Int((e.Y - 1.5 * BitmapHeight) * (m_nMaxValue - m_nMinValue) / (Me.Height - 3 * BitmapHeight - 2))

                        m_nValue = m_nMaxValue - m_nMinValue - m_nValue

                        DrawTrack(True)

                    End If

                End If

            Else

                If m_bMouseOnThumb Then

                    m_bMouseOnThumb = False

                    m_fThumbLeft = DrawThumb()

                End If

            End If

            If e.Y < BitmapHeight Or e.Y > Me.Height - BitmapHeight Then

                Me.Cursor = Cursors.Arrow

            Else

                Me.Cursor = Cursors.Hand

            End If

        End If

    End Sub



    Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)

        m_bMouseOnThumb = False

        m_bMouseDown = False

        DrawTrack()

    End Sub



    Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)



        If (m_BarLayout = BarLayout.Horizontal) Then

            If (e.X > BitmapWidth And e.X < Me.Width - BitmapWidth) Then  'within track

                If m_bMouseOnThumb Then  'on thumb

                    If e.Button = MouseButtons.Left Then

                        m_bMouseDown = True

                    Else

                        m_bMouseDown = False

                    End If

                Else

                    If (e.X > (BitmapWidth * 1.5 + 1) And e.X < (Me.Width - BitmapWidth * 1.5 - 1)) Then 'within effective area

                        m_nValue = CType((e.X - BitmapWidth * 1.5 - 1) * (m_nMaxValue - m_nMinValue) / (Me.Width - BitmapWidth * 3 - 2), Long)

                    ElseIf e.X < (BitmapWidth * 1.5 + 1) Then    'minvalue

                        m_nValue = 0

                    ElseIf e.X > Me.Width - (BitmapWidth * 1.5 + 1) Then 'maxvalue

                        m_nValue = m_nMaxValue - m_nMinValue

                    End If

                    DrawTrack() 'draw track

                End If

            Else    'click the botton

                'Dim nTmpValue As Long = CType((m_nMaxValue - m_nMinValue) / 10, Long)

                If e.X < BitmapWidth + 1 Then

                    m_bArrowClicked = True

                    m_nValue -= m_nLargeChange

                    If m_nValue < 0 Then m_nValue = 0

                ElseIf e.X > Me.Width - BitmapWidth Then

                    m_bArrowClicked = False

                    m_nValue += m_nLargeChange

                    If m_nValue > (m_nMaxValue - m_nMinValue) Then m_nValue = (m_nMaxValue - m_nMinValue)

                End If

                m_nRealValue = m_nValue + m_nMinValue

                DrawTrack()

                Sleep(500)

                Timer1.Enabled = True

            End If

        Else

            If (e.Y > BitmapHeight And e.Y < Me.Height - BitmapHeight) Then  'within track

                If m_bMouseOnThumb Then  'on thumb

                    If e.Button = MouseButtons.Left Then

                        m_bMouseDown = True

                    Else

                        m_bMouseDown = False

                    End If

                Else

                    If (e.Y > (BitmapHeight * 1.5 + 1) And e.Y < (Me.Height - BitmapHeight * 1.5 - 1)) Then 'within effective area

                        m_nValue = CType((Me.Height - (e.Y + BitmapHeight * 1.5 - 1)) * (m_nMaxValue - m_nMinValue) / (Me.Height - BitmapHeight * 3 + 2), Long)

                    ElseIf e.Y < (BitmapHeight * 1.5 + 1) Then    'maxvalue

                        m_nValue = m_nMaxValue - m_nMinValue

                    ElseIf e.Y > Me.Height - (BitmapHeight * 1.5 + 1) Then 'minvalue

                        m_nValue = 0

                    End If

                    DrawTrack() 'draw track

                End If

            Else    'click the botton

                If e.Y < BitmapHeight + 1 Then

                    m_bArrowClicked = False

                    m_nValue += m_nLargeChange

                    If m_nValue > (m_nMaxValue - m_nMinValue) Then m_nValue = (m_nMaxValue - m_nMinValue)

                ElseIf e.Y > Me.Height - BitmapHeight Then

                    m_bArrowClicked = True

                    m_nValue -= m_nLargeChange

                    If m_nValue < 0 Then m_nValue = 0

                End If

                m_nRealValue = m_nValue + m_nMinValue

                DrawTrack()

                Sleep(500)

                Timer1.Enabled = True

            End If

        End If



    End Sub



    Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)



        m_bMouseDown = False

        m_nRealValue = m_nValue + m_nMinValue

        Timer1.Enabled = False

        RaiseEvent ValueChanged()

    End Sub

#End Region



    Private Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed



        Dim nTmpValue As Long = CType(Math.Ceiling(m_nLargeChange / 5), Long)



        If nTmpValue < 1 Then

            nTmpValue = 1

        End If



        If m_bArrowClicked = True Then

            m_nValue -= nTmpValue

            If m_nValue < 0 Then m_nValue = 0

        Else

            m_nValue += nTmpValue

            If m_nValue > (m_nMaxValue - m_nMinValue) Then m_nValue = (m_nMaxValue - m_nMinValue)

        End If



        m_nRealValue = m_nValue + m_nMinValue

        DrawTrack()



    End Sub



    Private Sub CBar_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Disposed

        'free memory

        m_imgLeftImage.Dispose()

        m_imgRightImage.Dispose()

    End Sub

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

superliu
Web Developer
United States United States
Graduated from Wuhan University(EE), China in june 2004, I worked for Fiberhome Telecommunication Technologies, Co., LTD, WRI for one year, and now I am pursuing my graduate studies in Electrical Engineering. Basicly I wrote programs in my spare time.

| Advertise | Privacy | Mobile
Web03 | 2.8.140921.1 | Last Updated 3 May 2005
Article Copyright 2004 by superliu
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid