MySlider.xaml.vb 7.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. Public Class MySlider
  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. RefreshWidth(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 = MathClamp(newValue, 0, MaxValue)
  27. If _Value = newValue Then Exit Property
  28. '触发 Preview 事件,修改新值
  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. DragStop()
  37. Exit Property
  38. End If
  39. End If
  40. If IsLoaded AndAlso AniControlEnabled = 0 Then
  41. If ActualWidth < ShapeDot.Width Then Exit Property
  42. Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
  43. Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
  44. Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
  45. AniStart({
  46. AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
  47. AaWidth(LineBack, Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
  48. AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
  49. }, "MySlider Progress " & Uuid)
  50. Else
  51. RefreshWidth(Nothing, Nothing)
  52. End If
  53. If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
  54. Catch ex As Exception
  55. Log(ex, "滑动条进度改变出错", LogLevel.Hint)
  56. End Try
  57. End Set
  58. End Property
  59. Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
  60. If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width
  61. AniStop("MySlider Progress " & Uuid)
  62. Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
  63. LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
  64. LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
  65. SetLeft(ShapeDot, NewWidth)
  66. End Sub
  67. '拖动
  68. Public GetHintText As [Delegate]
  69. Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
  70. e.Handled = True '防止 ScrollViewer 失焦问题
  71. DragControl = Me
  72. RefreshColor()
  73. FrmMain.DragDoing()
  74. AniStart({
  75. AaScaleTransform(ShapeDot, 1.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 40,, New AniEaseOutFluent)
  76. }, "MySlider Scale " & Uuid)
  77. RefreshPopup()
  78. AniStop("MySlider KeyPopup " & Uuid)
  79. End Sub
  80. Public Sub DragDoing()
  81. Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
  82. Dim NewValue As Integer = Percent * MaxValue
  83. If Not NewValue = Value Then
  84. Value = NewValue
  85. End If
  86. RefreshPopup()
  87. End Sub
  88. Public Sub DragStop()
  89. RefreshColor()
  90. AniStart({
  91. AaScaleTransform(ShapeDot, 1 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent)
  92. }, "MySlider Scale " & Uuid)
  93. Popup.IsOpen = False
  94. End Sub
  95. Public Sub RefreshPopup()
  96. If GetHintText Is Nothing Then Exit Sub
  97. Popup.IsOpen = True
  98. TextHint.Text = GetHintText.DynamicInvoke(Value)
  99. Dim typeface As New Typeface(TextHint.FontFamily, TextHint.FontStyle, TextHint.FontWeight, TextHint.FontStretch)
  100. Dim formattedText As New FormattedText(TextHint.Text, Thread.CurrentThread.CurrentCulture, TextHint.FlowDirection, typeface, TextHint.FontSize, TextHint.Foreground, DPI)
  101. TextHint.Width = formattedText.Width '使用手动测量的宽度修复 #1057
  102. End Sub
  103. '指向动画
  104. Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave
  105. Try
  106. '判断当前颜色
  107. Dim ForegroundName As String, DotFillName As String
  108. Dim AnimationTime As Integer
  109. If IsEnabled Then
  110. If Not IsNothing(DragControl) AndAlso DragControl.Equals(Me) Then
  111. ForegroundName = "ColorBrush3"
  112. DotFillName = "ColorBrush3"
  113. AnimationTime = 40
  114. ElseIf IsMouseOver Then
  115. ForegroundName = "ColorBrush3"
  116. DotFillName = "ColorBrush3"
  117. AnimationTime = 40
  118. Else
  119. ForegroundName = "ColorBrushBg0"
  120. DotFillName = "ColorBrushBg0"
  121. AnimationTime = 100
  122. End If
  123. Else
  124. ForegroundName = "ColorBrushGray5"
  125. DotFillName = "ColorBrushGray5"
  126. AnimationTime = 200
  127. End If
  128. '触发颜色动画
  129. If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
  130. '有动画
  131. AniStart({
  132. AaColor(Me, BorderBrushProperty, ForegroundName, AnimationTime),
  133. AaColor(ShapeDot, Ellipse.FillProperty, DotFillName, AnimationTime)
  134. }, "MySlider Color " & Uuid)
  135. Else
  136. '无动画
  137. AniStop("MySlider Color " & Uuid)
  138. SetResourceReference(BorderBrushProperty, ForegroundName)
  139. ShapeDot.SetResourceReference(Ellipse.FillProperty, DotFillName)
  140. End If
  141. Catch ex As Exception
  142. Log(ex, "滑动条颜色改变出错")
  143. End Try
  144. End Sub
  145. '按键改变
  146. Public Property ValueByKey As UInteger = 1
  147. Private Sub MySlider_MouseEnter() Handles Me.MouseEnter
  148. Focus() '确保按键能改变值
  149. End Sub
  150. Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
  151. '拒绝一边拖动一边用按键改变
  152. If ReferenceEquals(Me, DragControl) Then Exit Sub
  153. '改变值
  154. If e.Key = Key.Left Then
  155. ChangeByKey = True
  156. Value -= ValueByKey
  157. ChangeByKey = False
  158. e.Handled = True
  159. ElseIf e.Key = Key.Right Then
  160. ChangeByKey = True
  161. Value += ValueByKey
  162. ChangeByKey = False
  163. e.Handled = True
  164. Else
  165. Exit Sub
  166. End If
  167. '更新 Popup
  168. If GetHintText IsNot Nothing Then
  169. RefreshPopup()
  170. AniStop("MySlider KeyPopup " & Uuid)
  171. AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid)
  172. End If
  173. End Sub
  174. End Class