核心自定义滚动条类

• 下载源文件 - 6.99 Kb
• 下载演示项目 - 25.3 Kb

引言

这是一个完全由 GDI+ 绘制的自定义滚动条控件类。它的所有绘图方法都可以被重写，允许开发人员按自己的选择绘制它。

教程

好吧，让我先说明一下我为什么编写这个类。我写这个类是因为我曾经读到过一篇文章，说你可以在 .NET 中**自定义绘制** Windows 滚动条。根据那篇文章，我尝试捕获用于**自定义绘制**的 wndproc() 消息。但很快我就发现，在多次修改代码后，Windows 在不同的方法中绘制滚动条，导致由于闪烁而无法**自定义绘制**。我非常生气，因为我花了很多时间试图让它工作。所以，我决定从头开始。我从零开始制作了我自己的自定义控件。

虽然非常耗时，但我从下面的链接中了解了许多关于 Windows 滚动条类及其工作原理的知识。

• ScrollBar 类 - MSDN
• 关于滚动条 - MSDN

滚动条似乎是微软不喜欢分享其源代码的东西之一。上面的文章提供了关于如何使用滚动条的基本知识信息。它们缺乏关于滚动条如何计算的深入信息。它们不仅忘记解释如何计算它们，而且没有提及如何从滑块、轨道、按钮等获取大小和位置信息。这些信息不是公开信息，因为微软不希望你乱搞它。

在下面的教程中，我将解释所有你想知道的关于滚动条以及更多内容。除此之外，你还将学习如何制作一个带有事件映射的完全自定义绘制控件。

第 1 部分 - 绘制你的虚拟控件

我们直接开始吧。要制作一个自定义控件，你需要从继承 System.Windows.Forms.UserControl 类开始。这个类包含了你控件的所有基本属性。它有点像为所有新手准备的基本入门模板控件。:) 我一开始就先做一些有趣的事情来构建我的控件，那就是**图形设计**！

设计自定义控件有两种方法。一种方法是使用其他预构建的微软控件来制作**复合**控件。这是一种非常有效且快速完成任务的方法。虽然创建速度很快，但加载时间可能很慢，并且会消耗大量资源。除此之外，考虑到你正在使用其他控件，引擎中可能有很多问题。你还无法修复预构建控件中的错误，并且受限于它们的设计和功能。

第二种方法是**自定义绘制**设计。这种设计类型需要永远，呵呵。尽管如此，好处是显而易见的。要在 .NET 中进行自定义绘制，你必须导入 System.Drawing 类。这些类为你提供了在控件内部进行完全绘制的能力。自定义绘制在 .NET 中被称为 **GDI+**。你可以绘制所有东西，从圆形、矩形、字体、线条等等。

对于我的滚动条类，我决定选择第二种设计方式，即绘制所有内容。我的第一个方法 Draw() 首先定义了我希望所有内容所在的大小和位置。请记住，所有的绘制都不是真正的控件。你必须跟踪它们的所有信息，例如**高度**、**宽度**、**顶部**、**左侧**和**名称**。要做到这一点，最好的方法是创建一个类来存储所有信息并将其制作成一个数组。下面是制作这种类型类的简单方法。

Public Class ControlInfo

#Region "Private Variables"

Private P_X As Integer
Private P_Y As Integer
Private P_H As Integer
Private P_W As Integer
Private P_Name As String
Private P_X2 As Integer
Private P_Y2 As Integer

#End Region

Public Property X() As Integer
 Get
  Return P_X
 End Get
 Set(ByVal Value As Integer)
  P_X = Value
 End Set
End Property

Public Property Y() As Integer
 Get
  Return P_Y
 End Get
 Set(ByVal Value As Integer)
  P_Y = Value
 End Set
End Property

Public Property H() As Integer
 Get
  Return P_H
 End Get
 Set(ByVal Value As Integer)
  P_H = Value
 End Set
End Property

Public Property W() As Integer
 Get
  Return P_W
 End Get
 Set(ByVal Value As Integer)
  P_W = Value
 End Set
End Property

Public Property Name() As String
 Get
  Return P_Name
 End Get
 Set(ByVal Value As String)
  P_Name = Value
 End Set
End Property

Public Property X2() As Integer
 Get
  Return P_X2
 End Get
 Set(ByVal Value As Integer)
  P_X2 = Value
 End Set
End Property

Public Property Y2() As Integer
 Get
  Return P_Y2
 End Get
 Set(ByVal Value As Integer)
  P_Y2 = Value
 End Set
End Property

Public Sub New()

 P_X = 0
 P_Y = 0
 P_H = 0
 P_W = 0
 P_Name = ""
 P_X2 = 0
 P_Y2 = 0

End Sub
End Class

这个类存储了所有关于虚拟控件的信息。在我们的主滚动条类中声明一个它的数组非常简单。

Private Info(0) As ControlInfo

如你所见，它被声明为大小为零。这是因为我的 Draw() 方法使用适当的大小和值来定义它。现在让我们进入实际的绘制方法。

Private Sub Draw()

 'Set value to nothing-----
 Me.Value = 0
 '-------------------------

 'Redim Control list-------
 ReDim Info(5)
 Info(0) = New ControlInfo
 Info(1) = New ControlInfo
 Info(2) = New ControlInfo
 Info(3) = New ControlInfo
 Info(4) = New ControlInfo
 Info(5) = New ControlInfo
 PageUp = New Timer
 PageDown = New Timer
 '-------------------------


 'Declare Variables--------
 Dim x, y, h, w As Integer
 PageUp.Enabled = False
 PageUp.Interval = 500
 PageDown.Enabled = False
 PageDown.Interval = 500
 '-------------------------

 'Main Control--------------------------
 x = 0 : y = 0 : h = 0 : w = 0
 Info(0).X = x : Info(0).Y = y : Info(0).H = h : _
  Info(0).W = w : Info(0).X2 = (x + w) : _ 
  Info(0).Y2 = (y + h) : Info(0).Name = "ALL"
 '--------------------------------------

 'Thumb Control-------------------------
 Dim Thumbht As Integer = Get_Thumb_Height()
 x = 0 : y = 17 : h = Thumbht : w = Me.Width
 Info(1).X = x : Info(1).Y = y : Info(1).H = h :  _
  Info(1).W = w : Info(1).X2 = (x + w) : _ 
  Info(1).Y2 = (y + h) : Info(1).Name = "Thumb"
 Draw_Thumb(x, y, w, h, ControlEvents.None)
 '--------------------------------------

 'Shaft Control Above-------------------
 x = 0 : y = 17 : h = 0 : w = Me.Width
 Info(2).X = x : Info(2).Y = y : Info(2).H = h : _
  Info(2).W = w : Info(2).X2 = (x + w) : _
  Info(2).Y2 = (y + h) : Info(2).Name = "Shaft Above"
 Draw_Shaft_Above(x, y, w, h, ControlEvents.None)
 '--------------------------------------

 'Shaft Control Below-------------------
 If Thumbht > 0 Then Thumbht += 1
  x = 0 : y = 17 + Thumbht :  _
   h = Me.Height - 34 - Thumbht : w = Me.Width
 Info(3).X = x : Info(3).Y = y : Info(3).H = h : _ 
  Info(3).W = w : Info(3).X2 = (x + w) : _ 
  Info(3).Y2 = (y + h) : Info(3).Name = "Shaft Below"
 Draw_Shaft_Below(x, y, w, h, ControlEvents.None)
 '--------------------------------------

 'Draw Arrow Down---------------------
 x = 0 : y = Me.Height - 17 : h = 16 : w = Me.Width
 Info(4).X = x : Info(4).Y = y : Info(4).H = h : _ 
  Info(4).W = w : Info(4).X2 = (x + w) : _ 
  Info(4).Y2 = (y + h) : Info(4).Name = "Arrow Down"
 Draw_Arrow_Down(x, y, w, h, ControlEvents.None)
 '------------------------------------

 'Draw Arrow Up-----------------------
 x = 0 : y = 0 : h = 16 : w = Me.Width
 Info(5).X = x : Info(5).Y = y : Info(5).H = h : _ 
  Info(5).W = w : Info(5).X2 = (x + w) :  _
  Info(5).Y2 = (y + h) : Info(5).Name = "Arrow Up"
 Draw_Arrow_Up(x, y, w, h, ControlEvents.None)
 '------------------------------------

End Sub

上面的方法非常简单。我们首先重新声明数组大小。然后我们开始制作我们的虚拟控件。

1. 主用户控件
2. 滑块控件
3. 滑块上方的轨道控件
4. 滑块下方的轨道控件
5. 向上滚动箭头按钮
6. 向下滚动箭头按钮

然后我们设置所有虚拟属性，将它们存储在我们的 controlinfo 类中。最后但并非最不重要的是，每个虚拟控件都有自己的绘图方法。所有这些绘图方法都是**可重写的**，方便**自定义绘制**。它们也不会让你摸不着头脑，因为它们会传递给你几个参数。这些参数包括**位置**、**大小**和**事件类型**。让我们看看其中一个绘图方法是什么样子的。这个绘图方法是 Draw_Arrow_Up()。它绘制向上滚动箭头按钮。

Public Overridable Sub Draw_Arrow_Up(ByVal X As Integer, _
  ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, _
  ByVal EventOf As ControlEvents)

 'Get Control Graphics-----------------
 Dim g As Graphics = Me.CreateGraphics
 g.SmoothingMode = SmoothingMode.None
 '-------------------------------------

 Select Case EventOf

  Case ControlEvents.None

   'Draw Rectangle to start--------------------------------------------
   g.FillRectangle(New SolidBrush(Color.White), _
     New Rectangle(X, Y, W, H))
   g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
   '-------------------------------------------------------------------

   'Draw Border--------------------------------------------------------
   g.DrawLine(New Pen(Color.LightBlue), 3, 2 + Y, W - 4, 2 + Y)
   g.DrawLine(New Pen(Color.LightBlue), 2, Y + 3, 2, H + Y - 3)
   g.DrawLine(New Pen(Color.LightBlue), 3, Y + H - 2, W - 4, Y + H - 2)
   g.DrawLine(New Pen(Color.LightBlue), W - 3, Y + 3, W - 3, H + Y - 3)
   '-------------------------------------------------------------------

   'Draw Arrow---------------------------------------------------------
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
     (W \ 2) + 1, (H \ 2) - 2)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
     (W \ 2) + 2, (H \ 2) - 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
     (W \ 2) - 1, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
     (W \ 2) + 3, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
     (W \ 2) + 4, (H \ 2) + 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
     (W \ 2) - 2, (H \ 2) + 1)
   '-------------------------------------------------------------------

   'Reset Settings-----------------------
   Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
     Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : _
     Info(5).Name = "Arrow Up"
   '-------------------------------------

  Case ControlEvents.OnMouseDown

   'Draw Rectangle to start--------------------------------------------
   g.FillRectangle(New SolidBrush(Color.LightBlue), _
     New Rectangle(X, Y, W, H))
   g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
   '-------------------------------------------------------------------

   'Draw Border--------------------------------------------------------
   g.DrawLine(New Pen(Color.Blue), 3, 2 + Y, W - 4, 2 + Y)
   g.DrawLine(New Pen(Color.Blue), 2, Y + 3, 2, H + Y - 3)
   g.DrawLine(New Pen(Color.Blue), 3, Y + H - 2, W - 4, Y + H - 2)
   g.DrawLine(New Pen(Color.Blue), W - 3, Y + 3, W - 3, H + Y - 3)
   '-------------------------------------------------------------------

   'Draw Arrow---------------------------------------------------------
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
     (W \ 2) + 1, (H \ 2) - 2)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
     (W \ 2) + 2, (H \ 2) - 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
     (W \ 2) - 1, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
     (W \ 2) + 3, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
     (W \ 2) + 4, (H \ 2) + 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
     (W \ 2) - 2, (H \ 2) + 1)
   '-------------------------------------------------------------------

   'Reset Settings-----------------------
   Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
     Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : _
     Info(5).Name = "Arrow Up"
   '-------------------------------------

  Case ControlEvents.OnMouseMove

   'Draw Rectangle to start--------------------------------------------
   g.FillRectangle(New SolidBrush(Color.White), _
     New Rectangle(X, Y, W, H))
   g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
   '-------------------------------------------------------------------

   'Draw Border--------------------------------------------------------
   g.DrawLine(New Pen(Color.Blue), 3, 2 + Y, W - 4, 2 + Y)
   g.DrawLine(New Pen(Color.Blue), 2, Y + 3, 2, H + Y - 3)
   g.DrawLine(New Pen(Color.Blue), 3, Y + H - 2, W - 4, Y + H - 2)
   g.DrawLine(New Pen(Color.Blue), W - 3, Y + 3, W - 3, H + Y - 3)
   '-------------------------------------------------------------------

   'Draw Arrow---------------------------------------------------------
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
     (W \ 2) + 1, (H \ 2) - 2)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
     (W \ 2) + 2, (H \ 2) - 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
     (W \ 2) - 1, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
     (W \ 2) + 3, (H \ 2))
   g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
     (W \ 2) + 4, (H \ 2) + 1)
   g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
     (W \ 2) - 2, (H \ 2) + 1)
   '-------------------------------------------------------------------

   'Reset Settings-----------------------
   Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
     Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : Info(5).Name = "Arrow Up"
   '-------------------------------------

 End Select

End Sub

对于所有不熟悉 GDI+ 绘图的人，我首先创建一个变量来保存我将要绘制的图形。我将其 smoothingmode 设置为 none 以获得清晰的外观。在该枚举中有许多其他模式可供选择，例如 highquality，它会尝试混合你的图形。接下来，我使用 Case 语句来判断发生了哪个事件，以便我可以将图形绘制到该事件上。我使用一些基本的 **GDI+** 绘图方法，例如 FillRectangle（绘制实心矩形）、DrawRectangle（绘制矩形轮廓）和 DrawLine（从一个点到另一个点绘制线条）。然后我再次在我的 controlinfo 类中设置所有虚拟属性。你可能会问为什么两次？ 好吧，这就是我们如何从不止一个地方多次使用此方法的原因。其余的虚拟控件绘图方法都非常相似。如果你想制作看起来很花哨的滚动条，或者像 XP 风格、或者你选择的任何风格，它们都很容易重写，这取决于你。

第 2 部分 - 为你的虚拟控件制作虚拟事件

如何制作虚拟事件？好吧，首先，继承的 usercontrol 类允许你重写它的主要事件。这将为你提供一个起点。知道发生了什么事件是成功的一半，困难的部分是弄清楚事件相对于你的虚拟控件的位置发生在何处。由于你已将虚拟控件属性存储在你的 controlinfo 类中，因此确定事件是否发生在你的虚拟控件上很容易。下面是两种方法向你展示如何完成此操作

Private Function CursorPOS() As Integer

 'Get Cursor Location-----------------
 Dim CursorLocation As Point = Me.PointToClient(Cursor.Position)
 '------------------------------------

 'Check to make sure control has something------------------
 If UBound(Info) = 0 Then Return 0 : Exit Function
 '----------------------------------------------------------

 Dim i As Integer = 0
 For i = 0 To UBound(Info)
  'Check to see if cursor is over area-------------------
  If CursorLocation.X >= Info(i).X And CursorLocation.X < _
    Info(i).X2 And CursorLocation.Y >= Info(i).Y And _
    CursorLocation.Y <= Info(i).Y2 Then
      Return i
    Exit Function
  End If
  '------------------------------------------------------
 Next

 'Return Nothing------
 Return 0
 '--------------------

End Function

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

 'Check if thumb moving----------------------------
 If ThumbMoving = True Then ThumbMover() : Exit Sub
 '-------------------------------------------------

 'If Mouse Down = True Then exit this method-------
 If MouseDownNow = True Then Exit Sub
 '-------------------------------------------------

 'Locate which control cursor is located above---
 Dim CheckValue As Integer = CursorPOS()
 '-----------------------------------------------

 'Check to see if mouse is already over location dont redraw--------
 If CheckValue = CurrentMouseMove Then
  Exit Sub
 Else

  Select Case CurrentMouseMove

   Case 1 : Draw_Thumb(Info(1).X, Info(1).Y, Info(1).W, Info(1).H, _
                                   ControlEvents.None)
   Case 4 : Draw_Arrow_Down(Info(4).X, Info(4).Y, Info(4).W, _
                        Info(4).H, ControlEvents.None)
   Case 5 : Draw_Arrow_Up(Info(5).X, Info(5).Y, Info(5).W, _
                        Info(5).H, ControlEvents.None)

  End Select

  'Set Current Mouse Move---------
  CurrentMouseMove = CheckValue
  '-------------------------------

  Select Case CheckValue

   Case 1 : Draw_Thumb(Info(CheckValue).X, Info(CheckValue).Y, _
    Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)
   Case 4 : Draw_Arrow_Down(Info(CheckValue).X, Info(CheckValue).Y, _
    Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)
   Case 5 : Draw_Arrow_Up(Info(CheckValue).X, Info(CheckValue).Y, _
    Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)

  End Select

 End If
 '------------------------------------------------------------------

End Sub

第一个方法 CursorPOS() 检查事件发生在哪个虚拟控件上。然后它返回其数组 ID。有了这个 ID，你就可以绘制新的控件并设置其新属性。第二个方法 OnMouseMove() 完成这个任务。它会找出鼠标是否移动到虚拟控件上，然后调用其绘图方法重新绘制它，这对于鼠标悬停效果来说可能是一个不错的亮点，如下所示

在这个例子中，滑块因鼠标悬停而被高亮显示。

第 3 部分 - 调整虚拟滚动条控件的大小

这一部分是微软不愿透露秘密的部分。它们是用于计算滑块大小和滚动范围的方法。计算滑块大小非常简单。

Private Function Get_Thumb_Height() As Integer

 If Me.Maximum = 0 Or LargeChange = 0 Then Return 0 : Exit Function
 'Make thumb height based on number of records--------
 Dim ThumbHt As Integer = (Me.Height - 35) / (Me.Maximum / Me.LargeChange)
 '----------------------------------------------------


 'Get the thumb bar height-------------
 Select Case ThumbHt
  Case Is < 10
   Return 10
  Case Else
   Return ThumbHt
 End Select
 '-------------------------------------

End Function

首先，我们检查以确保用户在**设计模式**中设置了属性。然后我们计算滑块的高度。公式如下

• ThumbHeight = ShaftHeight / (Maximum / LargeChange)

你说容易吗？是的，看起来足够简单。然后我们需要检查滑块有多大。如果滑块高度小于 10，我们就无法点击它，所以我们确保它最小高度为 10。如果它大于 10，我们就按原样返回它。

下面是控件调整大小的示例

如你所见，根据最大属性值，滑块高度会改变。下一个计算是滑块在轴上上下滑动。**哈哈，要是“Beavis and Butthead 在这里”就好了。**该方法是 ThumbMover()。

Private Sub ThumbMover()

 'Get Cursor Location-----------------
 Dim e As Point = Me.PointToClient(Cursor.Position)
 '------------------------------------

 'Get Position relative to where mouse was---------
 Dim NewPOS As Integer = e.Y + Info(1).Y - MeterY
 '-------------------------------------------------

 If NewPOS <= 18 Then
  If Info(1).Y <> 17 Then
   Draw_Thumb(0, 17, Me.Width, Info(1).H, ControlEvents.OnMouseDown)
   Draw_Shaft_Above(0, 0, Me.Width, 0, ControlEvents.None)
   Draw_Shaft_Below(0, Info(1).H + 18, Me.Width, Me.Height - 18 - _
     17 - Info(1).H, ControlEvents.None)
   Me.Value = Me.Minimum
   RaiseEvent Scroll()
  End If
  Exit Sub
 End If

 If NewPOS >= Me.Height - Info(1).H - 19 Then
  If Info(1).Y <> Me.Height - Info(1).H - 18 Then
    Draw_Thumb(Info(1).X, Me.Height - Info(1).H - 18, Info(1).W, _
      Info(1).H, ControlEvents.OnMouseDown)
    Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
      ControlEvents.None)
    Draw_Shaft_Below(0, 0, Me.Width, 0, ControlEvents.None)
    Me.Value = Me.Maximum
    RaiseEvent Scroll()
  End If
  Exit Sub
 End If

 'Drawing moving Thumb-----------------------------------
 Draw_Thumb(Info(1).X, NewPOS, Info(1).W, Info(1).H, _
   ControlEvents.OnMouseDown)
 Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
   ControlEvents.None)
 Draw_Shaft_Below(0, NewPOS + Info(1).H + 1, Me.Width, _
   Me.Height - 18 - NewPOS - Info(1).H, ControlEvents.None)
 MeterY = e.Y
 '-------------------------------------------------------

 'Make New Value-----------------------------------------
 Dim ScrollingArea As Integer = Me.Height - 34 - Info(1).H
 Me.Value = (Me.Maximum / ScrollingArea) * ((Info(1).Y - 17) - 1)
 '-------------------------------------------------------

 'Scroll-------------
 RaiseEvent Scroll()
 '-------------------

End Sub

好吧，让我为你分解一下。首先，我们获取光标位置。然后我们用这个方程计算新位置

• NewPosition = CurrentCursorPosition + ThumbTop - OldCursorPosition

这将给我们一个可移动滑块的新位置。然后我们检查以确保滑块在轴内。如果超出范围，我们会进行修正。如果它在范围内，那么我们开始移动过程。好的，现在深入了解 Windows 滚动条的秘密。为了防止滚动条闪烁，我们不在滑块下方绘制。轴分为两部分。上轴和下轴。我们从上轴绘制到滑块顶部，然后从滑块底部绘制到下轴。这会将绘图闪烁减少到几乎没有。下一个方程计算新的控件值。

方程是

• Value = (Maximum / FullShaftSize) * ThumbTop

看起来很简单！然后，最后但并非最不重要的是，我们触发一个滚动事件。

第 4 部分 - 基于箭头按钮事件滚动滑块

好的，我们从本节开始描述微软如何使其箭头按钮工作。它如何点击一次并将滑块向下移动一个位置，但如果你继续按住箭头按钮，它会加速滑块移动。为了创建这种效果，我使用了一个计时器控件。当然，在一个没有时间的世界里你怎么生活呢？

Private Sub Move_ThumbDown()

 Dim NewPos As Integer
 If Me.Value < Me.Maximum Then
  If Me.Value + Me.SmallChange > Me.Maximum Then
    Me.Value = Me.Maximum
  Else
   Me.Value += Me.SmallChange
  End If

  If Me.Value = Me.Maximum Then
   NewPos = Info(4).Y - Info(1).H - 1

   Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
         ControlEvents.None)
   Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
         ControlEvents.None)
   Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
     (Me.Height - 18) - (Info(1).Y + Info(1).H), ControlEvents.None)
   '--------------------------------------------------

  Else

   NewPos = ((Me.Value) / (Me.Maximum)) * _
     (Info(4).Y - Info(1).H - 17) + 17

   Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
     ControlEvents.None)
   Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
     ControlEvents.None)
   Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
     (Me.Height - 18) - (Info(1).Y + Info(1).H), _
   ControlEvents.None)
   '--------------------------------------------------

  End If

  'Scroll-------------
  RaiseEvent Scroll()
  '-------------------

 End If

End Sub

Private Sub PageDown_Tick(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles PageDown.Tick

If ShaftMovingDown = True Then

'Start Moving from Shaft-------
Move_ShaftDown()
'------------------------------

Else

'Start Moving from Thumb------
Move_ThumbDown()
'-----------------------------

End If

'Increase Timer Speed-------
PageDown.Interval = 50
'---------------------------

End Sub

PageDown 计时器属性（启用）设置为 True。然后它调用 Move_ThumbDown() 方法。这会为滑块创建一次点击移动。然后计时器增加其速度，如果鼠标仍然按下，这将增加滑块移动的速度。

第 5 部分 - 基于轴鼠标按下事件滚动滑块

你刚刚在上一节中了解了如何通过箭头按钮移动滑块。现在，我将教你如何通过单击轴来通过**大改变**移动滑块。以下方法结合了之前的计时器方法来创建此功能

Private Sub Move_ShaftDown()

 Dim NewPos As Integer
 If Me.Value < Me.Maximum Then
  If Me.Value + Me.LargeChange > Me.Maximum Then
   Me.Value = Me.Maximum
  Else
   Me.Value += Me.LargeChange
  End If

  If Me.Value = Me.Maximum Then

   NewPos = Info(4).Y - Info(1).H - 1

   Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
     ControlEvents.OnMouseDown)
   Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
     ControlEvents.None)
   Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
     (Me.Height - 18) - (Info(1).Y + Info(1).H), _
   ControlEvents.OnMouseDown)
   '--------------------------------------------------

  Else

   NewPos = ((Me.Value) / (Me.Maximum)) * _
      (Info(4).Y - Info(1).H - 17) + 17

   Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
      ControlEvents.OnMouseDown)
   Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
      ControlEvents.None)
   Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
      (Me.Height - 18) - (Info(1).Y + Info(1).H), _
   ControlEvents.OnMouseDown)
   '--------------------------------------------------

  End If

  RaiseEvent Scroll()

 End If

End Sub

上面的代码首先检查值是否低于最大值。如果是，则高亮显示轴并移动滑块。它只高亮显示被点击的那一半轴。

以下示例显示了这一点

第 6 部分 - 基于键盘和滚轮事件滚动

下面的方法展示了如何捕获箭头和翻页键盘键，以及鼠标滚轮。为了捕获键盘键，我使用 ProcessDialogKey() 方法。为了捕获鼠标滚轮，我使用 onMouseWheel() 方法。

Protected Overrides Function ProcessDialogKey(ByVal keyData _
  As System.Windows.Forms.Keys) As Boolean


 Try
  Select Case keyData
   Case Keys.Up, Keys.PageUp
     If PageUp.Enabled = False Then
      Draw_Arrow_Up(Info(5).X, Info(5).Y, Info(5).W, Info(5).H, _
             ControlEvents.OnMouseDown)
      Move_ThumbUp()
      PageUp.Enabled = True
     End If
   Case Keys.Down, Keys.PageDown
    If PageDown.Enabled = False Then
      Draw_Arrow_Down(Info(4).X, Info(4).Y, Info(4).W, Info(4).H, _
        ControlEvents.OnMouseDown)
      Move_ThumbDown()
      PageDown.Enabled = True
    End If
  End Select
  Return True
 Catch ex As Exception
  Return False
 End Try

End Function

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

 If e.Delta > 0 Then
  Move_ThumbUp()
 Else
  Move_ThumbDown()
 End If

End Sub

结论

好了，我的滚动条教程到此结束。希望大家喜欢它的长度。;) 如果有人在理解这篇文章方面需要任何帮助，请不要忘记留言。

还有一件事，我正在制作滚动条的方向。所以，目前你只能垂直滚动。抱歉！我还在制作 XP 风格、3D 风格、扁平风格和未来风格的自定义绘图预设。

“德文开发者！” VectorX。

许可证

只要保留标题，即可自由使用和修改。如果对本程序集进行任何修改，用户必须将更改通过电子邮件发送给作者的电子邮件地址。

使用、复制、分发和修改的条款和条件

本代码由版权所有者和贡献者“按原样”提供，不作任何明示或暗示的保证，包括但不限于适销性和特定用途适用性的暗示保证。在任何情况下，版权所有者贡献者均不对任何直接、间接、偶然、特殊、惩戒性或后果性损害（包括但不限于采购替代商品或服务；使用、数据或利润损失；或业务中断）承担责任，无论其原因如何，也无论基于任何责任理论，无论是合同、严格责任或侵权（包括疏忽或其他），即使已被告知可能发生此类损害。