| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538 |
- Imports System.ComponentModel
- Public Class FormMain
- #Region "基础"
- '更新日志
- Private Sub ShowUpdateLog(LastVersion As Integer)
- Dim FeatureCount As Integer = 0, BugCount As Integer = 0
- Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
- '统计更新日志条目
- #If BETA Then
- If LastVersion < 296 Then 'Release 2.6.3
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
- FeatureCount += 21
- BugCount += 30
- End If
- If LastVersion < 293 Then 'Release 2.6.1
- BugCount += 1
- End If
- If LastVersion < 292 Then 'Release 2.6.0
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
- FeatureCount += 24
- BugCount += 24
- End If
- If LastVersion < 286 Then 'Release 2.5.2
- FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、安装 Modrinth 的 Mod 与整合包"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
- FeatureCount += 35
- BugCount += 36
- End If
- If LastVersion < 281 Then 'Release 2.4.9
- If LastVersion = 279 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
- FeatureCount += 1
- BugCount += 5
- End If
- If LastVersion < 279 Then 'Release 2.4.8
- FeatureCount += 1
- BugCount += 10
- End If
- If LastVersion < 276 Then 'Release 2.4.7
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
- FeatureCount += 25
- BugCount += 56
- End If
- If LastVersion < 272 Then 'Release 2.4.4
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色,让整体边框变得更淡"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
- If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
- FeatureCount += 13
- BugCount += 23
- End If
- If LastVersion < 268 Then 'Release 2.4.2
- FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
- FeatureCount += 14
- BugCount += 33
- End If
- If LastVersion < 265 Then 'Release 2.3.5
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
- FeatureCount += 13
- BugCount += 9
- End If
- If LastVersion < 260 Then 'Release 2.3.2
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
- FeatureCount += 22
- BugCount += 4
- End If
- If LastVersion < 257 Then 'Release 2.3.0
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug"))
- FeatureCount += 4
- BugCount += 4
- End If
- If LastVersion < 255 Then 'Release 2.2.14
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
- FeatureCount += 5
- BugCount += 3
- End If
- If LastVersion < 253 Then 'Release 2.2.13
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
- FeatureCount += 13
- BugCount += 27
- End If
- If LastVersion < 250 Then 'Release 2.2.11
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持将 Mod 文件拖入窗口进行安装"))
- If LastVersion = 246 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用中文搜索 Mod 的 Bug"))
- FeatureCount += 8
- BugCount += 33
- End If
- #Else
- '5: FEAT+
- '4: IMP+ FEAT*
- '3:BUG+ IMP* FEAT-
- '2:BUG* IMP-
- '1:BUG-
- If LastVersion < 295 Then 'Snapshot 2.6.3
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
- FeatureCount += 12
- BugCount += 14
- End If
- If LastVersion < 294 Then 'Snapshot 2.6.2
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
- FeatureCount += 9
- BugCount += 16
- End If
- If LastVersion < 291 Then 'Snapshot 2.6.0
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
- FeatureCount += 10
- BugCount += 2
- End If
- If LastVersion < 289 Then 'Snapshot 2.5.4
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
- FeatureCount += 6
- BugCount += 14
- End If
- If LastVersion < 288 Then 'Snapshot 2.5.3
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
- FeatureCount += 8
- BugCount += 8
- End If
- If LastVersion < 285 Then 'Snapshot 2.5.2
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
- If LastVersion = 284 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复打开部分帮助报错的 Bug"))
- FeatureCount += 8
- BugCount += 8
- End If
- If LastVersion < 284 Then 'Snapshot 2.5.1
- If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
- FeatureCount += 22
- BugCount += 21
- End If
- If LastVersion < 283 Then 'Snapshot 2.5.0
- FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包"))
- FeatureCount += 5
- BugCount += 5
- End If
- If LastVersion < 282 Then 'Snapshot 2.4.9
- FeatureCount += 1
- BugCount += 5
- If LastVersion = 280 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
- End If
- If LastVersion < 280 Then 'Snapshot 2.4.8
- FeatureCount += 1
- BugCount += 10
- End If
- If LastVersion < 278 Then 'Snapshot 2.4.7
- If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
- BugCount += 2
- End If
- If LastVersion < 277 Then 'Snapshot 2.4.6
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
- FeatureCount += 8
- BugCount += 21
- End If
- If LastVersion < 275 Then 'Snapshot 2.4.5
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
- FeatureCount += 17
- BugCount += 35
- End If
- If LastVersion < 273 Then 'Snapshot 2.4.4
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
- If LastVersion = 271 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法同时开启多个 Minecraft 客户端的 Bug"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
- FeatureCount += 7
- BugCount += 8
- End If
- If LastVersion < 271 Then 'Snapshot 2.4.3
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
- If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
- FeatureCount += 6
- BugCount += 15
- End If
- If LastVersion < 269 Then 'Snapshot 2.4.2
- If LastVersion = 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载 CurseForge 整合包的 Bug"))
- FeatureCount += 2
- BugCount += 3
- End If
- If LastVersion < 267 Then 'Snapshot 2.4.1
- FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
- FeatureCount += 12
- BugCount += 22
- End If
- If LastVersion < 266 Then 'Snapshot 2.4.0
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
- FeatureCount += 3
- BugCount += 11
- End If
- If LastVersion < 264 Then 'Snapshot 2.3.5
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动部分 Forge 版本的 Bug"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
- FeatureCount += 2
- BugCount += 3
- End If
- If LastVersion < 263 Then 'Snapshot 2.3.4
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
- FeatureCount += 11
- BugCount += 5
- End If
- If LastVersion < 262 Then 'Snapshot 2.3.3
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "修复无法使用 Mod、整合包搜索功能的 Bug"))
- BugCount += 1
- End If
- If LastVersion < 261 Then 'Snapshot 2.3.2
- FeatureCount += 8
- BugCount += 4
- End If
- If LastVersion < 259 Then 'Snapshot 2.3.1
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
- FeatureCount += 14
- End If
- If LastVersion < 258 Then 'Snapshot 2.3.0
- FeatureCount += 4
- BugCount += 4
- End If
- If LastVersion < 256 Then 'Snapshot 2.2.14
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
- FeatureCount += 5
- BugCount += 3
- End If
- If LastVersion < 254 Then 'Snapshot 2.2.13
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
- FeatureCount += 3
- BugCount += 17
- End If
- If LastVersion < 252 Then 'Snapshot 2.2.12
- FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
- FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
- If LastVersion = 251 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复同时安装 Forge 和 OptiFine 时 OptiFine 无效的 Bug"))
- FeatureCount += 10
- BugCount += 10
- End If
- If LastVersion < 251 Then 'Snapshot 2.2.11
- FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持将 Mod 文件拖入窗口进行安装"))
- FeatureCount += 2
- BugCount += 16
- End If
- #End If
- '整理更新日志文本
- Dim ContentList As New List(Of String)
- Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
- Return Left.Key > Right.Key
- End Function)
- If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
- ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
- End If
- For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
- ContentList.Add(SortedFeatures(i).Value)
- Next
- If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
- If FeatureCount > 0 OrElse BugCount > 0 Then
- ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") &
- If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
- If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
- ",详见完整更新日志")
- End If
- Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ")
- '输出更新日志
- RunInNewThread(Sub()
- If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
- OpenWebsite("https://afdian.net/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()
- '窗体参数初始化
- FrmMain = Me
- FrmLaunchLeft = New PageLaunchLeft
- FrmLaunchRight = New PageLaunchRight
- '版本号改变
- Dim LastVersion As Integer = Setup.Get("SystemLastVersionReg")
- If LastVersion < VersionCode Then
- '触发升级
- UpgradeSub(LastVersion)
- ElseIf LastVersion > VersionCode Then
- '触发降级
- DowngradeSub(LastVersion)
- End If
- ''刷新语言
- 'Lang = ReadReg("Lang", "zh_CN")
- 'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)}
- '刷新主题
- ThemeCheckAll(False)
- Setup.Load("UiLauncherTheme")
- '加载 UI
- InitializeComponent()
- Opacity = 0
- '切换到首页
- If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
- If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
- 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)
- #End If
- If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会造成性能的下降,若无必要请不要开启!")
- '尽早执行的加载池
- McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
- Log("[Start] 第二阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
- End Sub
- Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
- ApplicationStartTick = GetTimeTick()
- Handle = New Interop.WindowInteropHelper(Me).Handle
- '读取设置
- Setup.Load("UiBackgroundOpacity")
- Setup.Load("UiBackgroundBlur")
- Setup.Load("UiLogoType")
- Setup.Load("UiHiddenPageDownload")
- BackgroundRefresh(False, True)
- MusicRefreshPlay(False, True)
- '扩展按钮
- BtnExtraDownload.ShowCheck = AddressOf BtnExtraDownload_ShowCheck
- BtnExtraBack.ShowCheck = AddressOf BtnExtraBack_ShowCheck
- BtnExtraApril.ShowCheck = AddressOf BtnExtraApril_ShowCheck
- BtnExtraShutdown.ShowCheck = AddressOf BtnExtraShutdown_ShowCheck
- BtnExtraApril.ShowRefresh()
- '初始化尺寸改变
- Dim Resizer As New MyResizer(Me)
- Resizer.addResizerDown(ResizerB)
- Resizer.addResizerLeft(ResizerL)
- Resizer.addResizerLeftDown(ResizerLB)
- Resizer.addResizerLeftUp(ResizerLT)
- Resizer.addResizerRight(ResizerR)
- Resizer.addResizerRightDown(ResizerRB)
- Resizer.addResizerRightUp(ResizerRT)
- Resizer.addResizerUp(ResizerT)
- 'PLC 彩蛋
- If RandomInteger(1, 1000) = 233 Then
- ShapeTitleLogo.Data = New GeometryConverter().ConvertFromString("M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M80,6.5 a10,11.5 180 1 0 0,18 M47,2.5 v24.5 h12 M98,2 v27 M107,2 v27")
- End If
- '加载窗口
- ThemeRefreshMain()
- Try
- Height = ReadReg("WindowHeight", MinHeight + 50)
- Width = ReadReg("WindowWidth", MinWidth + 50)
- Catch ex As Exception '修复 #2019
- Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
- Height = MinHeight + 50
- Width = MinWidth + 50
- End Try
- Topmost = False
- If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
- '更改窗口
- Top = (GetWPFSize(My.Computer.Screen.WorkingArea.Height) - Height) / 2
- Left = (GetWPFSize(My.Computer.Screen.WorkingArea.Width) - Width) / 2
- IsSizeSaveable = True
- ShowWindowToTop()
- Dim HwndSource As Interop.HwndSource = PresentationSource.FromVisual(Me)
- HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
- AniStart({
- AaCode(Sub() AniControlEnabled -= 1, 50),
- AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
- AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
- AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
- AaCode(Sub()
- PanBack.RenderTransform = Nothing
- IsWindowLoadFinished = True
- Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
- End Sub, , True)
- }, "Form Show")
- 'Timer 启动
- AniStartRun()
- TimerMainStartRun()
- '加载池
- RunInNewThread(Sub()
- If Not Setup.Get("SystemEula") Then
- Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
- Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
- Case 1
- Setup.Set("SystemEula", True)
- Case 2
- EndProgram(False)
- End Select
- End If
- Try
- JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
- Thread.Sleep(200)
- DlClientListMojangLoader.Start(1)
- RunCountSub()
- ServerLoader.Start(1)
- Catch ex As Exception
- Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
- End Try
- Try
- If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
- Catch ex As Exception
- Log(ex, "清理自动更新文件失败")
- End Try
- End Sub, "Start Loader", ThreadPriority.Lowest)
- Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
- End Sub
- '根据打开次数触发的事件
- Private Sub RunCountSub()
- Setup.Set("SystemCount", Setup.Get("SystemCount") + 1)
- #If Not BETA Then
- Select Case Setup.Get("SystemCount")
- Case 1
- MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
- "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
- "如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
- End Select
- If Setup.Get("SystemCount") >= 99 Then
- If ThemeUnlock(6, False) Then
- MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
- "隐藏主题 铁杆粉 已解锁!", "提示")
- End If
- End If
- #End If
- End Sub
- '升级与降级事件
- Private Sub UpgradeSub(LastVersionCode As Integer)
- Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode)
- Setup.Set("SystemLastVersionReg", VersionCode)
- '检查有记录的最高版本号
- Dim LowerVersionCode As Integer
- #If BETA Then
- LowerVersionCode = Setup.Get("SystemHighestBetaVersionReg")
- If LowerVersionCode < VersionCode Then
- Setup.Set("SystemHighestBetaVersionReg", VersionCode)
- Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
- End If
- #Else
- LowerVersionCode = Setup.Get("SystemHighestAlphaVersionReg")
- If LowerVersionCode < VersionCode Then
- Setup.Set("SystemHighestAlphaVersionReg", VersionCode)
- Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
- End If
- #End If
- '修改主题设置项名称
- If LowerVersionCode <= 207 Then
- Dim UnlockedTheme As New List(Of String) From {"2"}
- UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide").ToString.Split("|")))
- UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")))
- Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme.Distinct.ToList, "|"))
- End If
- '重置欧皇彩
- If LastVersionCode <= 115 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
- Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
- UnlockedTheme.Remove("13")
- Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
- MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
- "多谢各位的理解啦!", "重新解锁提醒")
- End If
- '重置滑稽彩
- If LastVersionCode <= 152 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
- Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
- UnlockedTheme.Remove("12")
- Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
- MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
- "多谢各位的理解啦!", "重新解锁提醒")
- End If
- '移动自定义皮肤
- If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
- CopyFile(Path & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
- Log("[Start] 已移动离线自定义皮肤 (162)")
- End If
- If LastVersionCode <= 263 AndAlso File.Exists(PathTemp & "CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
- CopyFile(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
- Log("[Start] 已移动离线自定义皮肤 (264)")
- End If
- '解除帮助页面的隐藏
- If LastVersionCode <= 205 Then
- Setup.Set("UiHiddenOtherHelp", False)
- Log("[Start] 已解除帮助页面的隐藏")
- End If
- '输出更新日志
- If LastVersionCode = 0 Then Exit Sub
- If LowerVersionCode >= VersionCode Then Exit Sub
- ShowUpdateLog(LowerVersionCode)
- End Sub
- Private Sub DowngradeSub(LastVersionCode As Integer)
- Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode)
- Setup.Set("SystemLastVersionReg", VersionCode)
- End Sub
- #End Region
- #Region "自定义窗口"
- '关闭
- Private Sub FormMain_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
- EndProgram(True)
- e.Cancel = True
- End Sub
- ''' <summary>
- ''' 正常关闭程序。程序将在执行此方法后约 0.3s 退出。
- ''' </summary>
- ''' <param name="SendWarning">是否在还有下载任务未完成时发出警告。</param>
- Public Sub EndProgram(SendWarning As Boolean)
- '发出警告
- If SendWarning AndAlso HasDownloadingTask() Then
- If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then
- '强行结束下载任务
- RunInNewThread(Sub()
- Log("[System] 正在强行停止任务")
- For Each Task As LoaderBase In LoaderTaskbar.ToArray
- Task.Abort()
- Next
- End Sub, "强行停止下载任务")
- Else
- Exit Sub
- End If
- End If
- '关闭
- RunInUiWait(
- Sub()
- IsHitTestVisible = False
- If PanBack.RenderTransform Is Nothing Then
- Dim TransformPos As New TranslateTransform(0, 0)
- Dim TransformRotate As New RotateTransform(0)
- Dim TransformScale As New ScaleTransform(1, 1)
- PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
- AniStart({
- AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
- AaDouble(Sub(i)
- TransformScale.ScaleX += i
- TransformScale.ScaleY += i
- End Sub, 0.88 - TransformScale.ScaleX, 180),
- AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
- AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
- AaCode(Sub()
- IsHitTestVisible = False
- Top = -10000
- ShowInTaskbar = False
- End Sub, 210),
- AaCode(AddressOf EndProgramForce, 230)
- }, "Form Close")
- Else
- EndProgramForce()
- End If
- Log("[System] 收到关闭指令")
- End Sub)
- End Sub
- Private Shared IsLogShown As Boolean = False
- Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success)
- On Error Resume Next
- IsProgramEnded = True
- AniControlEnabled += 1
- PageLinkIoi.IoiStop(False)
- PageLinkHiper.HiperStop(False)
- If IsUpdateWaitingRestart Then UpdateRestart(False)
- If ReturnCode = Result.Exception Then
- If Not IsLogShown Then
- FeedbackInfo()
- Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告,以便于作者解决此问题!")
- IsLogShown = True
- ShellOnly(Path & "PCL\Log1.txt")
- End If
- Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
- End If
- Log("[System] 程序已退出,返回值:" & GetStringFromEnum(CType(ReturnCode, [Enum])))
- LogFlush()
- If ReturnCode = Result.Success Then
- Process.GetCurrentProcess.Kill()
- Else
- Environment.Exit(ReturnCode)
- Process.GetCurrentProcess.Kill()
- End If
- End Sub
- Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click
- EndProgram(True)
- End Sub
- '移动
- Private Sub FormDragMove(sender As Object, e As MouseButtonEventArgs) Handles PanTitle.MouseLeftButtonDown, PanMsg.MouseLeftButtonDown
- On Error Resume Next
- If sender.IsMouseDirectlyOver Then DragMove()
- End Sub
- '改变大小
- ''' <summary>
- ''' 是否可以向注册表储存尺寸改变信息。以此避免初始化时误储存。
- ''' </summary>
- Public IsSizeSaveable As Boolean = False
- Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
- If IsSizeSaveable Then
- WriteReg("WindowHeight", Height)
- WriteReg("WindowWidth", Width)
- End If
- RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
- PanForm.Width = BorderForm.ActualWidth + 0.001
- PanForm.Height = BorderForm.ActualHeight + 0.001
- PanMain.Width = PanForm.Width
- PanMain.Height = Math.Max(0, PanForm.Height - PanTitle.ActualHeight)
- If WindowState = WindowState.Maximized Then WindowState = WindowState.Normal '修复 #1938
- End Sub
- '最小化
- Private Sub BtnTitleMin_Click() Handles BtnTitleMin.Click
- WindowState = WindowState.Minimized
- End Sub
- #End Region
- #Region "窗体事件"
- '按键事件
- Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
- If e.IsRepeat Then Exit Sub
- '调用弹窗:回车选择第一个,Esc 选择最后一个
- If PanMsg.Children.Count > 0 Then
- If e.Key = Key.Enter Then
- CType(PanMsg.Children(0), Object).Btn1_Click()
- Exit Sub
- ElseIf e.Key = Key.Escape Then
- Dim Msg As Object = PanMsg.Children(0)
- If TypeOf Msg Is MyMsgText AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
- Msg.Btn3_Click()
- ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
- Msg.Btn2_Click()
- Else
- Msg.Btn1_Click()
- End If
- Exit Sub
- End If
- End If
- '按 ESC 返回上一级
- If e.Key = Key.Escape Then TriggerPageBack()
- '更改隐藏版本可见性
- If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.VersionSelect Then
- FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
- LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
- Exit Sub
- End If
- '更改功能隐藏可见性
- If e.Key = Key.F12 Then
- PageSetupUI.HiddenForceShow = Not PageSetupUI.HiddenForceShow
- If PageSetupUI.HiddenForceShow Then
- Hint("功能隐藏设置已暂时关闭!", HintType.Finish)
- Else
- Hint("功能隐藏设置已重新开启!", HintType.Finish)
- End If
- PageSetupUI.HiddenRefresh()
- Exit Sub
- End If
- '调用启动游戏
- If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
- If IsAprilEnabled AndAlso Not IsAprilGiveup Then
- Hint("木大!")
- Else
- FrmLaunchLeft.LaunchButtonClick()
- End If
- End If
- '修复按下 Alt 后误认为弹出系统菜单导致的冻结
- If e.SystemKey = Key.LeftAlt OrElse e.SystemKey = Key.RightAlt Then e.Handled = True
- End Sub
- Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
- '鼠标侧键返回上一级
- If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
- End Sub
- Private Sub TriggerPageBack()
- If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
- FrmDownloadInstall.ExitSelectPage()
- Else
- PageBack()
- End If
- End Sub
- '切回窗口
- Private Sub FormMain_Activated() Handles Me.Activated
- Try
- If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
- 'Mod 管理自动刷新
- FrmVersionMod.RefreshList()
- ElseIf PageCurrent = PageType.VersionSelect Then
- '版本选择自动刷新
- LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
- End If
- Catch ex As Exception
- Log(ex, "切回窗口时出错", LogLevel.Feedback)
- End Try
- End Sub
- '文件拖放
- Private Sub FrmMain_PreviewDragOver(sender As Object, e As DragEventArgs) Handles Me.PreviewDragOver
- If e.Data.GetFormats.Contains("FileDrop") Then
- e.Effects = DragDropEffects.Link
- Else
- e.Effects = DragDropEffects.None
- End If
- End Sub
- Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.PreviewDrop
- Try
- If e.Data.GetDataPresent(DataFormats.Text) Then
- '获取文本
- Try
- Dim Str As String = e.Data.GetData(DataFormats.Text)
- Log("[System] 接受文本拖拽:" & Str)
- If Str.StartsWith("authlib-injector:yggdrasil-server:") Then
- 'Authlib 拖拽
- e.Handled = True
- Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
- Log("[System] Authlib 拖拽:" & AuthlibServer)
- If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
- Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Critical)
- Exit Sub
- End If
- If McVersionCurrent Is Nothing Then
- Hint("请先下载游戏,再设置第三方登录!", HintType.Critical)
- Exit Sub
- End If
- If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
- 'LittleSkin
- If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启 LittleSkin 登录?" & vbCrLf &
- "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
- Exit Sub
- End If
- Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=McVersionCurrent)
- Else
- '第三方 Authlib 服务器
- If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启第三方登录?" & vbCrLf &
- $"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
- "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
- Exit Sub
- End If
- Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=McVersionCurrent)
- Setup.Set("VersionServerAuthName", "", Version:=McVersionCurrent)
- End If
- If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionSetup Then
- '正在服务器选项页,需要刷新设置项显示
- FrmVersionSetup.Reload()
- ElseIf PageCurrent = PageType.Launch Then
- '正在主页,需要刷新左边栏
- FrmLaunchLeft.RefreshPage(True, False)
- End If
- End If
- Catch ex As Exception
- Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
- Exit Sub
- End Try
- ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
- '获取文件并检查
- Dim FilePathList As New List(Of String)(CType(e.Data.GetData(DataFormats.FileDrop), Array))
- e.Handled = True
- If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
- Hint("请拖入一个文件,而非文件夹!", 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
- 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
- '自定义主页
- If Extension = "xaml" Then
- Log("[System] 文件后缀为 XAML,作为自定义主页加载")
- If File.Exists(Path & "PCL\Custom.xaml") Then
- If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
- Exit Sub
- End If
- End If
- CopyFile(FilePath, Path & "PCL\Custom.xaml")
- RunInUi(Sub()
- Setup.Set("UiCustomType", 1)
- FrmLaunchRight.ForceRefresh()
- End Sub)
- Exit Sub
- End If
- 'Mod 安装
- If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then
- Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
- '获取并检查目标版本
- Dim TargetVersion As McVersion = McVersionCurrent
- If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
- If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
- '正在选择版本,或当前版本不能安装 Mod
- Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
- ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
- '未处于 Mod 管理页面
- If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
- Else
- '处于 Mod 管理页面
- Install:
- Try
- For Each ModFile In FilePathList
- CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
- Next
- If FilePathList.Count = 1 Then
- Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
- Else
- Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
- End If
- '刷新列表
- If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
- LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
- End If
- Catch ex As Exception
- Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
- End Try
- End If
- Exit Sub
- End If
- '安装整合包
- If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
- Log("[System] 文件为压缩包,尝试作为整合包安装")
- If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
- End If
- 'RAR 处理
- If Extension = "rar" Then
- Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
- Exit Sub
- End If
- '错误报告分析
- Try
- Log("[System] 尝试进行错误报告分析")
- Dim Analyzer As New CrashAnalyzer(GetUuid())
- Analyzer.Import(FilePath)
- If Analyzer.Prepare() = 0 Then Exit Try
- Analyzer.Analyze()
- Analyzer.Output(True, New List(Of String))
- Exit Sub
- Catch ex As Exception
- Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
- End Try
- '未知操作
- Hint("PCL 无法确定应当执行的文件拖拽操作……")
- End Sub, "文件拖拽")
- End If
- Catch ex As Exception
- Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
- End Try
- End Sub
- '接受到 Windows 窗体事件
- Public IsSystemTimeChanged As Boolean = False
- Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
- If msg = 30 Then
- Dim NowDate = Date.Now
- If NowDate.Date = ApplicationOpenTime.Date Then
- Log("[System] 系统时间微调为:" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
- IsSystemTimeChanged = False
- Else
- Log("[System] 系统时间修改为:" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
- IsSystemTimeChanged = True
- End If
- ElseIf msg = 400 * 16 + 2 Then
- Log("[System] 收到置顶信息:" & hwnd.ToInt64)
- If Not IsWindowLoadFinished Then
- Log("[System] 窗口尚未加载完成,忽略置顶请求")
- Return IntPtr.Zero
- End If
- ShowWindowToTop()
- handled = True
- End If
- Return IntPtr.Zero
- End Function
- '窗口隐藏与置顶
- Private _Hidden As Boolean = False
- Public Property Hidden As Boolean
- Get
- Return _Hidden
- End Get
- Set(ByVal value As Boolean)
- If _Hidden = value Then Exit Property
- _Hidden = value
- If value Then
- '隐藏
- Left -= 10000
- ShowInTaskbar = False
- Visibility = Visibility.Hidden
- 'SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
- Log("[System] 窗口已隐藏,位置:(" & Left & "," & Top & ")")
- Else
- '取消隐藏
- If Left < -2000 Then Left += 10000
- ShowWindowToTop()
- End If
- End Set
- End Property
- ''' <summary>
- ''' 把当前窗口拖到最前面。
- ''' </summary>
- Public Sub ShowWindowToTop()
- RunInUi(Sub()
- '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
- Visibility = Visibility.Visible
- ShowInTaskbar = True
- WindowState = WindowState.Normal
- Hidden = False
- Topmost = True '偶尔 SetForegroundWindow 失效
- Topmost = False
- SetForegroundWindow(Handle)
- Focus()
- 'ShowWindow(Handle, 1) 'SW_RESTORE
- 'SetWindowPos(Handle, 0, 0, 0, 0, 0, 3) 'InsertAfter: TOP, NOMOVE & NOSIZE
- 'SetFocus(Handle)
- Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height)
- End Sub)
- End Sub
- 'Private Declare Function SetFocus Lib "user32" (hWnd As IntPtr) As IntPtr
- 'Private Declare Function SetWindowPos Lib "user32" (hWnd As IntPtr, hWndInsertAfter As IntPtr, x As Integer, y As Integer, cx As Integer, cy As Integer, flags As UInteger) As Boolean
- 'Private Declare Function AttachThreadInput Lib "user32" (attachFrom As IntPtr, attachTo As IntPtr, isAttach As Boolean) As Boolean
- 'Private Declare Function SendMessage Lib "user32" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As IntPtr
- #End Region
- #Region "切换页面"
- '页面种类与属性
- ''' <summary>
- ''' 页面种类。
- ''' </summary>
- Public Enum PageType
- ''' <summary>
- ''' 启动。
- ''' </summary>
- Launch
- ''' <summary>
- ''' 下载。
- ''' </summary>
- Download
- ''' <summary>
- ''' 联机。
- ''' </summary>
- Link
- ''' <summary>
- ''' 设置。
- ''' </summary>
- Setup
- ''' <summary>
- ''' 更多。
- ''' </summary>
- Other
- ''' <summary>
- ''' 版本选择。这是一个副页面。
- ''' </summary>
- VersionSelect
- ''' <summary>
- ''' 下载管理。这是一个副页面。
- ''' </summary>
- DownloadManager
- ''' <summary>
- ''' 版本设置。这是一个副页面。
- ''' </summary>
- VersionSetup
- ''' <summary>
- ''' 资源工程详情。这是一个副页面。
- ''' </summary>
- CompDetail
- ''' <summary>
- ''' 帮助详情。这是一个副页面。
- ''' </summary>
- HelpDetail
- End Enum
- ''' <summary>
- ''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。
- ''' </summary>
- Public Enum PageSubType
- [Default] = 0
- DownloadInstall = 1
- DownloadClient = 4
- DownloadOptiFine = 5
- DownloadForge = 6
- DownloadFabric = 7
- DownloadLiteLoader = 8
- DownloadMod = 10
- DownloadPack = 11
- SetupLaunch = 0
- SetupUI = 1
- SetupSystem = 2
- SetupLink = 3
- LinkHiper = 1
- LinkIoi = 2
- LinkSetup = 4
- LinkHelp = 5
- LinkFeedback = 6
- OtherHelp = 0
- OtherAbout = 1
- OtherTest = 2
- VersionOverall = 0
- VersionSetup = 1
- VersionMod = 2
- VersionModDisabled = 3
- End Enum
- ''' <summary>
- ''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
- ''' </summary>
- Private Function PageNameGet(Stack As PageStackData) As String
- Select Case Stack.Page
- Case PageType.VersionSelect
- Return "版本选择"
- Case PageType.DownloadManager
- Return "下载管理"
- Case PageType.VersionSetup
- Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
- Case PageType.CompDetail
- If Stack.Additional Is Nothing Then
- Log("[Control] 资源工程详情页面未提供关键项", LogLevel.Feedback)
- Return "未知页面"
- Else
- Dim Project As CompProject = Stack.Additional
- Select Case Project.Type
- Case CompType.Mod
- Return "Mod 下载 - " & Project.TranslatedName
- Case CompType.ModPack
- Return "整合包下载 - " & Project.TranslatedName
- Case Else 'CompType.ResourcePack
- Return "资源包下载 - " & Project.TranslatedName
- End Select
- End If
- Case PageType.HelpDetail
- If Stack.Additional Is Nothing Then
- Log("[Control] 帮助详情页面未提供关键项", LogLevel.Msgbox)
- Return "未知页面"
- Else
- Dim Entry As HelpEntry = Stack.Additional(0)
- Return Entry.Title
- End If
- Case Else
- Return ""
- End Select
- End Function
- ''' <summary>
- ''' 刷新次级页面的名称。
- ''' </summary>
- Public Sub PageNameRefresh(Type As PageStackData)
- LabTitleInner.Text = PageNameGet(Type)
- End Sub
- ''' <summary>
- ''' 刷新次级页面的名称。
- ''' </summary>
- Public Sub PageNameRefresh()
- PageNameRefresh(PageCurrent)
- End Sub
- '页面状态存储
- ''' <summary>
- ''' 当前的主页面。
- ''' </summary>
- Public PageCurrent As PageStackData = PageType.Launch
- ''' <summary>
- ''' 当前的子页面。
- ''' </summary>
- Public ReadOnly Property PageCurrentSub As PageSubType
- Get
- Select Case PageCurrent
- Case PageType.Download
- If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
- Return FrmDownloadLeft.PageID
- Case PageType.Link
- If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
- Return FrmLinkLeft.PageID
- Case PageType.Setup
- If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
- Return FrmSetupLeft.PageID
- Case PageType.Other
- If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
- Return FrmOtherLeft.PageID
- Case PageType.VersionSetup
- If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
- Return FrmVersionLeft.PageID
- Case Else
- Return 0 '没有子页面
- End Select
- End Get
- End Property
- ''' <summary>
- ''' 上层页面的编号堆栈,用于返回。
- ''' </summary>
- Public PageStack As New List(Of PageStackData)
- Public Class PageStackData
- Public Page As PageType
- Public Additional As Object
- Public Overrides Function Equals(other As Object) As Boolean
- If other Is Nothing Then Return False
- If TypeOf other Is PageStackData Then
- Dim PageOther As PageStackData = other
- If Page <> PageOther.Page Then Return False
- If Additional Is Nothing Then
- Return PageOther.Additional Is Nothing
- Else
- Return PageOther.Additional IsNot Nothing AndAlso Additional.Equals(PageOther.Additional)
- End If
- ElseIf TypeOf other Is Integer Then
- If Page <> other Then Return False
- Return Additional Is Nothing
- Else
- Return False
- End If
- End Function
- Public Shared Operator =(left As PageStackData, right As PageStackData) As Boolean
- Return EqualityComparer(Of PageStackData).Default.Equals(left, right)
- End Operator
- Public Shared Operator <>(left As PageStackData, right As PageStackData) As Boolean
- Return Not left = right
- End Operator
- Public Shared Widening Operator CType(Value As PageType) As PageStackData
- Return New PageStackData With {.Page = Value}
- End Operator
- Public Shared Widening Operator CType(Value As PageStackData) As PageType
- Return Value.Page
- End Operator
- End Class
- Public PageLeft As MyPageLeft, PageRight As MyPageRight
- '引发实际页面切换的入口
- Private IsChangingPage As Boolean = False
- ''' <summary>
- ''' 切换页面,并引起对应选择 UI 的改变。
- ''' </summary>
- Public Sub PageChange(Stack As PageStackData, Optional SubType As PageSubType = PageSubType.Default)
- If PageNameGet(Stack) = "" Then
- '切换到主页面
- PageChangeExit()
- IsChangingPage = True '防止下面的勾选直接触发了 PageChangeActual
- CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "")
- IsChangingPage = False
- Select Case Stack.Page
- Case PageType.Link
- If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
- CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
- Case PageType.Download
- If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
- CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
- Case PageType.Setup
- If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
- CType(FrmSetupLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
- Case PageType.Other
- If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
- CType(FrmOtherLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
- End Select
- PageChangeActual(Stack, SubType)
- Else
- '切换到次页面
- Select Case Stack.Page
- Case PageType.VersionSetup
- If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
- CType(FrmVersionLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
- End Select
- PageChangeActual(Stack, SubType)
- End If
- End Sub
- ''' <summary>
- ''' 通过点击导航栏改变页面。
- ''' </summary>
- Private Sub BtnTitleSelect_Click(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTitleSelect0.Check, BtnTitleSelect1.Check, BtnTitleSelect2.Check, BtnTitleSelect3.Check, BtnTitleSelect4.Check
- If IsChangingPage Then Exit Sub
- PageChangeActual(Val(sender.Tag))
- End Sub
- Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick
- If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
- "PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
- "联机功能已暂时关闭", "查看详情", "确定") = 1 Then
- OpenWebsite("https://www.bilibili.com/read/cv19845645")
- End If
- e.Handled = True
- End Sub
- ''' <summary>
- ''' 通过点击返回按钮或手动触发返回来改变页面。
- ''' </summary>
- Public Sub PageBack() Handles BtnTitleInner.Click
- If PageStack.Count = 0 Then Exit Sub
- PageChangeActual(PageStack(0))
- End Sub
- '实际处理页面切换
- ''' <summary>
- ''' 切换现有页面的实际方法。
- ''' </summary>
- Private Sub PageChangeActual(Stack As PageStackData, Optional SubType As PageSubType = -1)
- If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Exit Sub
- AniControlEnabled += 1
- Try
- #Region "子页面处理"
- Dim PageName As String = PageNameGet(Stack)
- If PageName = "" Then
- '即将切换到一个顶级页面
- PageChangeExit()
- Else
- '即将切换到一个子页面
- If PageStack.Count = 0 Then
- '主页面 → 子页面,进入
- PanTitleInner.Visibility = Visibility.Visible
- PanTitleMain.IsHitTestVisible = False
- PanTitleInner.IsHitTestVisible = True
- PageNameRefresh(Stack)
- AniStart({
- AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
- AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
- AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
- AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
- AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
- }, "FrmMain Titlebar FirstLayer")
- PageStack.Insert(0, PageCurrent)
- Else
- '子页面 → 另一个子页面,更新
- AniStart({
- AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
- AaCode(Sub() LabTitleInner.Text = PageName,, True),
- AaOpacity(LabTitleInner, 1, 150, 30)
- }, "FrmMain Titlebar SubLayer")
- If PageStack.Contains(Stack) Then
- '返回到更上层的子页面
- Do While PageStack.Contains(Stack)
- PageStack.RemoveAt(0)
- Loop
- Else
- '进入更深层的子页面
- PageStack.Insert(0, PageCurrent)
- End If
- End If
- End If
- #End Region
- #Region "实际更改页面框架 UI"
- PageCurrent = Stack
- Select Case Stack.Page
- Case PageType.Launch '启动
- PageChangeAnim(FrmLaunchLeft, FrmLaunchRight)
- Case PageType.Download '下载
- If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
- 'PageGet 方法会在未设置 SubType 时指定默认值,并建立相关页面的实例
- PageChangeAnim(FrmDownloadLeft, FrmDownloadLeft.PageGet(SubType))
- Case PageType.Link '联机
- If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
- PageChangeAnim(FrmLinkLeft, FrmLinkLeft.PageGet(SubType))
- Case PageType.Setup '设置
- If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
- PageChangeAnim(FrmSetupLeft, FrmSetupLeft.PageGet(SubType))
- Case PageType.Other '更多
- If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
- PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType))
- Case PageType.VersionSelect '版本选择
- If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft
- If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight
- PageChangeAnim(FrmSelectLeft, FrmSelectRight)
- Case PageType.DownloadManager '下载管理
- If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft
- If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight
- PageChangeAnim(FrmSpeedLeft, FrmSpeedRight)
- Case PageType.VersionSetup '版本设置
- If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
- PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType))
- Case PageType.CompDetail 'Mod 信息
- If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
- PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
- Case PageType.HelpDetail '帮助详情
- PageChangeAnim(New MyPageLeft, Stack.Additional(1))
- End Select
- #End Region
- #Region "设置为最新状态"
- BtnExtraDownload.ShowRefresh()
- BtnExtraApril.ShowRefresh()
- #End Region
- Log("[Control] 切换主要页面:" & GetStringFromEnum(Stack) & ", " & SubType)
- Catch ex As Exception
- Log(ex, "切换主要页面失败(ID " & PageCurrent.Page & ")", LogLevel.Feedback)
- Finally
- AniControlEnabled -= 1
- End Try
- End Sub
- Private Sub PageChangeAnim(TargetLeft As FrameworkElement, TargetRight As FrameworkElement)
- AniStop("FrmMain LeftChange")
- AniStop("PageLeft PageChange") '停止左边栏变更导致的右页面切换动画,防止它与本动画一起触发多次 PageOnEnter
- AniControlEnabled += 1
- '清除新页面关联性
- If Not IsNothing(TargetLeft.Parent) Then TargetLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
- If Not IsNothing(TargetRight) AndAlso Not IsNothing(TargetRight.Parent) Then TargetRight.SetValue(ContentPresenter.ContentProperty, Nothing)
- PageLeft = TargetLeft
- PageRight = TargetRight
- '触发页面通用动画
- CType(PanMainLeft.Child, MyPageLeft).TriggerHideAnimation()
- CType(PanMainRight.Child, MyPageRight).PageOnExit()
- AniControlEnabled -= 1
- '执行动画
- AniStart({
- AaCode(Sub()
- AniControlEnabled += 1
- '把新页面添加进容器
- PanMainLeft.Child = PageLeft
- PageLeft.Opacity = 0
- PanMainLeft.Background = Nothing
- AniControlEnabled -= 1
- RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
- End Sub, 130),
- AaCode(Sub()
- '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
- PageLeft.Opacity = 1
- PageLeft.TriggerShowAnimation()
- End Sub, 30, True)
- }, "FrmMain PageChangeLeft")
- AniStart({
- AaCode(Sub()
- AniControlEnabled += 1
- CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
- '把新页面添加进容器
- PanMainRight.Child = PageRight
- PageRight.Opacity = 0
- PanMainRight.Background = Nothing
- AniControlEnabled -= 1
- RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
- End Sub, 130),
- AaCode(Sub()
- '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
- PageRight.Opacity = 1
- PageRight.PageOnEnter()
- End Sub, 30, True)
- }, "FrmMain PageChangeRight")
- End Sub
- ''' <summary>
- ''' 退出子界面。
- ''' </summary>
- Private Sub PageChangeExit()
- If PageStack.Count = 0 Then
- '主页面 → 主页面,无事发生
- Else
- '子页面 → 主页面,退出
- PanTitleMain.Visibility = Visibility.Visible
- PanTitleMain.IsHitTestVisible = True
- PanTitleInner.IsHitTestVisible = False
- AniStart({
- AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
- AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
- AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
- AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
- AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
- }, "FrmMain Titlebar FirstLayer")
- PageStack.Clear()
- End If
- End Sub
- '左边栏改变
- Private Sub PanMainLeft_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanMainLeft.SizeChanged
- If Not e.WidthChanged Then Exit Sub
- PanMainLeft_Resize(e.NewSize.Width)
- End Sub
- Private Sub PanMainLeft_Resize(NewWidth As Double)
- Dim Delta As Double = NewWidth - RectLeftBackground.Width
- If Math.Abs(Delta) < 0.1 Then Exit Sub
- If AniControlEnabled = 0 Then
- If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
- If NewWidth > 0 Then
- '宽度足够,显示
- AniStart({
- AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
- AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
- AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
- }, "FrmMain LeftChange", True)
- Else
- '宽度不足,隐藏
- AniStart({
- AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
- AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
- AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
- }, "FrmMain LeftChange", True)
- End If
- Else
- RectLeftBackground.Width = NewWidth
- PanMainLeft.IsHitTestVisible = True
- AniStop("FrmMain LeftChange")
- End If
- End Sub
- #End Region
- #Region "控件拖动"
- '在时钟中调用,使得即使鼠标在窗口外松开,也可以释放控件
- Public Sub DragTick()
- If DragControl Is Nothing Then Exit Sub
- If Not Mouse.LeftButton = MouseButtonState.Pressed Then
- DragStop()
- End If
- End Sub
- '在鼠标移动时调用,以改变 Slider 位置
- Public Sub DragDoing() Handles PanBack.MouseMove
- If DragControl Is Nothing Then Exit Sub
- If Mouse.LeftButton = MouseButtonState.Pressed Then
- DragControl.DragDoing()
- Else
- DragStop()
- End If
- End Sub
- Public Sub DragStop()
- '存在其他线程调用的可能性,因此需要确保在 UI 线程运行
- RunInUi(Sub()
- If DragControl Is Nothing Then Exit Sub
- Dim Control = DragControl
- DragControl = Nothing
- Control.DragStop() '控件会在该事件中判断 DragControl,所以得放在后面
- End Sub)
- End Sub
- #End Region
- #Region "附加按钮"
- '音乐
- Private Sub BtnExtraMusic_Click(sender As Object, e As EventArgs) Handles BtnExtraMusic.Click
- MusicControlPause()
- End Sub
- Private Sub BtnExtraMusic_RightClick(sender As Object, e As EventArgs) Handles BtnExtraMusic.RightClick
- MusicControlNext()
- End Sub
- '下载管理
- Private Sub BtnExtraDownload_Click(sender As Object, e As EventArgs) Handles BtnExtraDownload.Click
- PageChange(PageType.DownloadManager)
- End Sub
- Private Function BtnExtraDownload_ShowCheck() As Boolean
- Return HasDownloadingTask() AndAlso Not PageCurrent = PageType.DownloadManager
- End Function
- '投降
- Public Sub AprilGiveup() Handles BtnExtraApril.Click
- If IsAprilEnabled AndAlso Not IsAprilGiveup Then
- Hint("=D", HintType.Finish)
- IsAprilGiveup = True
- FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
- FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
- BtnExtraApril.ShowRefresh()
- End If
- End Sub
- Public Function BtnExtraApril_ShowCheck() As Boolean
- Return IsAprilEnabled AndAlso Not IsAprilGiveup AndAlso PageCurrent = PageType.Launch
- End Function
- '关闭 Minecraft
- Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
- Try
- If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Abort()
- For Each Watcher In McWatcherList
- Watcher.Kill()
- Next
- Hint("已关闭运行中的 Minecraft!", HintType.Finish)
- Catch ex As Exception
- Log(ex, "强制关闭所有 Minecraft 失败", LogLevel.Feedback)
- End Try
- End Sub
- Public Function BtnExtraShutdown_ShowCheck() As Boolean
- Return HasRunningMinecraft
- End Function
- ''' <summary>
- ''' 返回顶部。
- ''' </summary>
- Public Sub BackToTop() Handles BtnExtraBack.Click
- Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
- RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
- End Sub
- Private Function BtnExtraBack_ShowCheck() As Boolean
- Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
- Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 700)
- End Function
- Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
- If PanMainRight.Child Is Nothing Then Return Nothing
- Dim RightChild = CType(PanMainRight.Child, AdornerDecorator).Child
- If RightChild Is Nothing Then
- Return Nothing
- ElseIf TypeOf RightChild Is MyScrollViewer Then
- Return RightChild
- ElseIf TypeOf RightChild Is Grid AndAlso TypeOf CType(RightChild, Grid).Children(0) Is MyScrollViewer Then
- Return CType(RightChild, Grid).Children(0)
- Else
- Return Nothing
- End If
- End Function
- #End Region
- '愚人节鼠标位置
- Public lastMouseArg As MouseEventArgs = Nothing
- Private Sub FormMain_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
- lastMouseArg = e
- End Sub
- End Class
|