Public Class VScroll Public Event Change(ByVal sender As Object) #Region "属性" Private _ParentControl As Grid = Nothing Private _ParentSubControl As Grid = Nothing ''' ''' 对应的控件的容器。 ''' ''' Public ReadOnly Property ParentControl As Grid Get Return _ParentControl End Get End Property Private _Control As Object = Nothing ''' ''' 对应的控件。它是需要被滚动的容器,并且被一个Grid包裹。 ''' ''' Public ReadOnly Property Control As Object Get Return _Control End Get End Property ''' ''' 按钮离滚动条顶部的距离。 ''' ''' ''' ''' Public Property ValueMe As Double Get Return btnDrag.Margin.Top End Get Set(ByVal ValueMe As Double) If QuoteValue = 0 Then Exit Property SetTop(btnDrag, MathRange(ValueMe, 0, MaxValueMe - QuoteValueMe)) SetTop(Control, -MathRange( If(QuoteValueMe = 15, (MaxValue - QuoteValue) / (MaxValueMe - QuoteValueMe) * ValueMe, MaxValue / QuoteValue * ValueMe), 0, MaxValue - QuoteValue)) End Set End Property ''' ''' 按钮高度。 ''' ''' ''' ''' Public Property QuoteValueMe As Double Get Return btnDrag.ActualHeight End Get Set(ByVal ValueMe As Double) btnDrag.Height = ValueMe End Set End Property ''' ''' 滚动条高度。 ''' ''' ''' ''' Public ReadOnly Property MaxValueMe As Double Get Return Me.ActualHeight End Get End Property ''' ''' 控件滚动的距离。 ''' ''' ''' ''' Public Property Value As Double Get Return If(IsNothing(Control), 0, -Control.Margin.Top) End Get Set(ByVal ValueMe As Double) Me.ValueMe = If(QuoteValueMe = 15, (MaxValueMe - QuoteValueMe) / (MaxValue - QuoteValue) * ValueMe, MaxValueMe / MaxValue * ValueMe) End Set End Property ''' ''' 控件可以显示的最大高度。等同于容器的高度。 ''' ''' ''' ''' Public ReadOnly Property QuoteValue As Double Get Return If(IsNothing(ParentControl), 0, ParentControl.ActualHeight) End Get End Property ''' ''' 最大值。等同于控件的高度。 ''' ''' ''' ''' Public ReadOnly Property MaxValue As Double Get Return If(IsNothing(Control), 0, Control.ActualHeight) End Get End Property Private _InCenter As Boolean ''' ''' 是否在控件高度不足最高高度时把它居中。 ''' ''' ''' ''' Public ReadOnly Property InCenter As Boolean Get Return _InCenter End Get End Property ''' ''' 在判断滚动条是否显示时的容错范围。 ''' ''' ''' ''' Public Property WrongRange As Double = 2 #End Region #Region "鼠标动画" Private Sub VScroll_MouseEnter(ByVal sender As Object, ByVal e As System.Windows.Input.MouseEventArgs) Handles Me.MouseEnter If Len(Me.Name) < 1 Then Me.Name = "Aniamtioner" & GetUUID() '确保这个控件有名称 AniStart({ AaOpacity(btnDrag, 1 - btnDrag.Opacity, 200), AaOpacity(btnBack, 0.3 - btnBack.Opacity, 200) }, Me.Name & "Mouse") End Sub Private Sub VScroll_MouseLeave(ByVal sender As Object, ByVal e As System.Windows.Input.MouseEventArgs) Handles Me.MouseLeave If IsNothing(DragingScroll) Then DragMouseLeave() End Sub ''' ''' 触发离开动画。 ''' ''' Public Sub DragMouseLeave() AniStart({ AaOpacity(btnDrag, 0.4 - btnDrag.Opacity, 200), AaOpacity(btnBack, 0.01 - btnBack.Opacity, 200) }, Me.Name & "Mouse") End Sub #End Region #Region "鼠标拖动" Private ClickedY As Integer '鼠标指针在按钮上的相对Y坐标 Private ShouldTop As Integer '按钮到顶部的距离 Private Sub btnDrag_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles btnDrag.MouseDown ShouldTop = btnDrag.Margin.Top ClickedY = e.GetPosition(btnDrag).Y DragingScroll = Me End Sub Public Sub Draging(ByVal Y As Integer) ShouldTop = MathRange(Y - ClickedY + ShouldTop, 0, MaxValueMe - QuoteValueMe) '实际应该在的位置 If Not ValueMe = ShouldTop Then ValueMe = ShouldTop End Sub #End Region ''' ''' 设置绑定的控件。这个方法务必只能执行一次。 ''' ''' 需要被拖动的控件。它需要被一个Grid覆盖。 ''' 是否在控件高度不足最高高度时把它居中。 ''' Public Function SetControl(ByVal Control As StackPanel, ByVal InCenter As Boolean) As Boolean '可靠性检查 If IsNothing(Control) Then Return False If IsNothing(Control.Parent) Then Return False If Not Control.Parent.GetType.Name = "Grid" Then Return False If Not IsNothing(ParentControl) Then Return False Try '初始化 _ParentControl = Control.Parent _ParentControl.UpdateLayout() _ParentSubControl = New Grid With {.Width = _ParentControl.ActualWidth + 0.51, .VerticalAlignment = VerticalAlignment.Top} _Control = Control _InCenter = InCenter SetTop(btnDrag, 0) '初始化控件 _ParentControl.SetValue(ContentPresenter.ContentProperty, Nothing) _ParentControl.Children.Clear() _ParentControl.Children.Add(_ParentSubControl) _ParentSubControl.Children.Add(_Control) _Control.VerticalAlignment = VerticalAlignment.Top '添加委托 AddHandler Me.SizeChanged, AddressOf Refresh AddHandler Control.SizeChanged, AddressOf Refresh AddHandler ParentControl.SizeChanged, AddressOf Refresh AddHandler btnDrag.SizeChanged, AddressOf Refresh Catch ex As Exception ExShow(ex, "滚动条绑定失败", ErrorLevel.MsgboxAndFeedback) Return False End Try '刷新滚动条 Refresh(Nothing, Nothing) Return True End Function ''' ''' 刷新QuoteValue与高度等。 ''' ''' ''' Private Function Refresh(ByVal sender, ByVal e) As Boolean Try '可靠性检查 If IsNothing(_Control) Or IsNothing(ParentControl) Then Return False If QuoteValue = 0 Or MaxValue = 0 Or Not MathCheck(QuoteValueMe) Then Return False _ParentSubControl.Width = _ParentControl.ActualWidth + 0.51 Dim OldValueMe = ValueMe Dim OldValue = Value QuoteValueMe = MathRange(MaxValueMe / MaxValue * QuoteValue, 15, MaxValueMe) If MaxValueMe - QuoteValueMe < WrongRange Then '过短 AniStart({AaOpacity(Me, -Me.Opacity, 100)}, Me.Name & "Opacity", False) _Control.Margin = New Thickness(0) If InCenter Then _ParentSubControl.VerticalAlignment = VerticalAlignment.Center Value = 0 Else '正常 AniStart({AaOpacity(Me, 1 - Me.Opacity, 100)}, Me.Name & "Opacity", False) _ParentSubControl.VerticalAlignment = VerticalAlignment.Top Value = OldValue End If If Not ValueMe = OldValueMe Then RaiseEvent Change(Me) Return True Catch ex As Exception ExShow(ex, "刷新滚动条失败", ErrorLevel.MsgboxAndFeedback) Return False End Try End Function ''' ''' 委托处理鼠标滚轮事件。将试图接管滚轮的控件添加一个Handler到这个事件。 ''' ''' ''' ''' Public Sub RunMouseWheel(ByVal sender As Object, ByVal e As System.Windows.Input.MouseWheelEventArgs) If Me.Visibility = Visibility.Visible Then '如果时间为负数就不会执行,所以加绝对值 AniStart({ AaValue(Me, -e.Delta, Math.Abs(e.Delta) * 2, , New AniEaseEnd) }, "Scroll" & GetUUID(), False) End If End Sub ''' ''' 点击滚动条空白部分改变值。 ''' ''' ''' ''' Private Sub btnBack_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles btnBack.MouseUp If btnDrag.IsMouseOver Then Exit Sub '点在空白部分 If e.GetPosition(btnDrag).Y < 0 Then AniStart({ AaValue(Me, -QuoteValue, 200, , New AniEaseEnd) }, "ScrollClick" & GetUUID(), False) Else AniStart({ AaValue(Me, QuoteValue, 200, , New AniEaseEnd) }, "ScrollClick" & GetUUID(), False) End If End Sub End Class