2.14.0.0

2026-10-17 03:39:13 +08:00
parent 9dcb799fb0
commit ade6e04c6e
65 changed files with 6989 additions and 2643 deletions
@@ -44,8 +44,8 @@ Namespace Controls.Behaviors

        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))
+            tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutTextBox, AddressOf CanEditTextBox))
+            tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteTextBox, AddressOf CanEditTextBox))
        End Sub

        Private Shared Sub AddCommandBindingsToRichTextBox(rtb As RichTextBox)
@@ -58,42 +58,61 @@ Namespace Controls.Behaviors
            dg.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyDataGrid))
        End Sub

+        Private Shared Sub SetClipboardText(text As String)
+            Forms.Clipboard.SetDataObject(text, False, retryTimes:=10, retryDelay:=100) '实际的复制
+            Try
+                System.Windows.Clipboard.Flush() '将数据持久化到系统剪贴板，避免应用程序退出后数据丢失
+            Catch ex As Exception '持久化失败不抛出异常
+                Logger.Warn(ex, $"剪贴板持久化失败（错误码：0x{ex.HResult:X8}）")
+            End Try
+        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)
+                SetClipboardText(tb.SelectedText)
            Catch ex As Exception
-                Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"复制失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
            End Try

            e.Handled = True
        End Sub

+        Private Shared Sub CanEditTextBox(sender As Object, e As CanExecuteRoutedEventArgs)
+            Dim tb = TryCast(sender, TextBox)
+            e.CanExecute = tb IsNot Nothing AndAlso Not tb.IsReadOnly AndAlso
+                (e.Command IsNot ApplicationCommands.Cut OrElse tb.SelectionLength > 0)
+            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
+            e.Handled = True
+            If tb Is Nothing OrElse tb.IsReadOnly OrElse tb.SelectionLength <= 0 Then Return

            Try
-                Forms.Clipboard.Clear()
-                Forms.Clipboard.SetDataObject(tb.SelectedText, True)
+                SetClipboardText(tb.SelectedText)
            Catch ex As Exception
-                Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"剪切失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
+                Return
            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
+            e.Handled = True
+            If tb Is Nothing OrElse tb.IsReadOnly Then Return

            Try
-                If Forms.Clipboard.ContainsText() Then
-                    Dim pasteText = Forms.Clipboard.GetText()
+                Dim pasteText = Retrier.Attempt(func:=
+                Function(Attempt) As String
+                    Return If(Forms.Clipboard.ContainsText(), Forms.Clipboard.GetText(), Nothing)
+                End Function, maxAttempts:=10, delay:=Function() TimeSpan.FromMilliseconds(100))
+                If pasteText IsNot Nothing Then

                    '将换行符替换为空格（#7825）
                    If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
@@ -105,10 +124,8 @@ Namespace Controls.Behaviors
                    tb.SelectionLength = 0
                End If
            Catch ex As Exception
-                Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"粘贴失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
            End Try
-
-            e.Handled = True
        End Sub

        Private Shared Sub OnCopyRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
@@ -119,10 +136,9 @@ Namespace Controls.Behaviors
            If String.IsNullOrEmpty(textRange.Text) Then Return

            Try
-                Forms.Clipboard.Clear()
-                Forms.Clipboard.SetDataObject(textRange.Text, True)
+                SetClipboardText(textRange.Text)
            Catch ex As Exception
-                Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"复制失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
            End Try

            e.Handled = True
@@ -134,16 +150,16 @@ Namespace Controls.Behaviors

            Dim selection = New TextRange(rtb.Selection.Start, rtb.Selection.End)
            If String.IsNullOrEmpty(selection.Text) Then Return
+            e.Handled = True

            Try
-                Forms.Clipboard.Clear()
-                Forms.Clipboard.SetDataObject(selection.Text, True)
+                SetClipboardText(selection.Text)
            Catch ex As Exception
-                Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"剪切失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
+                Return
            End Try

            selection.Text = String.Empty
-            e.Handled = True
        End Sub

        Private Shared Sub OnPasteRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
@@ -151,9 +167,11 @@ Namespace Controls.Behaviors
            If rtb Is Nothing Then Return

            Try
-                If Not Forms.Clipboard.ContainsText() Then Return
-
-                Dim pasteText = Forms.Clipboard.GetText()
+                Dim pasteText = Retrier.Attempt(func:=
+                Function(Attempt) As String
+                    Return If(Forms.Clipboard.ContainsText(), Forms.Clipboard.GetText(), Nothing)
+                End Function, maxAttempts:=2, delay:=Function() TimeSpan.FromMilliseconds(200))
+                If pasteText Is Nothing Then Return
                Dim selection = rtb.Selection

                selection.Text = pasteText
@@ -162,7 +180,7 @@ Namespace Controls.Behaviors
                rtb.CaretPosition = caretPos
                rtb.Selection.Select(caretPos, caretPos)
            Catch ex As Exception
-                Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"粘贴失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
            End Try

            e.Handled = True
@@ -187,10 +205,9 @@ Namespace Controls.Behaviors
            Dim sbStr = sb.ToString().TrimEnd(ControlChars.Cr, ControlChars.Lf)

            Try
-                Forms.Clipboard.Clear()
-                Forms.Clipboard.SetDataObject(sbStr, True)
+                SetClipboardText(sbStr)
            Catch ex As Exception
-                Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
+                Logger.Warn(ex, $"复制失败，请稍后再试（错误码：0x{ex.HResult:X8}）", LogBehavior.Toast)
            End Try

            e.Handled = True
@@ -102,73 +102,36 @@ Public Class MyCard
            RunInUi(Sub() UseAnimation = RawUseAnimation, True)
        End If
    End Sub
-    Public Sub StackInstall()
-        StackInstall(SwapControl, SwapType, Title)
-        TriggerForceResize()
+
+    '填充
+    Private ContentBuilder As Action(Of Panel)
+    Public Sub SetContentBuilder(Builder As Action(Of Panel))
+        ContentBuilder = Builder
    End Sub
-    Public Shared Sub StackInstall(ByRef Stack As StackPanel, Type As Integer, Optional CardTitle As String = "")
-        '这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎
-        '但是现在……反正勉强能用……懒得改了就这样吧.jpg
-        '别骂了别骂了.jpg
-        If Stack.Tag Is Nothing Then Return
-        '排序
-        Dim HasDuplicates As Boolean = False
-        Select Case Type
-            Case 3
-                Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.DisplayName, b.DisplayName))
-            Case 4, 10
-                Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.Inherit, b.Inherit))
-            Case 6
-                Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
-            Case 8, 9
-                Stack.Tag = CType(Stack.Tag, List(Of ResourceVersion)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
-                HasDuplicates =
-                    CType(Stack.Tag, List(Of ResourceVersion)).DistinctBy(Function(a) a.Display).Count <>
-                    CType(Stack.Tag, List(Of ResourceVersion)).Count
-        End Select
-        '控件转换
-        Select Case Type
-            Case 6
-                ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
-            Case 8
-                PageDownloadResourceDetail.ResourceFilesCardPreload(Stack, Stack.Tag)
-        End Select
-        '实现控件虚拟化
-        For Each Data As Object In Stack.Tag
-            Select Case Type
-                Case 0
-                    Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
-                Case 2
-                    Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
-                Case 3
-                    Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
-                Case 6
-                    Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
-                Case 7
-                    '不能使用 AddressOf，这导致了 #535，原因完全不明，疑似是编译器 Bug
-                    Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
-                Case 8
-                    '若存在重复的版本名，则显示文件名而非版本名（#1344）
-                    Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
-                        AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
-                Case 9
-                    '若存在重复的版本名，则显示文件名而非版本名（#1344）
-                    Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
-                        AddressOf FrmDownloadResourceDetail.Install_Click, AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
-                Case 10
-                    Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
-                Case 11
-                    Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
-                Case 12
-                    Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected))
-                Case 13
-                    Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
-                Case Else
-                    Logger.Error($"未知的虚拟化种类：{Type}")
-            End Select
-        Next
-        Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠
-        Stack.Tag = Nothing
+    Public Sub SetContentBuilder(Of T)(Items As IEnumerable(Of T), ItemBuilder As Func(Of T, UIElement))
+        SetContentBuilder(
+        Sub(Stack)
+            For Each Item In Items
+                Stack.Children.Add(ItemBuilder(Item))
+            Next
+            Stack.Children.Add(New FrameworkElement With {.Height = 18})
+        End Sub)
+    End Sub
+    ''' <summary>
+    ''' 使用 ContentBuilder 生成卡片内容。
+    ''' </summary>
+    Public Sub BuildContent()
+        If ContentBuilder Is Nothing Then Return
+        Dim Stack = TryCast(SwapControl, Panel)
+        If Stack Is Nothing Then Return
+        Try
+            ContentBuilder(Stack)
+            ContentBuilder = Nothing
+        Catch
+            Stack.Children.Clear()
+            Throw
+        End Try
+        TriggerForceResize()
    End Sub

    '动画
@@ -278,10 +241,6 @@ Public Class MyCard
    Public SwapControl As FrameworkElement
    Public Property CanSwap As Boolean = False
    ''' <summary>
-    ''' 被折叠的种类，用于控件虚拟化。
-    ''' </summary>
-    Public Property SwapType As Integer
-    ''' <summary>
    ''' 是否已被折叠。
    ''' </summary>
    Public Property IsSwapped As Boolean
@@ -293,7 +252,7 @@ Public Class MyCard
            _IsSwapped = value
            If SwapControl Is Nothing Then Return
            '展开
-            If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
+            If Not IsSwapped Then BuildContent()
            '若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
            If Not IsLoaded Then Return
            '更新样式
@@ -397,4 +356,4 @@ Partial Public Module ModAnimation
            If CallBack IsNot Nothing Then CallBack(Control)
        End If
    End Sub
-End Module
+End Module
@@ -90,7 +90,7 @@ Public Class MyImage
            Catch ex As Exception
                Logger.Warn(ex, $"加载图片失败（{value}）")
                Try
-                    If value.StartsWithF(PathTemp) Then FileUtils.Delete(value)
+                    If value.StartsWithF(PathTemp, True) Then FileUtils.Delete(value)
                Catch
                End Try
            End Try