PCL-Communist/Plain Craft Launcher 2/Controls/MySlider.xaml.vb

Imports System.Windows.Shapes

Public Class MySlider
    Implements ISettingControl

    '基础

    Public Uuid As Integer = GetUuid()
    Public Event Change(sender As Object, user As Boolean)
    Public Event PreviewChange(sender As Object, e As RouteEventArgs)

    '自定义属性

    Private _MaxValue As Integer = 100
    Public Property MaxValue As Integer
        Get
            Return _MaxValue
        End Get
        Set(value As Integer)
            If value = _MaxValue Then Return
            _MaxValue = value
            RefreshWidth(Nothing, Nothing)
        End Set
    End Property
    Private ChangeByKey As Boolean = False
    Private _Value As Integer = 0
    Public Property Value As Integer
        Get
            Return _Value
        End Get
        Set(newValue As Integer)
            Try

                newValue = newValue.Clamp(0, MaxValue)
                If _Value = newValue Then Return

                '触发 Preview 事件，修改新值
                Dim OldValue = _Value
                _Value = newValue
                If AniControlEnabled = 0 Then
                    Dim e = New RouteEventArgs(False)
                    RaiseEvent PreviewChange(Me, e)
                    If e.Handled Then
                        _Value = OldValue
                        DragStop()
                        Return
                    End If
                End If

                If IsLoaded AndAlso AniControlEnabled = 0 Then
                    If ActualWidth < ShapeDot.Width Then Return
                    Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
                    Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
                    Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
                    AniStart({
                            AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
                            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)),
                            AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
                         }, "MySlider Progress " & Uuid)
                Else
                    RefreshWidth(Nothing, Nothing)
                End If
                If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)

            Catch ex As Exception
                Logger.Error(ex, "滑动条进度改变出错", LogBehavior.Toast)
            End Try
        End Set
    End Property
    Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
        If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width
        AniStop("MySlider Progress " & Uuid)
        Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
        LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
        LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
        ShapeDot.Margin = New Thickness(NewWidth, ShapeDot.Margin.Top, ShapeDot.Margin.Right, ShapeDot.Margin.Bottom)
    End Sub

    '拖动

    Public GetHintText As [Delegate]
    Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
        e.Handled = True '防止 ScrollViewer 失焦问题
        DragControl = Me
        RefreshColor()
        FrmMain.DragDoing()
        AniStart({
                 AaScaleTransform(ShapeDot, 1.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 40,, New AniEaseOutFluent)
            }, "MySlider Scale " & Uuid)
        RefreshPopup()
        AniStop("MySlider KeyPopup " & Uuid)
    End Sub
    Public Sub DragDoing()
        Dim Percent As Double = ((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width)).Clamp(0, 1)
        Dim NewValue As Integer = Percent * MaxValue
        If Not NewValue = Value Then
            Value = NewValue
        End If
        RefreshPopup()
    End Sub
    Public Sub DragStop()
        RefreshColor()
        AniStart({
                 AaScaleTransform(ShapeDot, 1 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent)
            }, "MySlider Scale " & Uuid)
        Popup.IsOpen = False
    End Sub
    Public Sub RefreshPopup()
        If GetHintText Is Nothing Then Return
        Popup.IsOpen = True
        TextHint.Text = GetHintText.DynamicInvoke(Value)
        Dim typeface As New Typeface(TextHint.FontFamily, TextHint.FontStyle, TextHint.FontWeight, TextHint.FontStretch)
        Dim formattedText As New FormattedText(TextHint.Text, Thread.CurrentThread.CurrentCulture, TextHint.FlowDirection, typeface, TextHint.FontSize, TextHint.Foreground, DPI)
        TextHint.Width = formattedText.Width '使用手动测量的宽度修复 #1057
    End Sub

    '指向动画

    Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave
        Try

            '判断当前颜色
            Dim ForegroundName As String, DotFillName As String
            Dim AnimationTime As Integer
            If IsEnabled Then
                If Not IsNothing(DragControl) AndAlso DragControl.Equals(Me) Then
                    ForegroundName = "ColorBrush3"
                    DotFillName = "ColorBrush3"
                    AnimationTime = 40
                ElseIf IsMouseOver Then
                    ForegroundName = "ColorBrush3"
                    DotFillName = "ColorBrush3"
                    AnimationTime = 40
                Else
                    ForegroundName = "ColorBrushBg0"
                    DotFillName = "ColorBrushBg0"
                    AnimationTime = 100
                End If
            Else
                ForegroundName = "ColorBrushGray5"
                DotFillName = "ColorBrushGray5"
                AnimationTime = 200
            End If
            '触发颜色动画
            If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
                '有动画
                AniStart({
                            AaColor(Me, BorderBrushProperty, ForegroundName, AnimationTime),
                            AaColor(ShapeDot, Ellipse.FillProperty, DotFillName, AnimationTime)
                         }, "MySlider Color " & Uuid)
            Else
                '无动画
                AniStop("MySlider Color " & Uuid)
                SetResourceReference(BorderBrushProperty, ForegroundName)
                ShapeDot.SetResourceReference(Ellipse.FillProperty, DotFillName)
            End If

        Catch ex As Exception
            Logger.Warn(ex, "滑动条颜色改变出错")
        End Try
    End Sub

    '按键改变

    Public Property ValueByKey As UInteger = 1
    Private Sub MySlider_MouseEnter() Handles Me.MouseEnter
        Focus() '确保按键能改变值
    End Sub
    Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        '拒绝一边拖动一边用按键改变
        If ReferenceEquals(Me, DragControl) Then Return
        '改变值
        If e.Key = Key.Left Then
            ChangeByKey = True
            Value -= ValueByKey
            ChangeByKey = False
            e.Handled = True
        ElseIf e.Key = Key.Right Then
            ChangeByKey = True
            Value += ValueByKey
            ChangeByKey = False
            e.Handled = True
        Else
            Return
        End If
        '更新 Popup
        If GetHintText IsNot Nothing Then
            RefreshPopup()
            AniStop("MySlider KeyPopup " & Uuid)
            AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid)
        End If
    End Sub

#Region "设置"

    Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
        Value = Val(NewValue)
    End Sub

    Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
        Return Value
    End Function

    Private Sub SaveSetting() Handles Me.Change
        SettingService.SaveSetting(Me)
    End Sub

#End Region

End Class