This commit is contained in:
龙腾猫跃
2025-12-27 02:48:47 +08:00
parent d6ba445e54
commit 085af160a1
78 changed files with 8426 additions and 4863 deletions
@@ -35,7 +35,7 @@ Namespace Controls.Behaviors
End Sub
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
Return CBool(element.GetValue(EnableSafeClipboardProperty))
Return element.GetValue(EnableSafeClipboardProperty)
End Function
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
@@ -97,6 +97,10 @@ Namespace Controls.Behaviors
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格(#7825)
If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
@@ -162,14 +166,15 @@ Namespace Controls.Behaviors
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 sb = New 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))
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
@@ -0,0 +1,47 @@
Public Module LazyLoadBehavior
''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
''' </summary>
<Runtime.CompilerServices.Extension()>
Public Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
obj.SetValue(IsInViewportProperty, value)
End Sub
Private ReadOnly IsInViewportProperty As DependencyProperty =
DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
Private Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
Dim Element = TryCast(d, FrameworkElement)
If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
Dim Handled As Boolean = False
Dim Handler As EventHandler =
Sub()
If Handled Then Return
'判断元素是否可见
If Element.RenderSize.Width < Double.Epsilon Then Return
If Not Element.IsVisible Then Return
'判断是否在 ScrollViewer 的可视区域内
Dim Scroll = FindParentScrollViewer(Element)
If Scroll Is Nothing Then Return
If Not New Rect(0, 0, Scroll.ViewportWidth, Scroll.ViewportHeight).IntersectsWith(
Element.TransformToAncestor(Scroll).TransformBounds(New Rect(New Point(0, 0), Element.RenderSize))) Then Return
'执行
Handled = True
CType(e.NewValue, Action).Invoke()
RemoveHandler Element.LayoutUpdated, Handler
End Sub
AddHandler Element.LayoutUpdated, Handler
End Sub
Private Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
While d IsNot Nothing
If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
d = VisualTreeHelper.GetParent(d)
End While
Return Nothing
End Function
End Module
+19 -26
View File
@@ -92,6 +92,7 @@
'改变默认的折叠
If IsSwapped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
SwapControl.Visibility = Visibility.Collapsed
'取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation
UseAnimation = False
@@ -109,17 +110,21 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Return
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)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
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)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
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)).Sort(Function(a, b) a.Version > b.Version)
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
Case 8, 9
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
HasDuplicates =
CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count
End Select
'控件转换
Select Case Type
@@ -132,9 +137,7 @@
For Each Data As Object In Stack.Tag
Select Case Type
Case 0
Dim VersionItem As MyListItem = CType(Data, McVersion).ToListItem
VersionItem.ContentHandler = AddressOf PageSelectRight.McVersionListContent
Stack.Children.Add(VersionItem)
Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3
@@ -145,23 +148,13 @@
'不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
End If
'若存在重复的版本名,则显示文件名而非版本名(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Case 9
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
End If
'若存在重复的版本名,则显示文件名而非版本名(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
@@ -268,7 +261,7 @@
Height = PreviousHeight
End Sub
''' <summary>
''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。
''' 通知 MyCard,控件内容已改变,需要中断动画并瞬间更新高度。
''' </summary>
Public Sub TriggerForceResize()
Height = If(IsSwapped, SwapedHeight, Double.NaN)
@@ -282,7 +275,7 @@
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object
Public SwapControl As FrameworkElement
Public Property CanSwap As Boolean = False
''' <summary>
''' 被折叠的种类,用于控件虚拟化。
@@ -102,7 +102,7 @@ Public Class MyHint
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)
Setup.SetSafe(RelativeSetup, True)
AniDispose(Me, False)
End Sub
+10 -18
View File
@@ -85,8 +85,8 @@
If _ActualSource = value Then Return
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap)
Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception
Log(ex, $"加载图片失败({value})")
Try
@@ -112,29 +112,24 @@
End If
'从缓存加载网络图片
Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = GetTempPath(Source) & If(EnableCache, "", GetUuid()) '不启用缓存时加上随机字符串,避免冲突
Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串,避免冲突
Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
Else
ActualSource = LoadingSource '显示加载中图片
End If
RunInNewThread(
Sub()
Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
Try
'下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
If(FallbackSource?.StartsWithF("http"), {Source, FallbackSource}, {Source}),
If(FallbackSource?.StartsWithF("http") AndAlso Source <> FallbackSource, {Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then
'保存缓存并显示
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempPath)
File.Delete(TempPath)
End If
ActualSource = TempPath
If Not EnableCache Then File.Delete(TempPath)
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
@@ -143,7 +138,7 @@
'加载本地备用图片
If IsLocalFallback Then
Try
RunInUiWait(Sub() ActualSource = FallbackSource)
ActualSource = FallbackSource
Log(ex, $"下载图片失败,使用本地备用图片({Source})")
Return
Catch exx As Exception
@@ -156,8 +151,5 @@
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class
@@ -396,6 +396,7 @@ Public Class MyListItem
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children
Control = MyVirtualizingElement.TryInit(Control)
If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
@@ -544,7 +545,7 @@ Public Class MyListItem
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'菜单虚拟化检测
If ContentHandler IsNot Nothing Then
ContentHandler(sender, e)
ContentHandler(Me, e)
ContentHandler = Nothing
End If
'判断当前颜色
@@ -21,7 +21,9 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
'添加选择控件
Btn1.IsEnabled = False
For Each Selection As IMyRadio In Converter.Content
For Each Content In Converter.Content
Content = MyVirtualizingElement.TryInit(Content)
Dim Selection As IMyRadio = Content
PanSelection.Children.Add(Selection)
AddHandler Selection.Check, AddressOf OnChecked
If TypeOf Selection Is MyListItem Then
@@ -30,6 +30,7 @@
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0
For Each Element As FrameworkElement In GetAllAnimControls(True)
Element = MyVirtualizingElement.TryInit(Element)
If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变(#2436)
Element.Opacity = 1
@@ -135,7 +135,7 @@
TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanAlways, PanLoader)
@@ -147,7 +147,7 @@
TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanLoader)
@@ -378,7 +378,7 @@
End If
'结束
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
AniStart(AniList, "PageRight PageChange " & PageUuid, True)
End Sub
'逐个退出动画
@@ -0,0 +1,70 @@
Public Class MyVirtualizingElement(Of T As FrameworkElement)
Inherits FrameworkElement
Private Initializer As Func(Of T)
Public Sub New(Initializer As Func(Of T))
Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As T
Dim Element As T = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
Public Shared Widening Operator CType(Virtualized As MyVirtualizingElement(Of T)) As T
Return Virtualized.Init()
End Operator
End Class
'非泛型形式
Public Class MyVirtualizingElement
Inherits FrameworkElement
Private Initializer As Func(Of FrameworkElement)
Public Sub New(Initializer As Func(Of FrameworkElement))
Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As FrameworkElement
Dim Element As FrameworkElement = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
''' <summary>
''' 获取实例化后的控件。
''' 如果该控件没有实例化,则会立即实例化。
''' 如果类型错误,则返回原值。
''' </summary>
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
If GetType(MyVirtualizingElement(Of )).IsInstanceOfGenericType(Element) Then
Return CType(Element, Object).Init()
ElseIf TypeOf Element Is MyVirtualizingElement Then
Return CType(Element, MyVirtualizingElement).Init()
Else
Return Element
End If
End Function
End Class