MySliderDot.xaml.vb 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169
  1. Public Class MySliderDot
  2. '基础
  3. Public Uuid As Integer = GetUuid()
  4. Public Event Change(sender As Object, user As Boolean)
  5. Public Event PreviewChange(sender As Object, e As RouteEventArgs)
  6. '自定义属性
  7. Private _MaxValue As Integer = 100
  8. Public Property MaxValue As Integer
  9. Get
  10. Return _MaxValue
  11. End Get
  12. Set(value As Integer)
  13. If value = _MaxValue Then Exit Property
  14. _MaxValue = value
  15. RefreshHeight(Nothing, Nothing)
  16. End Set
  17. End Property
  18. Private ChangeByKey As Boolean = False
  19. Private _Value As Integer = 0
  20. Public Property Value As Integer
  21. Get
  22. Return _Value
  23. End Get
  24. Set(newValue As Integer)
  25. Try
  26. newValue = MathRange(newValue, 0, MaxValue)
  27. If _Value = newValue Then Exit Property
  28. '触发前瞻事件,修改新值
  29. Dim OldValue = _Value
  30. _Value = newValue
  31. If AniControlEnabled = 0 Then
  32. Dim e = New RouteEventArgs(False)
  33. RaiseEvent PreviewChange(Me, e)
  34. If e.Handled Then
  35. _Value = OldValue
  36. Exit Property
  37. End If
  38. End If
  39. If IsLoaded AndAlso AniControlEnabled = 0 Then
  40. If ActualHeight < 16 Then Exit Property
  41. Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16)
  42. Dim DeltaProcess As Double = Math.Abs(LineFore.Height / (ActualHeight - 16) - _Value / MaxValue)
  43. Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 400 + If(ChangeByKey, 100, 0)
  44. AniStart({
  45. AaHeight(LineFore, Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5)) - LineFore.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
  46. AaHeight(LineBack, Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5)) - LineBack.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
  47. AaY(ShapeDot, NewHeight - ShapeDot.Margin.Top, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
  48. }, "MySlider Progress " & Uuid)
  49. Else
  50. RefreshHeight(Nothing, Nothing)
  51. End If
  52. If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
  53. Catch ex As Exception
  54. Logger.Warning(ex, "滑动条进度改变出错", LogLevel.Hint)
  55. End Try
  56. End Set
  57. End Property
  58. Private Sub RefreshHeight(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
  59. If Not IsNothing(e) Then PanMain.Height = e.NewSize.Height
  60. AniStop("MySlider Progress " & Uuid)
  61. Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16)
  62. LineFore.Height = Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5))
  63. LineBack.Height = Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5))
  64. SetTop(ShapeDot, NewHeight)
  65. End Sub
  66. '拖动
  67. Public GetHintText As [Delegate]
  68. Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles ShapeDot.MouseLeftButtonDown
  69. e.Handled = True '防止 ScrollViewer 失焦问题
  70. DragControl = Me
  71. AniStart({
  72. AaScaleTransform(ShapeDot, 2 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseOutFluent)
  73. }, "MySlider Scale " & Uuid)
  74. End Sub
  75. Public Sub DragDoing()
  76. Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).Y - 8) / (ActualHeight - 16), 0, 1)
  77. Dim NewValue As Integer = Percent * MaxValue
  78. If Not NewValue = Value Then Value = NewValue
  79. End Sub
  80. Public Sub DragStop()
  81. RefreshColor()
  82. AniStart({
  83. AaScaleTransform(ShapeDot, 2.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent)
  84. }, "MySlider Scale " & Uuid)
  85. If Value > 0 Then
  86. Value = MaxValue
  87. Else
  88. FrmMain.SliderDrag_Finish()
  89. End If
  90. End Sub
  91. '指向动画
  92. Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave
  93. 'Try
  94. ' '判断当前颜色
  95. ' Dim ColorName As String
  96. ' Dim AnimationTime As Integer
  97. ' If IsEnabled Then
  98. ' If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then
  99. ' ColorName = "ColorBrush3"
  100. ' AnimationTime = 100
  101. ' Else
  102. ' ColorName = "ColorBrush1"
  103. ' AnimationTime = 200
  104. ' End If
  105. ' Else
  106. ' ColorName = "ColorBrushGray4"
  107. ' AnimationTime = 200
  108. ' End If
  109. ' '触发颜色动画
  110. ' If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
  111. ' '有动画
  112. ' AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid)
  113. ' Else
  114. ' '无动画
  115. ' AniStop("MySlider Color " & Uuid)
  116. ' SetResourceReference(BorderBrushProperty, ColorName)
  117. ' End If
  118. 'Catch ex As Exception
  119. ' Log(ex, "滑动条颜色改变出错")
  120. 'End Try
  121. End Sub
  122. '按键改变
  123. 'Public Property ValueByKey As UInteger = 1
  124. 'Private Sub MySlider_MouseEnter() Handles Me.MouseEnter
  125. ' Focus() '确保按键能改变值
  126. 'End Sub
  127. 'Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
  128. ' '拒绝一边拖动一边用按键改变
  129. ' If ReferenceEquals(Me, DragControl) Then Exit Sub
  130. ' '改变值
  131. ' If e.Key = Key.Left Then
  132. ' ChangeByKey = True
  133. ' Value -= ValueByKey
  134. ' ChangeByKey = False
  135. ' e.Handled = True
  136. ' ElseIf e.Key = Key.Right Then
  137. ' ChangeByKey = True
  138. ' Value += ValueByKey
  139. ' ChangeByKey = False
  140. ' e.Handled = True
  141. ' Else
  142. ' Exit Sub
  143. ' End If
  144. ' '更新 Popup
  145. ' If GetHintText IsNot Nothing Then
  146. ' TextHint.Text = GetHintText.DynamicInvoke(Value)
  147. ' Popup.IsOpen = True
  148. ' AniStop("MySlider KeyPopup " & Uuid)
  149. ' AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid)
  150. ' End If
  151. 'End Sub
  152. End Class