Merge branch 'main' into feat5684

This commit is contained in:
龙腾猫跃
2025-10-06 01:14:23 +08:00
committed by GitHub
171 changed files with 8675 additions and 5622 deletions
@@ -0,0 +1,187 @@
' Author: uye (owner of the MaaAssistantArknights team)
' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
' License: Apache License 2.0 (this file only)
'
' This file is originally developed for MaaAssistantArknights and licensed under AGPL v3.0.
' As the original author and copyright holder,
' I hereby re-license this file under the Apache License 2.0 for use in the Plain Craft Launcher project.
'
' This file is contributed under the spirit of good faith and open cooperation.
' It does not implement any core launcher functions of PCL.
'
' Description:
' Provides a WPF clipboard handling fix to avoid OpenClipboard exceptions
' in TextBox, RichTextBox, and DataGrid under Windows focus issues or clipboard hooks.
'
' Date: 2025-07-03
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Input
Imports System.Windows.Documents
Imports System.Linq
Namespace Controls.Behaviors
Public NotInheritable Class ClipboardInterceptor
Private Sub New()
End Sub
Public Shared ReadOnly EnableSafeClipboardProperty As DependencyProperty =
DependencyProperty.RegisterAttached("EnableSafeClipboard", GetType(Boolean), GetType(ClipboardInterceptor),
New PropertyMetadata(False, AddressOf OnEnableSafeClipboardChanged))
Public Shared Sub SetEnableSafeClipboard(element As DependencyObject, value As Boolean)
element.SetValue(EnableSafeClipboardProperty, value)
End Sub
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
Return CBool(element.GetValue(EnableSafeClipboardProperty))
End Function
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
If TypeOf d Is TextBox AndAlso CBool(e.NewValue) Then
AddCommandBindingsToTextBox(DirectCast(d, TextBox))
ElseIf TypeOf d Is RichTextBox AndAlso CBool(e.NewValue) Then
AddCommandBindingsToRichTextBox(DirectCast(d, RichTextBox))
ElseIf TypeOf d Is DataGrid AndAlso CBool(e.NewValue) Then
AddCommandBindingsToDataGrid(DirectCast(d, DataGrid))
End If
End Sub
Private Shared Sub AddCommandBindingsToTextBox(tb As TextBox)
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyTextBox))
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutTextBox))
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteTextBox))
End Sub
Private Shared Sub AddCommandBindingsToRichTextBox(rtb As RichTextBox)
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyRichTextBox))
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutRichTextBox))
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteRichTextBox))
End Sub
Private Shared Sub AddCommandBindingsToDataGrid(dg As DataGrid)
dg.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyDataGrid))
End Sub
Private Shared Sub OnCopyTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
End Try
e.Handled = True
End Sub
Private Shared Sub OnCutTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
End Try
tb.SelectedText = String.Empty
e.Handled = True
End Sub
Private Shared Sub OnPasteTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing Then Return
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0
End If
e.Handled = True
End Sub
Private Shared Sub OnCopyRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
Dim textRange = New TextRange(rtb.Selection.Start, rtb.Selection.End)
If String.IsNullOrEmpty(textRange.Text) Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(textRange.Text, True)
Catch
End Try
e.Handled = True
End Sub
Private Shared Sub OnCutRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
Dim selection = New TextRange(rtb.Selection.Start, rtb.Selection.End)
If String.IsNullOrEmpty(selection.Text) Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(selection.Text, True)
Catch
End Try
selection.Text = String.Empty
e.Handled = True
End Sub
Private Shared Sub OnPasteRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
If Not Forms.Clipboard.ContainsText() Then Return
Dim pasteText = Forms.Clipboard.GetText()
Dim selection = rtb.Selection
selection.Text = pasteText
Dim caretPos = selection.End
rtb.CaretPosition = caretPos
rtb.Selection.Select(caretPos, caretPos)
e.Handled = True
End Sub
Private Shared Sub OnCopyDataGrid(sender As Object, e As ExecutedRoutedEventArgs)
Dim dg = TryCast(sender, DataGrid)
If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return
Dim sb = New System.Text.StringBuilder()
Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item)
For Each row In rowGroups
Dim rowText = String.Join(vbTab, row.Select(Function(cell)
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
Return If(tb IsNot Nothing, tb.Text, "")
End Function))
sb.AppendLine(rowText)
Next
Dim sbStr = sb.ToString().TrimEnd(ControlChars.Cr, ControlChars.Lf)
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(sbStr, True)
Catch
End Try
e.Handled = True
End Sub
End Class
End Namespace
@@ -0,0 +1,15 @@
Imports System.Windows.Threading
''' <summary>
''' 指示页面可以通过按下 F5 或以其他方式刷新。
''' </summary>
Public Interface IRefreshable
Sub Refresh()
End Interface
''' <summary>
''' 指示页面可以处理未捕获的异常。
''' </summary>
Public Interface IDispatcherUnhandledException
Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
End Interface
@@ -142,7 +142,7 @@ Public Class MyButton
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
@@ -197,7 +197,7 @@ Public Class MyButton
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush7"), AnimationColorIn), "MyButton Background " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
IsMouseDown = False
AniStart({
AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle))
@@ -205,7 +205,7 @@ Public Class MyButton
End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave
AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid)
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
IsMouseDown = False
AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid)
End Sub
+90 -68
View File
@@ -3,7 +3,7 @@
'控件
Inherits Grid
Private ReadOnly MainGrid As Grid
Public ReadOnly Property MainChrome As SystemDropShadowChrome
Public ReadOnly Property MainChrome As MyDropShadow
Private ReadOnly MainBorder As Border
Public Property BorderChild As UIElement
Get
@@ -63,17 +63,18 @@
'UI 建立
Public Sub New()
MainChrome = New SystemDropShadowChrome With {.Margin = New Thickness(-9.5, -9, 0.5, -0.5), .Opacity = 0.1, .CornerRadius = New CornerRadius(6)}
MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1")
MainChrome = New MyDropShadow With {
.Margin = New Thickness(-3, -3, -3, -3 - GetWPFSize(1)), .ShadowRadius = 3, .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius(5)}
MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1")
Children.Insert(0, MainChrome)
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(245, 255, 255, 255)), .CornerRadius = New CornerRadius(5), .IsHitTestVisible = False}
Children.Insert(1, MainBorder)
MainGrid = New Grid
Children.Add(MainGrid)
End Sub
Private IsLoad As Boolean = False
Private Sub Init() Handles Me.Loaded
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
'初次加载限定
If MainTextBlock Is Nothing Then
@@ -89,7 +90,7 @@
MainGrid.Children.Add(MainSwap)
End If
'改变默认的折叠
If IsSwaped AndAlso SwapControl IsNot Nothing Then
If IsSwapped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
'取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation
@@ -108,7 +109,7 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Exit Sub
If IsNothing(Stack.Tag) Then Return
'排序
Select Case Type
Case 3
@@ -122,14 +123,6 @@
End Select
'控件转换
Select Case Type
Case 5
Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
LoadingPickaxe.State = Loader
Loader.Start(Stack.Tag)
AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
Stack.Children.Add(LoadingPickaxe)
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
@@ -144,9 +137,6 @@
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3
Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
Case 4
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
Case 5
Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7
@@ -186,29 +176,29 @@
Stack.Tag = Nothing
End Sub
'事件
'动画
Private Const DropShadowIdleOpacity As Double = 0.07
Private Const DropShadowHoverOpacity As Double = 0.4
Public Property HasMouseAnimation As Boolean = True
Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
If Not HasMouseAnimation Then Exit Sub
If Not HasMouseAnimation Then Return
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 90))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 90))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4", 90),
AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
If Not HasMouseAnimation Then Exit Sub
If Not HasMouseAnimation Then Return
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 90))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 90))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1", 90),
AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
@@ -222,46 +212,64 @@
Private IsHeightAnimating As Boolean = False
Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not UseAnimation Then Exit Sub
Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
If Not UseAnimation Then Return
Dim DeltaHeight As Double = If(IsSwapped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
'卡片的进入时动画已被页面通用切换动画替代
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Exit Sub
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
End Sub
Private Sub StartHeightAnimation(DeltaHeight As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
Private Sub StartHeightAnimation(Delta As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
'高度增加较大,使用弹起动画
Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
AnimList.AddRange({
AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
})
Dim AbsDelta = Math.Abs(Delta)
If AbsDelta <= 800 Then
'短距离,直接使用 150ms 的缓动动画
AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
Dim EaseLength As Integer, EaseTime As Integer
Dim InitSpeed As Integer '到达缓动区前的初速度
If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0.1 Then
'收回距离过长 (>0.1s),强制以 100ms 完成匀速段,然后让减速段更长
EaseLength = 200
EaseTime = 150
InitSpeed = (AbsDelta - EaseLength) / 0.1
ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0.6 Then
'展开距离过长 (>0.6s),以 5000 速度展示 300ms 匀速段,剩下的距离全部归入减速段
InitSpeed = 5000
EaseLength = AbsDelta - InitSpeed * 0.3
EaseTime = 400
Else
'中程,匀速地快速展开(或收回)
EaseLength = 150
EaseTime = 200
InitSpeed = 4000
End If
'匀速段
AnimList.Add(AaHeight(Me, (AbsDelta - EaseLength) * Math.Sign(Delta),
(AbsDelta - EaseLength) / InitSpeed * 1000))
'减速段
AnimList.Add(AaHeight(Me, EaseLength * Math.Sign(Delta),
EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000, EaseLength), True))
End If
AnimList.Add(AaCode(
Sub()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
If IsSwapped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True
ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
ActualUsedHeight = If(IsSwapped, SwapedHeight, Height)
Height = PreviousHeight
End Sub
''' <summary>
''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。
''' </summary>
Public Sub TriggerForceResize()
Height = If(IsSwaped, SwapedHeight, Double.NaN)
Height = If(IsSwapped, SwapedHeight, Double.NaN)
AniStop("MyCard Height " & Uuid)
IsHeightAnimating = False
End Sub
@@ -281,26 +289,40 @@
''' <summary>
''' 是否已被折叠。
''' </summary>
Public Property IsSwaped As Boolean
Public Property IsSwapped As Boolean
Get
Return _IsSwaped
Return _IsSwapped
End Get
Set(value As Boolean)
If _IsSwaped = value Then Exit Property
_IsSwaped = value
If SwapControl Is Nothing Then Exit Property
If _IsSwapped = value Then Return
_IsSwapped = value
If SwapControl Is Nothing Then Return
'展开
If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
'若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
If Not IsLoaded Then Exit Property
If Not IsLoaded Then Return
'更新高度
SwapControl.Visibility = Visibility.Visible
TriggerForceResize()
'改变箭头
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "MyCard Swap " & Uuid, True)
AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
End Set
End Property
Private _IsSwaped As Boolean = False
Private _IsSwapped As Boolean = False
''' <summary>
''' 是否已被折叠。(已过时,请使用 IsSwapped)
''' </summary>
<Obsolete("IsSwaped 存在拼写错误,请换用 IsSwapped 属性。")>
Public Property IsSwaped As Boolean
Get
Return GetValue(IsSwapedProperty)
End Get
Set(value As Boolean)
SetValue(IsSwapedProperty, value)
End Set
End Property
Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
Public Property SwapLogoRight As Boolean = False
Private IsMouseDown As Boolean = False
@@ -309,8 +331,8 @@
Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
@@ -318,8 +340,8 @@
IsMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
@@ -328,8 +350,8 @@
Return
End If
IsSwaped = Not IsSwaped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
IsSwapped = Not IsSwapped
Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
@@ -350,7 +372,7 @@ Partial Public Module ModAnimation
AaCode(
Sub()
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Exit Sub
If Control.Parent Is Nothing Then Return
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
@@ -360,7 +382,7 @@ Partial Public Module ModAnimation
}, "MyCard Dispose " & Control.Uuid)
Else
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Exit Sub
If Control.Parent Is Nothing Then Return
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
@@ -40,7 +40,7 @@ Public Class MyCheckBox
''' <param name="user">是否由用户引发。</param>
Public Sub SetChecked(value As Boolean, user As Boolean)
Try
If value = Checked Then Exit Sub
If value = Checked Then Return
'Preview 事件
If value AndAlso user Then
@@ -50,7 +50,7 @@ Public Class MyCheckBox
MouseDowned = True
Checkbox_MouseLeave()
MouseDowned = False
Exit Sub
Return
End If
End If
@@ -133,14 +133,14 @@ Public Class MyCheckBox
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
MouseDowned = False
SetChecked(Not Checked, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
If Not AllowMouseDown Then Exit Sub
If Not AllowMouseDown Then Return
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
@@ -154,7 +154,7 @@ Public Class MyCheckBox
End If
End Sub
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
MouseDowned = False
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
If Checked Then
@@ -203,7 +203,7 @@ Public Class MyCheckBox
}, "MyCheckBox BorderColor " & Uuid)
End Sub
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid)
@@ -8,7 +8,7 @@
Public Property HintText As String = ""
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If Not IsEditable Then Exit Sub
If Not IsEditable Then Return
Try
TextBox = Template.FindName("PART_EditableTextBox", Me)
TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor))
@@ -116,7 +116,7 @@
'修复 WPF Bug:下拉框文本修改后,依然误认为还选择着此前的选项,导致再次点击该选项时内容不变
Private IsTextChanging As Boolean = False
Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
If IsTextChanging OrElse Not IsEditable Then Exit Sub
If IsTextChanging OrElse Not IsEditable Then Return
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
@@ -35,7 +35,7 @@
NewFontOpacity = 0.4
Time = AnimationTimeOut
End If
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Return
BackColorName = NewBackColorName
FontOpacity = NewFontOpacity
'触发颜色动画
@@ -0,0 +1,324 @@
Public Class MyDropShadow
Inherits Decorator
''' <summary>
''' 阴影颜色。
''' </summary>
Public Property Color As Color
Get
Return GetValue(ColorProperty)
End Get
Set(value As Color)
SetValue(ColorProperty, value)
End Set
End Property
Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(MyDropShadow),
New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
''' <summary>
''' 阴影模糊半径。
''' </summary>
Public Property ShadowRadius As Double
Get
Return GetValue(ShadowRadiusProperty)
End Get
Set(value As Double)
SetValue(ShadowRadiusProperty, value)
End Set
End Property
Public Shared ReadOnly ShadowRadiusProperty As DependencyProperty = DependencyProperty.Register("ShadowRadius", GetType(Double), GetType(MyDropShadow),
New FrameworkPropertyMetadata(CDbl(5), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
''' <summary>
''' 圆角大小。
''' </summary>
Public Property CornerRadius As CornerRadius
Get
Return GetValue(CornerRadiusProperty)
End Get
Set(value As CornerRadius)
SetValue(CornerRadiusProperty, value)
End Set
End Property
Private Shared Function IsCornerRadiusValid(value As Object) As Boolean
Dim cr As CornerRadius = value
Return Not (cr.TopLeft < 0.0 OrElse cr.TopRight < 0.0 OrElse cr.BottomLeft < 0.0 OrElse cr.BottomRight < 0.0 OrElse Double.IsNaN(cr.TopLeft) OrElse Double.IsNaN(cr.TopRight) OrElse Double.IsNaN(cr.BottomLeft) OrElse Double.IsNaN(cr.BottomRight) OrElse Double.IsInfinity(cr.TopLeft) OrElse Double.IsInfinity(cr.TopRight) OrElse Double.IsInfinity(cr.BottomLeft) OrElse Double.IsInfinity(cr.BottomRight))
End Function
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyDropShadow),
New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
' =======================================
' 渲染
' =======================================
Protected Overrides Sub OnRender(drawingContext As DrawingContext)
Dim cornerRadius As CornerRadius = Me.CornerRadius
Dim shadowBounds As New Rect(0, 0, RenderSize.Width, RenderSize.Height)
Dim color As Color = Me.Color
If shadowBounds.Width > 0 AndAlso shadowBounds.Height > 0 AndAlso color.A > 0 Then
Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowRadius
Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowRadius
Dim maxRadius As Double = Math.Min(centerWidth * 0.5, centerHeight * 0.5)
cornerRadius.TopLeft = Math.Min(cornerRadius.TopLeft, maxRadius)
cornerRadius.TopRight = Math.Min(cornerRadius.TopRight, maxRadius)
cornerRadius.BottomLeft = Math.Min(cornerRadius.BottomLeft, maxRadius)
cornerRadius.BottomRight = Math.Min(cornerRadius.BottomRight, maxRadius)
Dim brushes As Brush() = GetBrushes(color, cornerRadius)
Dim centerTop As Double = shadowBounds.Top + ShadowRadius
Dim centerLeft As Double = shadowBounds.Left + ShadowRadius
Dim centerRight As Double = shadowBounds.Right - ShadowRadius
Dim centerBottom As Double = shadowBounds.Bottom - ShadowRadius
Dim guidelineSetX As Double() = New Double() {centerLeft, centerLeft + cornerRadius.TopLeft, centerRight - cornerRadius.TopRight, centerLeft + cornerRadius.BottomLeft, centerRight - cornerRadius.BottomRight, centerRight}
Dim guidelineSetY As Double() = New Double() {centerTop, centerTop + cornerRadius.TopLeft, centerTop + cornerRadius.TopRight, centerBottom - cornerRadius.BottomLeft, centerBottom - cornerRadius.BottomRight, centerBottom}
drawingContext.PushGuidelineSet(New GuidelineSet(guidelineSetX, guidelineSetY))
cornerRadius.TopLeft += ShadowRadius
cornerRadius.TopRight += ShadowRadius
cornerRadius.BottomLeft += ShadowRadius
cornerRadius.BottomRight += ShadowRadius
Dim topLeft As New Rect(shadowBounds.Left, shadowBounds.Top, cornerRadius.TopLeft, cornerRadius.TopLeft)
drawingContext.DrawRectangle(brushes(Placement.TopLeft), Nothing, topLeft)
Dim topWidth As Double = guidelineSetX(2) - guidelineSetX(1)
If topWidth > 0 Then
Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowRadius)
drawingContext.DrawRectangle(brushes(Placement.Top), Nothing, top)
End If
Dim topRight As New Rect(guidelineSetX(2), shadowBounds.Top, cornerRadius.TopRight, cornerRadius.TopRight)
drawingContext.DrawRectangle(brushes(Placement.TopRight), Nothing, topRight)
Dim leftHeight As Double = guidelineSetY(3) - guidelineSetY(1)
If leftHeight > 0 Then
Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowRadius, leftHeight)
drawingContext.DrawRectangle(brushes(Placement.Left), Nothing, left)
End If
Dim rightHeight As Double = guidelineSetY(4) - guidelineSetY(2)
If rightHeight > 0 Then
Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowRadius, rightHeight)
drawingContext.DrawRectangle(brushes(Placement.Right), Nothing, right)
End If
Dim bottomLeft As New Rect(shadowBounds.Left, guidelineSetY(3), cornerRadius.BottomLeft, cornerRadius.BottomLeft)
drawingContext.DrawRectangle(brushes(Placement.BottomLeft), Nothing, bottomLeft)
Dim bottomWidth As Double = guidelineSetX(4) - guidelineSetX(3)
If bottomWidth > 0 Then
Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowRadius)
drawingContext.DrawRectangle(brushes(Placement.Bottom), Nothing, bottom)
End If
Dim bottomRight As New Rect(guidelineSetX(4), guidelineSetY(4), cornerRadius.BottomRight, cornerRadius.BottomRight)
drawingContext.DrawRectangle(brushes(Placement.BottomRight), Nothing, bottomRight)
If cornerRadius.TopLeft = ShadowRadius AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
Dim center As New Rect(guidelineSetX(0), guidelineSetY(0), centerWidth, centerHeight)
drawingContext.DrawRectangle(brushes(Placement.Center), Nothing, center)
Else
Dim figure As New PathFigure()
If cornerRadius.TopLeft > ShadowRadius Then
figure.StartPoint = New Point(guidelineSetX(1), guidelineSetY(0))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(1), guidelineSetY(1)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(1)), True))
Else
figure.StartPoint = New Point(guidelineSetX(0), guidelineSetY(0))
End If
If cornerRadius.BottomLeft > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(3)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(3)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(5)), True))
Else
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(5)), True))
End If
If cornerRadius.BottomRight > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(5)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(4)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(4)), True))
Else
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(5)), True))
End If
If cornerRadius.TopRight > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(2)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(2)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(0)), True))
Else
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(0)), True))
End If
figure.IsClosed = True
figure.Freeze()
Dim geometry As New PathGeometry()
geometry.Figures.Add(figure)
geometry.Freeze()
drawingContext.DrawGeometry(brushes(Placement.Center), Nothing, geometry)
End If
drawingContext.Pop()
End If
End Sub
Private Enum Placement
TopLeft = 0
Top = 1
TopRight = 2
Left = 3
Center = 4
Right = 5
BottomLeft = 6
Bottom = 7
BottomRight = 8
End Enum
Private Shared _commonBrushes As Brush()
Private Shared _commonCornerRadius As CornerRadius
Private Shared ReadOnly _resourceAccess As New Object()
Private _brushes As Brush()
Private Shared Sub ClearBrushes(o As DependencyObject, e As DependencyPropertyChangedEventArgs)
CType(o, MyDropShadow)._brushes = Nothing
End Sub
Private Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
Dim gradientScale As Double = 1 / (ShadowRadius + cornerRadius)
Dim gsc As New GradientStopCollection
Dim stopColor As Color = c
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.1 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.74336 * c.A)
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.3 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.38053 * c.A)
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.5 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.12389 * c.A)
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.7 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.02654 * c.A)
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.9 + cornerRadius) * gradientScale))
stopColor.A = 0
gsc.Add(New GradientStop(stopColor, (ShadowRadius + cornerRadius) * gradientScale))
gsc.Freeze()
Return gsc
End Function
Private Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
Dim brushes As Brush() = New Brush(8) {}
brushes(Placement.Center) = New SolidColorBrush(c)
brushes(Placement.Center).Freeze()
Dim sideStops As GradientStopCollection = CreateStops(c, 0)
Dim top As New LinearGradientBrush(sideStops, New Point(0, 1), New Point(0, 0))
top.Freeze()
brushes(Placement.Top) = top
Dim left As New LinearGradientBrush(sideStops, New Point(1, 0), New Point(0, 0))
left.Freeze()
brushes(Placement.Left) = left
Dim right As New LinearGradientBrush(sideStops, New Point(0, 0), New Point(1, 0))
right.Freeze()
brushes(Placement.Right) = right
Dim bottom As New LinearGradientBrush(sideStops, New Point(0, 0), New Point(0, 1))
bottom.Freeze()
brushes(Placement.Bottom) = bottom
Dim topLeftStops As GradientStopCollection
If cornerRadius.TopLeft = 0 Then
topLeftStops = sideStops
Else
topLeftStops = CreateStops(c, cornerRadius.TopLeft)
End If
Dim topLeft As New RadialGradientBrush(topLeftStops) With {
.RadiusX = 1,
.RadiusY = 1,
.Center = New Point(1, 1),
.GradientOrigin = New Point(1, 1)
}
topLeft.Freeze()
brushes(Placement.TopLeft) = topLeft
Dim topRightStops As GradientStopCollection
If cornerRadius.TopRight = 0 Then
topRightStops = sideStops
ElseIf cornerRadius.TopRight = cornerRadius.TopLeft Then
topRightStops = topLeftStops
Else
topRightStops = CreateStops(c, cornerRadius.TopRight)
End If
Dim topRight As New RadialGradientBrush(topRightStops) With {
.RadiusX = 1,
.RadiusY = 1,
.Center = New Point(0, 1),
.GradientOrigin = New Point(0, 1)
}
topRight.Freeze()
brushes(Placement.TopRight) = topRight
Dim bottomLeftStops As GradientStopCollection
If cornerRadius.BottomLeft = 0 Then
bottomLeftStops = sideStops
ElseIf cornerRadius.BottomLeft = cornerRadius.TopLeft Then
bottomLeftStops = topLeftStops
ElseIf cornerRadius.BottomLeft = cornerRadius.TopRight Then
bottomLeftStops = topRightStops
Else
bottomLeftStops = CreateStops(c, cornerRadius.BottomLeft)
End If
Dim bottomLeft As New RadialGradientBrush(bottomLeftStops) With {
.RadiusX = 1,
.RadiusY = 1,
.Center = New Point(1, 0),
.GradientOrigin = New Point(1, 0)
}
bottomLeft.Freeze()
brushes(Placement.BottomLeft) = bottomLeft
Dim bottomRightStops As GradientStopCollection
If cornerRadius.BottomRight = 0 Then
bottomRightStops = sideStops
ElseIf cornerRadius.BottomRight = cornerRadius.TopLeft Then
bottomRightStops = topLeftStops
ElseIf cornerRadius.BottomRight = cornerRadius.TopRight Then
bottomRightStops = topRightStops
ElseIf cornerRadius.BottomRight = cornerRadius.BottomLeft Then
bottomRightStops = bottomLeftStops
Else
bottomRightStops = CreateStops(c, cornerRadius.BottomRight)
End If
Dim bottomRight As New RadialGradientBrush(bottomRightStops) With {
.RadiusX = 1,
.RadiusY = 1,
.Center = New Point(0, 0),
.GradientOrigin = New Point(0, 0)
}
bottomRight.Freeze()
brushes(Placement.BottomRight) = bottomRight
Return brushes
End Function
Private Function GetBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
If _commonBrushes Is Nothing Then
SyncLock _resourceAccess
If _commonBrushes Is Nothing Then
_commonBrushes = CreateBrushes(c, cornerRadius)
_commonCornerRadius = cornerRadius
End If
End SyncLock
End If
If c = CType(_commonBrushes(Placement.Center), SolidColorBrush).Color AndAlso cornerRadius = _commonCornerRadius Then
_brushes = Nothing
Return _commonBrushes
ElseIf _brushes Is Nothing Then
_brushes = CreateBrushes(c, cornerRadius)
End If
Return _brushes
End Function
End Class
'参考自:https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
@@ -11,7 +11,7 @@
Return _Progress
End Get
Set(value As Double)
If _Progress = value Then Exit Property
If _Progress = value Then Return
_Progress = value
If value < 0.0001 Then
PanProgress.Visibility = Visibility.Collapsed
@@ -30,7 +30,7 @@
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
If value = _Logo Then Return
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
@@ -51,7 +51,7 @@
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(Sub()
If value Then
@@ -121,7 +121,7 @@
Focus()
End Sub
Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
If Not CanRightClick Then Exit Sub
If Not CanRightClick Then Return
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
@@ -141,7 +141,7 @@
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not CanRightClick Then Exit Sub
If Not CanRightClick Then Return
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
@@ -14,7 +14,7 @@ Public Class MyExtraTextButton
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
If value = _Logo Then Return
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
@@ -55,7 +55,7 @@ Public Class MyExtraTextButton
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(
Sub()
+4 -12
View File
@@ -3,22 +3,14 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
FocusVisualStyle="{x:Null}"
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="1" BorderBrush="#99FF4444" CornerRadius="3">
<Border.Background>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop x:Name="Gradient1" Color="#88FFBBBB" Offset="0.3"/>
<GradientStop x:Name="Gradient2" Color="#88FF8888" Offset="0.9"/>
</LinearGradientBrush>
</Border.Background>
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="3,0,0,0" BorderBrush="#99FF4444" CornerRadius="2">
<Grid UseLayoutRounding="False" SnapsToDevicePixels="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
<TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" Visibility="Collapsed" Theme="Custom" Margin="0,0,8,0" Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z"
ToolTip="不再提示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid>
</Border>
+73 -38
View File
@@ -2,37 +2,73 @@
<ContentProperty("Inlines")>
Public Class MyHint
Public Uuid As Integer = GetUuid()
Private _IsWarn As Boolean = True
Public Property IsWarn As Boolean
'边框
Public Property HasBorder As Boolean
Get
Return _IsWarn
Return BorderThickness.Top > 0
End Get
Set(value As Boolean)
If _IsWarn = value Then Exit Property
_IsWarn = value
If _IsWarn Then
BorderBrush = New MyColor("#CCFF4444")
Gradient1.Color = New MyColor("#BBFFBBBB")
Gradient2.Color = New MyColor("#BBFF8888")
Path.Fill = New MyColor("#BF0000")
LabText.Foreground = New MyColor("#BF0000")
BtnClose.Foreground = New MyColor("#BF0000")
Path.Data = (New GeometryConverter).ConvertFromString("F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z ")
If value Then
BorderThickness = New Thickness(3, GetWPFSize(1), GetWPFSize(1), GetWPFSize(1))
Else
BorderBrush = New MyColor("#CC4D76FF")
Gradient1.Color = New MyColor("#BBB0D0FF")
Gradient2.Color = New MyColor("#BB9EBAFF")
Path.Fill = New MyColor("#0062BF")
LabText.Foreground = New MyColor("#0062BF")
BtnClose.Foreground = New MyColor("#0062BF")
Path.Data = (New GeometryConverter).ConvertFromString("F1M38,19C48.4934,19 57,27.5066 57,38 57,48.4934 48.4934,57 38,57 27.5066,57 19,48.4934 19,38 19,27.5066 27.5066,19 38,19z M33.25,33.25L33.25,36.4167 36.4166,36.4167 36.4166,47.5 33.25,47.5 33.25,50.6667 44.3333,50.6667 44.3333,47.5 41.1666,47.5 41.1666,36.4167 41.1666,33.25 33.25,33.25z M38.7917,25.3333C37.48,25.3333 36.4167,26.3967 36.4167,27.7083 36.4167,29.02 37.48,30.0833 38.7917,30.0833 40.1033,30.0833 41.1667,29.02 41.1667,27.7083 41.1667,26.3967 40.1033,25.3333 38.7917,25.3333z")
BorderThickness = New Thickness(3, 0, 0, 0)
End If
End Set
End Property
'配色
Public Enum Themes
Blue = 0
Red = 1
Yellow = 2
End Enum
Public Property Theme As Themes
Get
Return _ColorType
End Get
Set(value As Themes)
_ColorType = value
UpdateUI()
End Set
End Property
Private _ColorType As Themes = Themes.Red
Private Sub UpdateUI() Handles Me.Loaded
Select Case Theme
Case Themes.Blue
Background = New MyColor("#d9ecff")
BorderBrush = New MyColor("#1172D4")
LabText.Foreground = New MyColor("#0F64B8")
BtnClose.Foreground = New MyColor("#0F64B8")
Case Themes.Red
Background = New MyColor("#ffdddf")
BorderBrush = New MyColor("#d82929")
LabText.Foreground = New MyColor("#bf0b0b")
BtnClose.Foreground = New MyColor("#bf0b0b")
Case Themes.Yellow
Background = New MyColor("#ffebd7")
BorderBrush = New MyColor("#f57a00")
LabText.Foreground = New MyColor("#d86c00")
BtnClose.Foreground = New MyColor("#d86c00")
End Select
End Sub
<Obsolete("IsWarn 已过时。请换用 Theme 属性。")>
Public Property IsWarn As Boolean
Get
Return Theme = Themes.Red
End Get
Set(value As Boolean)
Theme = If(value, Themes.Red, Themes.Blue)
End Set
End Property
Public Shared ReadOnly IsWarnProperty As DependencyProperty =
DependencyProperty.Register("IsWarn", GetType(Boolean), GetType(MyHint), New PropertyMetadata(True,
Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
d.Theme = If(e.NewValue, Themes.Red, Themes.Blue)
End Sub))
'文本
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
@@ -52,6 +88,7 @@ Public Class MyHint
d.LabText.Text = e.NewValue
End Sub))
'关闭按钮
Public Property CanClose As Boolean
Get
Return BtnClose.Visibility = Visibility.Visible
@@ -60,12 +97,9 @@ Public Class MyHint
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public Property RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then
Visibility = Visibility.Collapsed
End If
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True)
@@ -121,20 +155,21 @@ Public Class MyHint
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
If Not Control.IsHitTestVisible Then Return
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(
Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
End Sub
End Module
@@ -198,7 +198,7 @@
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyIconButton, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
If Not Control.IsHitTestVisible Then Return
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent),
@@ -72,7 +72,7 @@ Public Class MyIconTextButton
Public Event Click(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
+18 -57
View File
@@ -25,7 +25,7 @@
''' <summary>
''' 与 Image 的 Source 类似。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存。
''' 支持 WebP 格式的图片。
''' </summary>
Public Shadows Property Source As String '覆写 Image 的 Source 属性
@@ -34,9 +34,9 @@
End Get
Set(value As String)
If value = "" Then value = Nothing
If _Source = value Then Exit Property
If _Source = value Then Return
_Source = value
If Not IsInitialized Then Exit Property '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
If Not IsInitialized Then Return '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
Load()
End Set
End Property
@@ -46,7 +46,7 @@
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary>
''' 当 Source 首次下载失败时,会从该备用地址加载图片。
''' 若 Source 是一个网络图片,该地址将作为第二下载源。
''' </summary>
Public Property FallbackSource As String
Get
@@ -82,7 +82,7 @@
End Get
Set(value As String)
If value = "" Then value = Nothing
If _ActualSource = value Then Exit Property
If _ActualSource = value Then Return
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
@@ -103,82 +103,43 @@
'空
If Source Is Nothing Then
ActualSource = Nothing
Exit Sub
Return
End If
'本地图片
If Not Source.StartsWithF("http") Then
ActualSource = Source
Exit Sub
Return
End If
'从缓存加载网络图片
Dim Url As String = Source
Dim Retried As Boolean = False
Dim TempPath As String = GetTempPath(Url)
Dim TempFile As New FileInfo(TempPath)
Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = GetTempPath(Source) & If(EnableCache, "", GetUuid()) '不启用缓存时加上随机字符串,避免冲突
Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
End If
RunInNewThread(
Sub()
Dim TempDownloadingPath As String = Nothing
Try
RetryStart:
'下载
ActualSource = LoadingSource '显示加载中图片
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载,以避免携带 Header(#5072)
Using Client As New Net.WebClient
Client.DownloadFile(Url, TempDownloadingPath)
End Using
If Url <> Source AndAlso Url <> FallbackSource Then
'已经更换了地址
File.Delete(TempDownloadingPath)
ElseIf EnableCache Then
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
If(String.IsNullOrEmpty(FallbackSource), {Source}, {Source, FallbackSource}),
TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then
'保存缓存并显示
If File.Exists(TempPath) Then File.Delete(TempPath)
FileSystem.Rename(TempDownloadingPath, TempPath)
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempDownloadingPath)
File.Delete(TempDownloadingPath)
RunInUiWait(Sub() ActualSource = TempPath)
File.Delete(TempPath)
End If
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
Catch
End Try
If Not Retried Then
'更换备用地址
Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer)
Retried = True
Url = If(FallbackSource, Source)
'空
If Url Is Nothing Then
ActualSource = Nothing
Exit Sub
End If
'本地图片
If Not Url.StartsWithF("http") Then
ActualSource = Url
Exit Sub
End If
'从缓存加载网络图片
TempPath = GetTempPath(Url)
TempFile = New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists() Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
'下载
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
GoTo RetryStart
Else
Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
End If
Log(ex, $"下载图片失败", LogLevel.Hint)
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
@@ -197,7 +197,7 @@ Public Class MyListItem
Return _Info
End Get
Set(value As String)
If _Info = value Then Exit Property
If _Info = value Then Return
value = value.Replace(vbCr, "").Replace(vbLf, "")
_Info = value
LabInfo.Text = value
@@ -212,7 +212,7 @@ Public Class MyListItem
Return _Logo
End Get
Set(value As String)
If _Logo = value Then Exit Property
If _Logo = value Then Return
_Logo = value
'删除旧 Logo
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
@@ -297,7 +297,7 @@ Public Class MyListItem
Return _Type
End Get
Set(value As CheckType)
If _Type = value Then Exit Property
If _Type = value Then Return
_Type = value
'切换左栏大小
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
@@ -345,7 +345,7 @@ Public Class MyListItem
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False, value <> _Checked) '仅在值发生变化时触发动画 (#4596)
End Set
End Property
''' <summary>
@@ -367,31 +367,31 @@ Public Class MyListItem
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
Return
End If
End If
_Checked = value
Else
If value = _Checked Then Exit Sub
If value = _Checked Then Return
_Checked = value
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
Return
End If
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(user)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Sub
If CheckEventArgs.Handled Then Return
End If
'保证只有一个单选 ListItem 选中
If Type = CheckType.RadioBox Then
If IsNothing(Parent) Then Exit Sub
If IsNothing(Parent) Then Return
Dim RadioboxList As New List(Of MyListItem)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -502,15 +502,15 @@ Public Class MyListItem
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
If e.Handled Then Return
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
e.Handled = True
End If
If e.Handled Then Exit Sub
If e.Handled Then Return
'实际的单击处理
Select Case Type
Case CheckType.Clickable
@@ -593,7 +593,7 @@ Public Class MyListItem
Time = 180
End If
End If
If StateLast = StateNew Then Exit Sub
If StateLast = StateNew Then Return
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -35,7 +35,7 @@ Public Class MyLoading
Return _ShowProgress
End Get
Set(value As Boolean)
If _ShowProgress = value Then Exit Property
If _ShowProgress = value Then Return
_ShowProgress = value
RefreshText()
End Set
@@ -79,11 +79,7 @@ Public Class MyLoading
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = StrTrim(Ex.Message)
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
LabText.Text = "网络环境不佳,请重试或尝试使用 VPN"
End If
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
End If
Else
LabText.Text = TextError
@@ -142,7 +138,7 @@ Public Class MyLoading
Return _OuterState
End Get
Set(value As MyLoadingState)
If _OuterState = value Then Exit Property
If _OuterState = value Then Return
Dim OldValue = _OuterState
_OuterState = value
'引发事件
@@ -159,7 +155,7 @@ Public Class MyLoading
Return _InnerState
End Get
Set(value As MyLoadingState)
If _InnerState = value Then Exit Property
If _InnerState = value Then Return
Dim OldValue = _InnerState
_InnerState = value
'引发事件
@@ -183,7 +179,7 @@ Public Class MyLoading
Private IsLooping As Boolean = False
Private Sub AniLoop()
'这坨循环代码也是老屎坑了,救救.jpg
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Return
IsLooping = True
ErrorAnimationWaiting = True
AniStart({
@@ -271,7 +267,7 @@ Public Class MyLoadingStateSimulator
Return _LoadingState
End Get
Set(value As MyLoadingState)
If _LoadingState = value Then Exit Property
If _LoadingState = value Then Return
Dim OldState = _LoadingState
_LoadingState = value
RaiseEvent LoadingStateChanged(value, OldState)
@@ -37,7 +37,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = BackName Then Exit Sub
If ColorName = BackName Then Return
ColorName = BackName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -72,13 +72,14 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub
TextArea.Validate() '#5773
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Return
MyConverter.IsExited = True
MyConverter.Result = TextArea.Text
Close()
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
@@ -77,13 +77,13 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Return
MyConverter.IsExited = True
MyConverter.Result = SelectedIndex
Close()
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
@@ -70,7 +70,7 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button1Action IsNot Nothing Then
MyConverter.Button1Action()
Else
@@ -80,7 +80,7 @@
End If
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button2Action IsNot Nothing Then
MyConverter.Button2Action()
Else
@@ -90,7 +90,7 @@
End If
End Sub
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button3Action IsNot Nothing Then
MyConverter.Button3Action()
Else
+16 -19
View File
@@ -3,15 +3,15 @@
Private Uuid As Integer = GetUuid()
'执行逐个进入动画的控件
Public Property AnimatedControl As FrameworkElement
Public Property AnimatedControl As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
Get
Return GetValue(AnimatedControlProperty)
End Get
Set(value As FrameworkElement)
Set(value As String)
SetValue(AnimatedControlProperty, value)
End Set
End Property
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing))
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing))
Public Sub TriggerShowAnimation()
If AnimatedControl Is Nothing Then
@@ -39,16 +39,17 @@
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
AniList.Add(AaCode(
Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Delay += Math.Max(15 - Id, 7) * 2
Id += 1
End If
Next
@@ -63,8 +64,8 @@
RenderTransformOrigin = New Point(0.5, 0.5)
End If
AniStart({
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 130,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 100, 30)
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 110,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 80, 30)
}, "PageLeft PageChange " & Uuid)
Else
'逐个退出动画
@@ -72,8 +73,8 @@
Dim Id As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
AniList.Add(AaOpacity(Element, -Element.Opacity, 60, 80 / Controls.Count * Id))
AniList.Add(AaTranslateX(Element, -6, 60, 80 / Controls.Count * Id))
AniList.Add(AaOpacity(Element, -Element.Opacity, 50, 70 / Controls.Count * Id))
AniList.Add(AaTranslateX(Element, -6, 50, 70 / Controls.Count * Id))
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
@@ -83,11 +84,11 @@
'遍历获取所有需要生成动画的控件
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
GetAllAnimControls(FindName(AnimatedControl), AllControls, IgnoreInvisibility)
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
If TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is MyListItem Then
@@ -104,7 +105,3 @@
End Sub
End Class
Public Interface IRefreshable
Sub Refresh()
End Interface
+14 -14
View File
@@ -3,16 +3,16 @@
Public PageUuid As Integer = GetUuid()
'“返回顶部” 按钮检测的滚动区域
Public Property PanScroll As MyScrollViewer
Public Property PanScroll As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
Get
Return GetValue(PanScrollProperty)
End Get
Set(value As MyScrollViewer)
Set(value As String)
SetValue(PanScrollProperty, value)
End Set
End Property
Private Shared ReadOnly PanScrollProperty =
DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing))
DependencyProperty.Register("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing))
'当前状态
Public Enum PageStates
@@ -33,7 +33,7 @@
Return _PageState
End Get
Set(value As PageStates)
If _PageState = value Then Exit Property
If _PageState = value Then Return
_PageState = value
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
End Set
@@ -106,7 +106,7 @@
End Sub
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If Not PageLoaderAutoRun Then Return
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
@@ -187,7 +187,7 @@
''' 需要立即切换至 Empty。
''' </summary>
Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Exit Sub
If PageState = PageStates.Empty Then Return
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid)
@@ -302,7 +302,7 @@
Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Failed, LoadState.Loading
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Exit Sub
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
'(重新)开始运行
'需要从部分状态切换到 ReloadExit
@@ -314,7 +314,7 @@
PageState = PageStates.ContentExit
End Select
Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Exit Sub
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
'运行结束
'需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
@@ -358,10 +358,10 @@
Else
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaOpacity(Control, 1, 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
Delay += 40
Delay += 25
End If
Next
Next
@@ -387,9 +387,9 @@
CType(Control, MyExtraTextButton).Show = False
Else
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
Delay += 20
AniList.Add(AaOpacity(Control, -1, 70, Delay))
AniList.Add(AaTranslateY(Control, -6, 70, Delay))
Delay += 15
End If
Next
Next
@@ -423,7 +423,7 @@
Return AllControls.Except(DisabledPageAnimControls)
End Function
Private Sub _GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
@@ -41,7 +41,7 @@ Public Class MyRadioBox
RaiseEvent PreviewCheck(Me, e)
If e.Handled Then
Radiobox_MouseLeave()
Exit Sub
Return
End If
End If
@@ -54,7 +54,7 @@ Public Class MyRadioBox
End If
'保证只有一个单选框选中
If Parent Is Nothing Then Exit Sub
If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0
For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
@@ -172,7 +172,7 @@ Public Class MyRadioBox
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
Log("[Control] 按下单选框:" & Text)
SetChecked(True, True)
MouseDowned = False
@@ -187,7 +187,7 @@ Public Class MyRadioBox
End If
End Sub
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
@@ -224,7 +224,7 @@ Public Class MyRadioBox
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox TextColor " & Uuid)
End Sub
Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not Me.IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If IsLoaded AndAlso AniControlEnabled = 0 Then
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
@@ -62,7 +62,7 @@ Public Class MyRadioButton
'保证只有一个单选框选中
If IsNothing(Parent) Then Exit Sub
If IsNothing(Parent) Then Return
Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -101,7 +101,7 @@ Public Class MyRadioButton
'更改动画
If Not IsChanged Then Exit Sub
If Not IsChanged Then Return
RefreshColor(Nothing, anime)
'触发事件
@@ -147,17 +147,17 @@ Public Class MyRadioButton
Public Event PreviewClick(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Exit Sub
If Not IsMouseDown Then Exit Sub
If Checked Then Return
If Not IsMouseDown Then Return
Log("[Control] 按下单选按钮:" & Text)
IsMouseDown = False
Dim e As New RouteEventArgs(True)
RaiseEvent PreviewClick(Me, e)
If e.Handled Then Exit Sub
If e.Handled Then Return
SetChecked(True, True, True)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
If Checked Then Exit Sub
If Checked Then Return
IsMouseDown = True
RefreshColor()
End Sub
+2 -2
View File
@@ -301,7 +301,7 @@ Public Class MyResizer
End Sub
Private Sub updateMouseDown()
Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released
Dim flag = (GetAsyncKeyState(&H1) And &H8000) = 0 '调用原生API判断鼠标是否抬起,如果使用WPF的API的话鼠标不在窗口上时不会更新状态 (#5655)
If flag Then
resizeRight = False
resizeLeft = False
@@ -311,5 +311,5 @@ Public Class MyResizer
End Sub
Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
Private Declare Function GetAsyncKeyState Lib "user32.dll" (vKey As Integer) As Short
End Class
@@ -6,16 +6,15 @@
Private RealOffset As Double
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
TypeOf e.Source Is CheckBox) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
Return
End If
e.Handled = True
PerformVerticalOffsetDelta(-e.Delta)
@@ -14,7 +14,7 @@
Return _MaxValue
End Get
Set(value As Integer)
If value = _MaxValue Then Exit Property
If value = _MaxValue Then Return
_MaxValue = value
RefreshWidth(Nothing, Nothing)
End Set
@@ -29,7 +29,7 @@
Try
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
If _Value = newValue Then Return
'触发 Preview 事件,修改新值
Dim OldValue = _Value
@@ -40,12 +40,12 @@
If e.Handled Then
_Value = OldValue
DragStop()
Exit Property
Return
End If
End If
If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualWidth < ShapeDot.Width Then Exit Property
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)
@@ -103,7 +103,7 @@
Popup.IsOpen = False
End Sub
Public Sub RefreshPopup()
If GetHintText Is Nothing Then Exit Sub
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)
@@ -165,7 +165,7 @@
End Sub
Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
'拒绝一边拖动一边用按键改变
If ReferenceEquals(Me, DragControl) Then Exit Sub
If ReferenceEquals(Me, DragControl) Then Return
'改变值
If e.Key = Key.Left Then
ChangeByKey = True
@@ -178,7 +178,7 @@
ChangeByKey = False
e.Handled = True
Else
Exit Sub
Return
End If
'更新 Popup
If GetHintText IsNot Nothing Then
+6 -6
View File
@@ -36,7 +36,7 @@
End Property
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If HintText = "" OrElse labHint.Text <> "" Then Exit Sub
If HintText = "" OrElse labHint.Text <> "" Then Return
labHint.Text = If(Text = "", HintText, "")
End Sub
@@ -217,11 +217,11 @@
IsTextChanged = IsLoaded
'进行输入验证
Validate()
If Not IsValidated Then Exit Sub
If Not IsValidated Then Return
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", LogLevel.Assert)
Log(ex, "进行输入验证时出错", LogLevel.Critical)
End Try
End Sub
@@ -230,7 +230,7 @@
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
Try
'不对 ComboBox 从属进行动画
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Return
'判断当前颜色
Dim ForeColorName As String, BackColorName As String
Dim AnimationTime As Integer
@@ -264,7 +264,7 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
AaColor(Me, BackgroundProperty, BackColorName, AnimationTime)
}, "MyTextBox Color " & Uuid)
Else
@@ -280,7 +280,7 @@
End Sub
Private Sub RefreshTextColor() Handles Me.IsEnabledChanged
Dim NewColor As MyColor = If(IsEnabled, ColorGray1, ColorGray4)
If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Exit Sub
If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Return
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then
'有动画
AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid)
@@ -57,7 +57,7 @@
Private Const AnimationTimeIn As Integer = 100
Private Const AnimationTimeOut As Integer = 200
Private ColorName As String
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'判断当前颜色
Dim ForeName As String
Dim Time As Integer
@@ -72,7 +72,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = ForeName Then Exit Sub
If ColorName = ForeName Then Return
ColorName = ForeName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画