Skip to content

Commit

Permalink
Merge branch 'Hex-Dragon:main' into ModFilter
Browse files Browse the repository at this point in the history
  • Loading branch information
tangge233 authored Aug 17, 2024
2 parents 05dc7a2 + 62394e0 commit 93574f6
Show file tree
Hide file tree
Showing 37 changed files with 2,654 additions and 1,565 deletions.
2 changes: 1 addition & 1 deletion Plain Craft Launcher 2/Application.xaml.vb
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ Public Class Application
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
Expand Down
11 changes: 10 additions & 1 deletion Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画

If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
Expand Down
28 changes: 17 additions & 11 deletions Plain Craft Launcher 2/FormMain.xaml.vb
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,15 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 13
BugCount += 17
End If
If LastVersion < 331 Then 'Snapshot 2.8.3
If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
Expand Down Expand Up @@ -307,17 +316,13 @@ Public Class FormMain
RunInNewThread(
Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
OpenWebsite("https://afdian.com/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
End Sub

'窗口加载
Private IsWindowLoadFinished As Boolean = False
''' <summary>
''' 是否为联机提权后自动重启。
''' </summary>
Public Shared IsLinkRestart As Boolean = False
Public Sub New()
ApplicationStartTick = GetTimeTick()
'窗体参数初始化
Expand Down Expand Up @@ -355,7 +360,6 @@ Public Class FormMain
PanMainLeft.Child = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
'模式提醒
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
Expand Down Expand Up @@ -424,7 +428,7 @@ Public Class FormMain
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
End Sub, , True)
}, "Form Show")
'Timer 启动
Expand Down Expand Up @@ -570,7 +574,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort()
Next
End Sub, "强行停止下载任务")
Expand Down Expand Up @@ -889,10 +893,12 @@ Public Class FormMain
Install:
Try
For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
Expand All @@ -909,7 +915,7 @@ Install:
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
Expand Down
Binary file removed Plain Craft Launcher 2/Images/Heads/DoodleHuang.png
Binary file not shown.
Binary file added Plain Craft Launcher 2/Images/Heads/z0z0r4.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
22 changes: 8 additions & 14 deletions Plain Craft Launcher 2/Modules/Base/ModBase.vb
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"

'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.3." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 332 'Release
#Else
Public Const VersionCode As Integer = 331 'Snapshot
Public Const VersionCode As Integer = 333 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
Expand Down Expand Up @@ -80,10 +80,6 @@ Public Module ModBase
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
Expand Down Expand Up @@ -1108,8 +1104,6 @@ Re:
Dim Retry As Boolean = False
Re:
Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
Expand Down Expand Up @@ -1587,14 +1581,14 @@ RetryDir:
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then
StartPos += Before.Length
StartPos += After.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
Expand Down Expand Up @@ -2682,7 +2676,7 @@ Retry:
Public Sub FeedbackInfo()
On Error Resume Next
Log("[System] 诊断信息:" & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
Expand Down
48 changes: 18 additions & 30 deletions Plain Craft Launcher 2/Modules/Base/ModLoader.vb
Original file line number Diff line number Diff line change
Expand Up @@ -566,38 +566,33 @@ Restart:
End Class

'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None

Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
End SyncLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.TryTake(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
Expand Down Expand Up @@ -625,15 +620,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
Expand Down
Loading

0 comments on commit 93574f6

Please sign in to comment.