This commit is contained in:
龙腾猫跃
2023-12-18 04:56:23 +08:00
parent c98e0367d0
commit 6705444fb4
33 changed files with 490 additions and 376 deletions
+1 -1
View File
@@ -293,7 +293,7 @@
<!-- 由于未知原因,TextView 会有 2,0 的 Margin -->
</Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.3" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.25" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid>
+2 -2
View File
@@ -209,7 +209,7 @@
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
'高度增加较大,使用弹起动画
Dim Delta As Double = MathRange(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
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))
@@ -217,7 +217,7 @@
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathRange(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
End If
AnimList.Add(AaCode(Sub()
@@ -6,6 +6,8 @@
Dim IconControl As Shapes.Path = GetTemplateChild("Icon")
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If
'对父级设置透明度
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
End Sub
'基础
@@ -24,7 +24,7 @@
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double)
RealOffset = MathRange(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
End Sub
@@ -28,7 +28,7 @@
Set(newValue As Integer)
Try
newValue = MathRange(newValue, 0, MaxValue)
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
'触发 Preview 事件,修改新值
@@ -88,7 +88,7 @@
AniStop("MySlider KeyPopup " & Uuid)
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
+4 -1
View File
@@ -4,7 +4,10 @@
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher " AllowsTransparency="True" MinHeight="470" MinWidth="810" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher " AllowsTransparency="True" MinHeight="470" MinWidth="810"
ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None"
ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500"
RenderTransformOrigin="0.5,0.5">
<Window.TaskbarItemInfo>
<TaskbarItemInfo ThumbnailClipMargin="{Binding Margin, ElementName=PanForm}" />
</Window.TaskbarItemInfo>
+46 -17
View File
@@ -11,6 +11,14 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 311 Then 'Release 2.6.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 27
BugCount += 25
End If
If LastVersion < 308 Then 'Release 2.6.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
@@ -135,7 +143,13 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 307 Then 'Snapshot 2.6.11
If LastVersion < 310 Then 'Snapshot 2.6.12
If LastVersion = 309 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理页面添加启用、禁用单个 Mod 的快捷按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 13
BugCount += 12
End If
If LastVersion < 309 Then 'Snapshot 2.6.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
@@ -399,7 +413,7 @@ Public Class FormMain
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
#End If
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会造成性能的下降,若无必要请不要开启!")
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会导致性能下降,若无必要请不要开启!")
'尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
@@ -466,8 +480,8 @@ Public Class FormMain
End Sub, , True)
}, "Form Show")
'Timer 启动
AniStartRun()
TimerMainStartRun()
AniStart()
TimerMainStart()
'加载池
RunInNewThread(Sub()
'EULA 提示
@@ -855,6 +869,11 @@ Public Class FormMain
'正在主页,需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False)
End If
ElseIf Str.StartsWith("file:///") Then
'文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True
FileDrag(New List(Of String) From {FilePath})
End If
Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
@@ -867,29 +886,38 @@ Public Class FormMain
Hint("请将文件解压后再拖入!", HintType.Critical)
Exit Sub
End If
Dim FilePathList As New List(Of String)(CType(FilePathRaw, IEnumerable(Of String)))
e.Handled = True
FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If
Catch ex As Exception
Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
End Try
End Sub
Private Sub FileDrag(FilePathList As IEnumerable(Of String))
RunInNewThread(
Sub()
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Exit Sub
ElseIf Not File.Exists(FilePathList.First) Then
Hint("拖入的文件不存在:" & FilePathList.First, HintType.Critical)
Exit Sub
End If
'多文件拖拽
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
Dim Extension As String = File.Split(".").Last.ToLower
If Not {"jar", "litemod", "disabled"}.Contains(Extension) Then
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.Split(".").Last.ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub
End If
Next
End If
'实际执行事件
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath, LogLevel.Developer)
RunInNewThread(Sub()
Dim Extension As String = FilePath.Split(".").Last.ToLower
'自定义主页
Dim Extension As String = FilePath.Split(".").Last.ToLower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
@@ -906,7 +934,7 @@ Public Class FormMain
Exit Sub
End If
'Mod 安装
If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then
If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
@@ -964,10 +992,6 @@ Install:
'未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……")
End Sub, "文件拖拽")
End If
Catch ex As Exception
Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
End Try
End Sub
'接受到 Windows 窗体事件
@@ -1170,6 +1194,10 @@ Install:
''' </summary>
Public PageCurrent As PageStackData = PageType.Launch
''' <summary>
''' 上一个主页面。
''' </summary>
Public PageLast As PageStackData = PageType.Launch
''' <summary>
''' 当前的子页面。
''' </summary>
Public ReadOnly Property PageCurrentSub As PageSubType
@@ -1347,6 +1375,7 @@ Install:
#End Region
#Region "实际更改页面框架 UI"
PageLast = PageCurrent
PageCurrent = Stack
Select Case Stack.Page
Case PageType.Launch '启动
Binary file not shown.

Before

Width:  |  Height:  |  Size: 701 B

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 982 B

After

Width:  |  Height:  |  Size: 2.2 KiB

@@ -577,10 +577,10 @@ Public Module ModAnimation
Public Class AniEaseLinear
Inherits AniEase
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1)
Return MathClamp(t, 0, 1)
End Function
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
Return MathRange(t1, 0, 1) - MathRange(t0, 0, 1)
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
End Function
End Class
@@ -595,7 +595,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1) ^ p
Return MathClamp(t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -608,7 +608,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return 1 - MathRange(1 - t, 0, 1) ^ p
Return 1 - MathClamp(1 - t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -636,7 +636,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
End Function
End Class
@@ -650,7 +650,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
End Function
End Class
@@ -694,7 +694,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -708,7 +708,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = 1 - MathRange(t, 0, 1)
t = 1 - MathClamp(t, 0, 1)
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -766,7 +766,7 @@ Public Module ModAnimation
''' <summary>
''' 开始动画执行。
''' </summary>
Public Sub AniStartRun()
Public Sub AniStart()
'初始化计时器
AniLastTick = GetTimeTick()
AniFPSTimer = AniLastTick
@@ -777,12 +777,12 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathRange(GetTimeTick() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathRange(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -904,7 +904,7 @@ NextAni:
Case AniTypeSub.Y
DeltaTop(Ani.Obj, Delta)
Case AniTypeSub.Opacity
Ani.Obj.Opacity = MathRange(Ani.Obj.Opacity + Delta, 0, 1)
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
Case AniTypeSub.Width
Dim Obj As FrameworkElement = Ani.Obj
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
+12 -11
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.11" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.11." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.6.12" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.12." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 308 'Release
#Else
Public Const VersionCode As Integer = 309 'Snapshot
Public Const VersionCode As Integer = 310 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -46,7 +46,7 @@ Public Module ModBase
''' <summary>
''' 程序内嵌图片文件夹路径,以“/”结尾。
''' </summary>
Public PathImage As String = "pack://application:,,,/images/"
Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
''' <summary>
''' 当前程序的语言。
''' </summary>
@@ -521,7 +521,6 @@ Public Module ModBase
''' 获取两数间的百分比。小数点精确到 6 位。
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double
Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误
End Function
@@ -535,7 +534,7 @@ Public Module ModBase
''' <summary>
''' 将数值限定在某个范围内。
''' </summary>
Public Function MathRange(value As Double, min As Double, max As Double) As Double
Public Function MathClamp(value As Double, min As Double, max As Double) As Double
Return Math.Max(min, Math.Min(max, value))
End Function
@@ -1325,8 +1324,10 @@ Re:
''' <summary>
''' 遍历文件夹中的所有文件。
''' </summary>
Public Function EnumerateFiles(Directory As String) As List(Of FileInfo)
Return New DirectoryInfo(Directory).EnumerateFiles("*", SearchOption.AllDirectories).ToList
Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
Dim Info As New DirectoryInfo(Directory)
If Not Info.Exists Then Return New List(Of FileInfo)
Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
End Function
#End Region
@@ -1456,15 +1457,15 @@ Re:
ElseIf FileSize < 1024 * 1000 Then
'K 级
Dim RoundResult As String = Math.Round(FileSize / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " K"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " K"
ElseIf FileSize < 1024 * 1024 * 1000 Then
'M 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " M"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " M"
Else
'G 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " G"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " G"
End If
End Function
@@ -634,7 +634,7 @@ Restart:
Next
End SyncLock
If Count = 0 Then Return 1
Return MathRange(Total / Count, 0, 1)
Return MathClamp(Total / Count, 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
@@ -1206,7 +1206,7 @@ SourceBreak:
Info.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
(Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
@@ -1862,9 +1862,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
@@ -1919,9 +1919,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
@@ -54,6 +54,7 @@ Public Class MyBitmap
End Sub
Public Sub New(FilePathOrResourceName As String)
Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
@@ -536,7 +536,7 @@
End Function
Public Function GetControlLogo() As String
If LogoUrl Is Nothing Then
Return "pack://application:,,,/images/Icons/NoIcon.png"
Return PathImage & "Icons/NoIcon.png"
Else
Return LogoUrl
End If
@@ -1279,13 +1279,13 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
@@ -1332,11 +1332,11 @@ Retry:
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
@@ -716,23 +716,23 @@ ExitDataLoad:
If Logo = "" OrElse Not CType(ReadIni(Path & "PCL\Setup.ini", "LogoCustom", False), Boolean) Then
Select Case State
Case McVersionState.Original
Logo = "pack://application:,,,/images/Blocks/Grass.png"
Logo = PathImage & "Blocks/Grass.png"
Case McVersionState.Snapshot
Logo = "pack://application:,,,/images/Blocks/CommandBlock.png"
Logo = PathImage & "Blocks/CommandBlock.png"
Case McVersionState.Old
Logo = "pack://application:,,,/images/Blocks/CobbleStone.png"
Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge
Logo = "pack://application:,,,/images/Blocks/Anvil.png"
Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.Fabric
Logo = "pack://application:,,,/images/Blocks/Fabric.png"
Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine
Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
Logo = PathImage & "Blocks/GrassPath.png"
Case McVersionState.LiteLoader
Logo = "pack://application:,,,/images/Blocks/Egg.png"
Logo = PathImage & "Blocks/Egg.png"
Case McVersionState.Fool
Logo = "pack://application:,,,/images/Blocks/GoldBlock.png"
Logo = PathImage & "Blocks/GoldBlock.png"
Case Else
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
Logo = PathImage & "Blocks/RedstoneBlock.png"
End Select
End If
'确定版本描述
@@ -791,7 +791,7 @@ ExitDataLoad:
End If
Catch ex As Exception
Info = "未知错误:" & GetExceptionSummary(ex)
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
Logo = PathImage & "Blocks/RedstoneBlock.png"
State = McVersionState.Error
Log(ex, "加载版本失败(" & Name & ")", LogLevel.Feedback)
Finally
@@ -24,11 +24,11 @@ Public Module ModMod
End Property
''' <summary>
''' Mod 的完整文件名,去除最后的 .disabled。
''' Mod 的完整文件名,去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawFileName As String
Get
Return FileName.Replace(".disabled", "")
Return FileName.Replace(".disabled", "").Replace(".old", "")
End Get
End Property
@@ -40,7 +40,7 @@ Public Module ModMod
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
ElseIf Path.EndsWith(".disabled") Then
ElseIf Path.EndsWith(".disabled") OrElse Path.EndsWith(".old") Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -365,6 +365,56 @@ Public Module ModMod
Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
@@ -467,56 +517,6 @@ Public Module ModMod
Log(ex, "读取 mods.toml 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
@@ -774,7 +774,7 @@ VersionFindFail:
''' 是否可能为前置 Mod。
''' </summary>
Public Function IsPresetMod() As Boolean
Return Dependencies.Count = 0 AndAlso (Name IsNot Nothing) AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
Return Dependencies.Count = 0 AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
End Function
''' <summary>
@@ -784,7 +784,8 @@ VersionFindFail:
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") Then Return True
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True
Return False
End Function
@@ -920,18 +921,19 @@ VersionFindFail:
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthUpdate.Count = 0 Then Exit Sub
Dim ModrinthMapping As New Dictionary(Of String, McMod)
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each ModEntity In Mods
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Else
ModrinthMapping.Add(ProjectId, ModEntity)
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(ModEntity)
End If
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
@@ -939,13 +941,14 @@ VersionFindFail:
"GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
Dim Entry = ModrinthMapping(Project.Id)
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
Entry.Comp = Project
Next
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
@@ -968,17 +971,20 @@ VersionFindFail:
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If CurseForgeRaw.Count = 0 Then Exit Sub
Dim CurseForgeMapping As New Dictionary(Of Integer, McMod)
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
Dim ModEntity = Mods.Find(Function(m) m.CurseForgeHash = Hash)
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Entry.Comp = CompProjectCache(ProjectId)
Else
CurseForgeMapping.Add(ProjectId, ModEntity)
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
End If
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
@@ -987,7 +993,7 @@ VersionFindFail:
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
For Each ProjectJson In CurseForgeProject
Dim Project As New CompProject(ProjectJson)
Dim Entry = CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
@@ -996,6 +1002,7 @@ VersionFindFail:
Entry.IsCompFromModrinth = False
Entry.Comp = Project
Next
Next
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
@@ -20,9 +20,9 @@
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -77,7 +77,7 @@ RetryStart:
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
@@ -172,19 +172,24 @@ RetryStart:
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String, TargetLoader As CompModLoaderType
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
If CType(sender.Tag, CompProject).Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
End Sub
@@ -28,7 +28,7 @@
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Foreground="{Binding Foreground, ElementName=PanBack}" />
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
@@ -22,9 +22,9 @@ Public Class MyLocalModItem
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -79,7 +79,7 @@ RetryStart:
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
@@ -93,9 +93,12 @@ RetryStart:
Set(value As String)
Dim RawValue = value
Select Case Entry.State
Case McMod.McModState.Fine
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
value &= " [禁用]"
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavaliable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Exit Property
@@ -154,17 +157,6 @@ RetryStart:
End Set
End Property
'前景色绑定
Public Property Foreground As Brush
Get
Return GetValue(ForegroundProperty)
End Get
Set(value As Brush)
SetValue(ForegroundProperty, value)
End Set
End Property
Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(Brush), GetType(MyLocalModItem), New PropertyMetadata(CType(Color1, SolidColorBrush)))
#End Region
#Region "点击与勾选"
@@ -229,13 +221,13 @@ RetryStart:
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush2", 200))
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"), 200))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush1", 120))
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(LabTitle.TextDecorations Is Nothing, "ColorBrush1", "ColorBrushGray4"), 120))
End If
AniStart(Anim, "MyLocalModItem Checked " & Uuid)
Else
@@ -245,23 +237,19 @@ RetryStart:
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
Foreground = CType(FindResource("ColorBrush2"), SolidColorBrush)
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
Foreground = CType(FindResource("ColorBrush1"), SolidColorBrush)
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Set
End Property
Private Sub ColorInit(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
SetResourceReference(ForegroundProperty, "ColorBrush1")
End Sub
#End Region
@@ -361,13 +349,18 @@ RetryStart:
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Substring(0, Entry.Path.Count - ".disabled".Count))
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable
NewDescription = GetFileNameFromPath(Entry.Path)
End Select
@@ -380,7 +373,7 @@ RetryStart:
End If
Description = NewDescription
'主 Logo
Logo = If(Entry.Comp Is Nothing, "pack://application:,,,/images/Icons/NoIcon.png", Entry.Comp.GetControlLogo())
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
@@ -390,7 +383,7 @@ RetryStart:
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 17, .Height = 17, .Margin = New Thickness(0, 0, -4, -3), .IsHitTestVisible = False,
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
@@ -401,7 +394,7 @@ RetryStart:
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavaliable.png" />
End If
ImgState.Source = New MyBitmap($"pack://application:,,,/images/Icons/{Entry.State}.png")
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
+4 -5
View File
@@ -22,12 +22,11 @@
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In My.Computer.FileSystem.GetFiles(Path & "PCL\Musics\", FileIO.SearchOption.SearchAllSubDirectories, "*.*")
For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Extend As String = File.Split(".").Last.ToLower
If Not (Extend = "ini" OrElse Extend = "jpg" OrElse Extend = "txt" OrElse Extend = "cfg" OrElse Extend = "lrc" OrElse Extend = "db" OrElse Extend = "png") Then
MusicAllList.Add(File)
End If
Dim Ext As String = File.Extension.ToLower
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName)
Next
End If
'打乱顺序播放
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.11.0")>
<Assembly: AssemblyFileVersion("2.6.11.0")>
<Assembly: AssemblyVersion("2.6.12.0")>
<Assembly: AssemblyFileVersion("2.6.12.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -181,13 +181,13 @@ Public Module ModDownloadLib
Dim Logo As String
Select Case Entry("type")
Case "release"
Logo = "pack://application:,,,/images/Blocks/Grass.png"
Logo = PathImage & "Blocks/Grass.png"
Case "snapshot"
Logo = "pack://application:,,,/images/Blocks/CommandBlock.png"
Logo = PathImage & "Blocks/CommandBlock.png"
Case "special"
Logo = "pack://application:,,,/images/Blocks/GoldBlock.png"
Logo = PathImage & "Blocks/GoldBlock.png"
Case Else
Logo = "pack://application:,,,/images/Blocks/CobbleStone.png"
Logo = PathImage & "Blocks/CobbleStone.png"
End Select
'建立控件
Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry}
@@ -722,7 +722,7 @@ Retry:
.Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion)),
.Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
.Logo = PathImage & "Blocks/GrassPath.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -951,7 +951,7 @@ Retry:
Dim NewItem As New MyListItem With {
.Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.IsPreview, "测试版", "稳定版") & If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime),
.Logo = "pack://application:,,,/images/Blocks/Egg.png"
.Logo = PathImage & "Blocks/Egg.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -1349,18 +1349,20 @@ Retry:
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件
Task.Progress = 0.4
Log("[Download] 需要 Mappings 下载信息,开始获取原版 Json 文件")
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt]
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0)
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings.txt")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
Log("[Download] 需要下载 Mappings:" & Address)
End If
Task.Progress = 0.8
'去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") Then
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
End If
@@ -1420,9 +1422,8 @@ Retry:
Try
Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress)
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(Info As DirectoryInfo) As String
Return Info.FullName
End Function).ToList()
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
Select(Function(i) i.FullName).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
@@ -1452,11 +1453,12 @@ Retry:
End If
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.SkipWhile(Function(Info As DirectoryInfo) As Boolean
Return OldList.Contains(Info.FullName)
End Function).ToList()
If DeltaList.Count > 1 Then '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
DeltaList = New List(Of DirectoryInfo) From {DeltaList.Where(Function(l) l.Name.Contains("forge")).First}
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
End If
If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
@@ -1580,7 +1582,7 @@ Retry:
.Info = If(Entry.ReleaseTime = "",
If(ModeDebug, "种类:" & Entry.Category & If(Entry.Branch Is Nothing, "", ",开发分支:" & Entry.Branch), ""),
"发布于 " & Entry.ReleaseTime & If(ModeDebug, ",种类:" & Entry.Category & If(Entry.Branch Is Nothing, "", ",开发分支:" & Entry.Branch), "")),
.Logo = "pack://application:,,,/images/Blocks/Anvil.png"
.Logo = PathImage & "Blocks/Anvil.png"
}
AddHandler NewItem.Click, OnClick
'建立菜单
@@ -1785,7 +1787,7 @@ Retry:
Dim NewItem As New MyListItem With {
.Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
.Logo = PathImage & "Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -1796,7 +1798,7 @@ Retry:
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
.Logo = PathImage & "Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -1807,7 +1809,7 @@ Retry:
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/OptiFabric.png"
.Logo = PathImage & "Blocks/OptiFabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
@@ -13,6 +13,12 @@
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Sub PageDownloadCompDetail_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
'Initialized 只会执行一次
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
'自动重试
@@ -55,10 +61,10 @@
TargetCard = "未知版本"
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
TargetCard = "快照版本"
ElseIf GameVersion.Split(".").Count >= 2 Then
TargetCard = GameVersion
ElseIf GameVersion.StartsWith("1.0") Then
TargetCard = "远古版本"
Else
TargetCard = "未知版本"
TargetCard = GameVersion
End If
'实际进行添加
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
@@ -33,6 +33,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -32,6 +32,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
@@ -237,7 +237,7 @@ Retry:
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom Cape", "樱花披风"}, {"CherryBlossomCape", "樱花披风"}
{"Cherry Blossom", "樱花披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -90,7 +90,7 @@ Download:
GoTo Download
Case 3 '简单主页
Log("[Page] 主页预设:简单主页")
Url = "https://cdn.wearclub.online/PCL/Custom.xaml"
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4 '历史上的今天
Log("[Page] 主页预设:历史上的今天")
@@ -196,7 +196,7 @@
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable)
Dim RamUsed As Double = RamTotal - RamAvailable
Dim RamEmpty As Double = Math.Round(MathRange(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
@@ -8,7 +8,7 @@
<Grid x:Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10,25,10" Grid.IsSharedSizeScope="True"> <!-- 若显示多选模块则为 92 -->
<local:MySearchBox Margin="0,15" HintText="搜索 Mod" x:Name="SearchBox" />
<local:MySearchBox Margin="0,15" HintText="搜索 Mod 名称 / 描述 / 标签" x:Name="SearchBox" />
<local:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage">
<Grid Margin="15,15,0,15" Height="35">
<Grid.ColumnDefinitions>
@@ -19,7 +19,7 @@
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageOpen" Grid.Column="0" MinWidth="140" Text="打开 Mod 文件夹" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnManageSelectAll" Grid.Column="1" MinWidth="140" Text="全选" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageInstall" Grid.Column="2" MinWidth="140" Text="安装 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="将 Mod 文件直接拖入 PCL 窗口即可快捷安装!" ToolTipService.InitialShowDelay="0" />
<local:MyButton x:Name="BtnManageInstall" Grid.Column="2" MinWidth="140" Text="安装 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid>
</local:MyCard>
@@ -35,7 +35,7 @@
<StackPanel Margin="20,17">
<TextBlock Margin="0,0,0,9" HorizontalAlignment="Center" Text="未找到 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Margin="10,15,10,0" Text="要安装 Mod,请直接将 Mod 文件拖入 PCL 窗口。&#xa;如果你确定你已经安装了 Mod,但仍然看到了这条提示,那么你的版本隔离设置可能有误。请尝试在启动设置中调整版本隔离选项。" TextWrapping="Wrap" />
<TextBlock Margin="10,15,10,0" Text="要安装 Mod,请直接将 Mod 文件拖入 PCL 窗口。&#xa;如果你确定你已经安装了 Mod,但仍然看到了这条提示,则是版本隔离设置有误,请在启动设置中调整版本隔离选项。" TextWrapping="Wrap" />
<local:MyButton Height="35" HorizontalAlignment="Center" x:Name="BtnHintOpen" MinWidth="140" Text="打开 Mod 文件夹" Margin="0,15,0,0" Padding="13,0" ColorType="Highlight" />
</StackPanel>
</local:MyCard>
@@ -53,7 +53,7 @@
<local:MyIconTextButton x:Name="BtnSelectEnable" Text="启用"
LogoScale="1.05" Logo="M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z" />
<local:MyIconTextButton x:Name="BtnSelectDisable" Text="禁用"
LogoScale="0.98" Logo="M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m409.6 512a404.48 404.48 0 0 1-86.528 250.88L261.12 188.928A404.48 404.48 0 0 1 512 102.4a409.6 409.6 0 0 1 409.6 409.6zM102.4 512a404.48 404.48 0 0 1 86.528-250.88L762.88 835.072A404.48 404.48 0 0 1 512 921.6a409.6 409.6 0 0 1-409.6-409.6z" />
LogoScale="1" Logo="M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z" />
<local:MyIconTextButton x:Name="BtnSelectDelete" Text="删除"
LogoScale="0.96" Logo="M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z" />
<local:MyIconTextButton x:Name="BtnSelectCancel" Text="取消选择"
@@ -5,7 +5,7 @@
Private IsLoad As Boolean = False
Public Sub PageOther_Loaded() Handles Me.Loaded
PanBack.ScrollToHome()
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1
SelectedMods.Clear()
RefreshList()
@@ -122,7 +122,26 @@
ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, AddressOf Info_Click
AddHandler sender.MouseRightButtonDown, AddressOf Info_Click
sender.Buttons = {BtnCont, BtnOpen}
Dim BtnDelete As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete, .Tag = sender}
BtnDelete.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDelete, 30)
ToolTipService.SetHorizontalOffset(BtnDelete, 2)
AddHandler BtnDelete.Click, AddressOf Delete_Click
Dim BtnED As New MyIconButton With {.LogoScale = 1.1, .Logo = If(sender.Entry.State = McMod.McModState.Fine,
"M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z",
"M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"),
.Tag = sender}
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2)
AddHandler BtnED.Click, AddressOf ED_Click
If sender.Entry.State = McMod.McModState.Unavaliable Then
sender.Buttons = {BtnCont, BtnOpen, BtnDelete}
Else
sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
End If
End Sub
#End Region
@@ -170,6 +189,13 @@
End If
End Sub
''' <summary>
''' 安装 Mod。
''' </summary>
Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click
Hint("将 Mod 文件直接拖入 PCL 窗口即可安装!")
End Sub
#End Region
#Region "选择"
@@ -304,17 +330,21 @@
#Region "下边栏"
'启用 / 禁用
Private Sub BtnSelectEorD_Click(sender As MyIconTextButton, e As RouteEventArgs) Handles BtnSelectEnable.Click, BtnSelectDisable.Click
Private Sub BtnSelectED_Click(sender As MyIconTextButton, e As RouteEventArgs) Handles BtnSelectEnable.Click, BtnSelectDisable.Click
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList(),
Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False)
End Sub
Private Sub EDMods(ModList As List(Of McMod), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True
Dim IsDisable As Boolean = sender.Equals(BtnSelectDisable)
For Each ModEntity In McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
For Each ModEntity In ModList
Dim NewPath As String = Nothing
If ModEntity.State = McMod.McModState.Fine And IsDisable Then
If ModEntity.State = McMod.McModState.Fine AndAlso Not IsEnable Then
'禁用
NewPath = ModEntity.Path & ".disabled"
ElseIf ModEntity.State = McMod.McModState.Disabled AndAlso Not IsDisable Then
ElseIf ModEntity.State = McMod.McModState.Disabled AndAlso IsEnable Then
'启用
NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count)
NewPath = ModEntity.Path.Replace(".disabled", "").Replace(".old", "")
Else
Continue For
End If
@@ -328,7 +358,7 @@
RefreshList(True)
Return
Catch ex As Exception
Log(ex, $"批量重命名 Mod 失败({If(ModEntity.Path, "null")})")
Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})")
IsSuccessful = False
End Try
'更改 Loader 和 UI 中的列表
@@ -350,19 +380,23 @@
LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly)
End If
If Not IsSuccessful Then
Hint("由于文件被占用,部分 Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
Else
ChangeAllSelected(False)
RefreshBottomBar()
End If
End Sub
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
DeleteMods(DeleteList)
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try
Dim IsSuccessful As Boolean = True
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
For Each ModEntity In DeleteList
For Each ModEntity In ModList
'删除
Try
If IsShiftPressed Then
@@ -371,13 +405,15 @@
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Catch ex As OperationCanceledException
Log(ex, "批量删除 Mod 被主动取消")
Log(ex, "删除 Mod 被主动取消")
RefreshList(True)
Return
Catch ex As Exception
Log(ex, $"批量删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
IsSuccessful = False
End Try
'取消选中
SelectedMods.Remove(ModEntity.RawFileName)
'更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity)
Dim Parent As StackPanel = If(IsSearching, PanSearchList, PanItems)
@@ -391,20 +427,35 @@
LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly)
End If
If Not IsSuccessful Then
Hint("由于文件被占用,部分 Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
ElseIf If(IsSearching, PanSearchList, PanItems).Children.Count = 0 Then
RefreshList(True)
Else
ChangeAllSelected(False)
RefreshBottomBar()
End If
If IsSuccessful Then
'显示结果提示
If Not IsSuccessful Then Exit Sub
If IsShiftPressed Then
Hint($"已彻底删除 {DeleteList.Count} 个文件!", HintType.Finish)
If ModList.Count = 1 Then
Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Finish)
Else
Hint($"已将 {DeleteList.Count} 个文件删除到回收站!", HintType.Finish)
Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Finish)
End If
Else
If ModList.Count = 1 Then
Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Finish)
Else
Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Finish)
End If
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
RefreshList(True)
Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback)
RefreshList(True)
End Try
End Sub
'取消选择
@@ -494,6 +545,16 @@
Log(ex, "打开 Mod 文件位置失败", LogLevel.Feedback)
End Try
End Sub
'删除
Public Sub Delete_Click(sender As MyIconButton, e As EventArgs)
Dim ListItem As MyLocalModItem = sender.Tag
DeleteMods({ListItem.Entry})
End Sub
'启用 / 禁用
Public Sub ED_Click(sender As MyIconButton, e As EventArgs)
Dim ListItem As MyLocalModItem = sender.Tag
EDMods(New List(Of McMod) From {ListItem.Entry}, ListItem.Entry.State = McMod.McModState.Disabled)
End Sub
#End Region
@@ -513,7 +574,9 @@
Dim SearchSource As New List(Of KeyValuePair(Of String, Double))
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Name, 1))
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.FileName, 1))
If Entry.Version IsNot Nothing Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Version, 0.2))
If Entry.Version IsNot Nothing Then
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Version, 0.2))
End If
If Entry.Description IsNot Nothing AndAlso Entry.Description <> "" Then
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Description, 0.4))
End If
@@ -521,6 +584,7 @@
If Entry.Comp.RawName <> Entry.Name Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.RawName, 1))
If Entry.Comp.TranslatedName <> Entry.Comp.RawName Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.TranslatedName, 1))
If Entry.Comp.Description <> Entry.Description Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.Description, 0.4))
SearchSource.Add(New KeyValuePair(Of String, Double)(String.Join("", Entry.Comp.Tags), 0.2))
End If
QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource})
Next
@@ -154,7 +154,7 @@
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable)
Dim RamUsed As Double = RamTotal - RamAvailable
Dim RamEmpty As Double = Math.Round(MathRange(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
Binary file not shown.