FormMain.xaml.vb 82 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663
  1. Imports System.ComponentModel
  2. Imports System.Windows.Interop
  3. Public Class FormMain
  4. #Region "基础"
  5. '更新日志
  6. Private Sub ShowUpdateLog(LastVersion As Integer)
  7. Dim FeatureCount As Integer = 0, BugCount As Integer = 0
  8. Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
  9. '统计更新日志条目
  10. If BuildType = BuildTypes.Release Then
  11. If LastVersion < 406 Then 'Release 2.13.0.0
  12. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:重做 Java 管理与相关设置,允许调整 Java 优先级、指定 Java 版本范围等"))
  13. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:导出整合包时允许自动导出版本文件夹中的 Java"))
  14. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:重做弹出提示的样式以及动画,以更符合现代 UI 审美"))
  15. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法安装 OptiFine 26.1.2"))
  16. FeatureCount += 35
  17. BugCount += 17
  18. End If
  19. If LastVersion < 404 Then 'Release 2.12.8.2
  20. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网"))
  21. FeatureCount += 1
  22. BugCount += 2
  23. End If
  24. If LastVersion < 402 Then 'Release 2.12.8.1
  25. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:升级框架到 .NET Framework 4.8"))
  26. FeatureCount += 35
  27. BugCount += 21
  28. End If
  29. If LastVersion < 398 Then 'Release 2.12.7.3
  30. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:下载游戏、整合包的稳定性"))
  31. FeatureCount += 1
  32. BugCount += 5
  33. End If
  34. If LastVersion < 391 Then 'Release 2.12.6.2
  35. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
  36. BugCount += 4
  37. End If
  38. If LastVersion < 389 Then 'Release 2.12.6.1
  39. If LastVersion = 387 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
  40. FeatureCount += 4
  41. BugCount += 3
  42. End If
  43. If LastVersion < 387 Then 'Release 2.12.6
  44. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
  45. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
  46. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
  47. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
  48. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
  49. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
  50. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
  51. FeatureCount += 24
  52. BugCount += 19
  53. End If
  54. If LastVersion < 383 Then 'Release 2.12.3
  55. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
  56. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
  57. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
  58. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
  59. FeatureCount += 15
  60. BugCount += 16
  61. End If
  62. If LastVersion < 381 Then 'Release 2.12.2
  63. FeatureCount += 3
  64. BugCount += 13
  65. End If
  66. If LastVersion < 379 Then 'Release 2.12.1
  67. If LastVersion >= 376 Then
  68. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
  69. End If
  70. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
  71. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
  72. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
  73. FeatureCount += 33
  74. BugCount += 29
  75. End If
  76. If LastVersion < 376 Then 'Release 2.11.2
  77. 'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
  78. FeatureCount += 32
  79. BugCount += 21
  80. End If
  81. Else
  82. '5: FEAT+
  83. '4: IMP+ FEAT*
  84. '3:BUG+ IMP* FEAT-
  85. '2:BUG* IMP-
  86. '1:BUG-
  87. If LastVersion < 405 Then 'Snapshot 2.13.0.0
  88. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:重做 Java 管理与相关设置,允许调整 Java 优先级、指定 Java 版本范围等"))
  89. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:导出整合包时允许自动导出版本文件夹中的 Java"))
  90. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:重做弹出提示的样式以及动画,以更符合现代 UI 审美"))
  91. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法安装 OptiFine 26.1.2"))
  92. FeatureCount += 35
  93. BugCount += 17
  94. End If
  95. If LastVersion < 403 Then 'Snapshot 2.12.8.2
  96. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网"))
  97. FeatureCount += 1
  98. BugCount += 2
  99. End If
  100. If LastVersion < 401 Then 'Snapshot 2.12.8.1
  101. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法更换披风"))
  102. FeatureCount += 8
  103. BugCount += 6
  104. End If
  105. If LastVersion < 399 Then 'Snapshot 2.12.8.0
  106. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:升级框架到 .NET Framework 4.8"))
  107. FeatureCount += 28
  108. BugCount += 19
  109. End If
  110. If LastVersion < 397 Then 'Snapshot 2.12.7.3
  111. If LastVersion >= 393 AndAlso LastVersion < 397 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法使用自定义隐藏主题"))
  112. End If
  113. If LastVersion < 395 Then 'Snapshot 2.12.7.2
  114. If LastVersion = 393 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分个性化功能失效"))
  115. End If
  116. If LastVersion < 393 Then 'Snapshot 2.12.7.1
  117. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:允许永久关闭启动页面的快照版提示"))
  118. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:下载游戏、整合包的稳定性"))
  119. FeatureCount += 1
  120. BugCount += 5
  121. End If
  122. If LastVersion < 390 Then 'Snapshot 2.12.6.2
  123. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
  124. BugCount += 4
  125. End If
  126. If LastVersion < 388 Then 'Snapshot 2.12.6.1
  127. If LastVersion = 386 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
  128. FeatureCount += 4
  129. BugCount += 3
  130. End If
  131. If LastVersion < 386 Then 'Snapshot 2.12.6
  132. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
  133. If LastVersion = 384 OrElse LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法正常重命名游戏版本"))
  134. If LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法显示 Modrinth 整合包的版本列表"))
  135. BugCount += 1
  136. End If
  137. If LastVersion < 385 Then 'Snapshot 2.12.5
  138. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
  139. If LastVersion = 384 Then
  140. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能失败,提示下载管理刷新线程出错"))
  141. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法保存选择的 Minecraft 文件夹"))
  142. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:使用中文搜索 Mod 时,部分结果会忽略筛选条件"))
  143. End If
  144. FeatureCount += 3
  145. BugCount += 6
  146. End If
  147. If LastVersion < 384 Then 'Snapshot 2.12.4
  148. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
  149. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
  150. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
  151. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
  152. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
  153. FeatureCount += 21
  154. BugCount += 14
  155. End If
  156. If LastVersion < 382 Then 'Snapshot 2.12.3
  157. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
  158. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
  159. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
  160. FeatureCount += 15
  161. BugCount += 16
  162. End If
  163. If LastVersion < 380 Then 'Snapshot 2.12.2
  164. FeatureCount += 3
  165. BugCount += 13
  166. End If
  167. If LastVersion < 378 Then 'Snapshot 2.12.1
  168. If LastVersion >= 377 Then
  169. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在版本列表中存在 OptiFine 时可能无法加载版本列表"))
  170. BugCount += 2
  171. End If
  172. End If
  173. If LastVersion < 377 Then 'Snapshot 2.12.0
  174. If LastVersion >= 373 Then
  175. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
  176. End If
  177. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
  178. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
  179. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
  180. FeatureCount += 33
  181. BugCount += 29
  182. End If
  183. If LastVersion < 375 Then 'Snapshot 2.11.2
  184. 'If LastVersion >= 373 Then
  185. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性"))
  186. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主"))
  187. 'End If
  188. FeatureCount += 16
  189. BugCount += 4
  190. End If
  191. If LastVersion < 374 Then 'Snapshot 2.11.1
  192. 'If LastVersion >= 373 Then
  193. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:使用离线登录也可以直接加入联机房间了"))
  194. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:会从所有共享节点中自动选择负载最低的进行中继连接"))
  195. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若复制了邀请码,则可以直接快速加入房间"))
  196. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间"))
  197. ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点"))
  198. 'End If
  199. FeatureCount += 9
  200. BugCount += 7
  201. End If
  202. If LastVersion < 373 Then 'Snapshot 2.11.0
  203. 'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
  204. FeatureCount += 7
  205. BugCount += 10
  206. End If
  207. End If
  208. '整理更新日志文本
  209. Dim ContentList As New List(Of String)
  210. Dim SortedFeatures = FeatureList.OrderByDescending(Function(f) f.Key).ToList
  211. If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("没有更新日志……")
  212. For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
  213. ContentList.Add(SortedFeatures(i).Value)
  214. Next
  215. If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
  216. If FeatureCount > 0 OrElse BugCount > 0 Then
  217. ContentList.Add(If(FeatureCount > 0, FeatureCount & " 项小调整与修改", "") &
  218. If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
  219. If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
  220. ",详见完整更新日志")
  221. End If
  222. Dim Content As String = "· " & ContentList.Join(vbCrLf & "· ")
  223. '输出更新日志
  224. RunInNewThread(
  225. Sub()
  226. If MyMsgBox(Content, "PCL 已更新至" & VersionDisplay, "确定", "完整更新日志") = 2 Then
  227. OpenWebsite("https://meloong.com/afd/a/LTCat?tab=feed")
  228. End If
  229. End Sub, "UpdateLog Output")
  230. End Sub
  231. '窗口加载
  232. Private IsWindowLoadFinished As Boolean = False
  233. Public Sub New()
  234. ApplicationStartTick = GetTimeMs()
  235. '窗体参数初始化
  236. FrmMain = Me
  237. FrmLaunchLeft = New PageLaunchLeft
  238. FrmLaunchRight = New PageLaunchRight
  239. '版本号改变
  240. Dim LastVersion As Integer = Settings.Get(Of Integer)("SystemLastVersionReg")
  241. If LastVersion < VersionCode Then
  242. '触发升级
  243. UpgradeSub(LastVersion)
  244. ElseIf LastVersion > VersionCode Then
  245. '触发降级
  246. DowngradeSub(LastVersion)
  247. End If
  248. '版本隔离设置迁移
  249. If Not Settings.HasSaved("LaunchArgumentIndieV2") Then
  250. If Settings.HasSaved("LaunchArgumentIndie") Then
  251. Logger.Info("从老 PCL 迁移版本隔离")
  252. Settings.Set("LaunchArgumentIndieV2", Settings.Get(Of Integer)("LaunchArgumentIndie"))
  253. ElseIf HasIniKey("Setup", "LaunchVersionSelect") Then
  254. Logger.Info("从老 PCL 升级,但此前未调整版本隔离,使用老的版本隔离默认值")
  255. Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndie"))
  256. Else
  257. Logger.Info("全新的 PCL,使用新的版本隔离默认值")
  258. Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2"))
  259. End If
  260. End If
  261. '刷新主题
  262. ThemeCheckAll(False)
  263. ThemeRefresh(Settings.Get(Of Integer)("UiLauncherTheme"))
  264. '注册拖拽事件(不能直接加 Handles,否则没用;#6340)
  265. [AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
  266. [AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
  267. '加载 UI
  268. InitializeComponent()
  269. Opacity = 0
  270. '开启管理员权限下的文件拖拽
  271. If WindowsUtils.HasAdminRole() Then
  272. Static Helper As New DragHelper
  273. AddHandler SourceInitialized,
  274. Sub()
  275. Dim WpfHelper As New WindowInteropHelper(Me)
  276. Helper.HwndIntPtrSource = HwndSource.FromHwnd(WpfHelper.Handle)
  277. Helper.AddHook()
  278. End Sub
  279. AddHandler Closing, Sub() Helper.RemoveDragHook()
  280. AddHandler Helper.DragDrop, Sub() FileDrag(Helper.DropFilePaths)
  281. End If
  282. '切换到首页
  283. If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
  284. If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
  285. PanMainLeft.Child = FrmLaunchLeft
  286. PageLeft = FrmLaunchLeft
  287. PanMainRight.Child = FrmLaunchRight
  288. PageRight = FrmLaunchRight
  289. FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
  290. '模式提醒
  291. If BuildType = BuildTypes.Debug Then Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Red)
  292. If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会导致性能下降,若无必要请不要开启!")
  293. '尽早执行的加载池
  294. McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
  295. Logger.Info($"第二阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms")
  296. End Sub
  297. Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
  298. ApplicationStartTick = GetTimeMs()
  299. Handle = New WindowInteropHelper(Me).Handle
  300. '读取设置
  301. UpdateBackgroundAndTitleBar()
  302. PageSetupUI.HiddenRefresh()
  303. PageSetupUI.BackgroundRefresh(False, True)
  304. MusicRefreshPlay(False, True)
  305. '扩展按钮
  306. BtnExtraDownload.ShowCheck = AddressOf BtnExtraDownload_ShowCheck
  307. BtnExtraBack.ShowCheck = AddressOf BtnExtraBack_ShowCheck
  308. BtnExtraApril.ShowCheck = AddressOf BtnExtraApril_ShowCheck
  309. BtnExtraShutdown.ShowCheck = AddressOf BtnExtraShutdown_ShowCheck
  310. BtnExtraApril.ShowRefresh()
  311. '初始化尺寸改变
  312. Dim Resizer As New MyResizer(Me)
  313. Resizer.addResizerDown(ResizerB)
  314. Resizer.addResizerLeft(ResizerL)
  315. Resizer.addResizerLeftDown(ResizerLB)
  316. Resizer.addResizerLeftUp(ResizerLT)
  317. Resizer.addResizerRight(ResizerR)
  318. Resizer.addResizerRightDown(ResizerRB)
  319. Resizer.addResizerRightUp(ResizerRT)
  320. Resizer.addResizerUp(ResizerT)
  321. 'PLC 彩蛋
  322. If RandomInteger(1, 1000) = 233 Then
  323. ShapeTitleLogo.Data = New GeometryConverter().ConvertFromString("M26,29 v-25 h6 a7,7 180 0 1 0,14 h-6 M83,6.5 a10,11.5 180 1 0 0,18 M48,2.5 v24.5 h13.5")
  324. End If
  325. '加载窗口
  326. ThemeRefreshMain()
  327. Try
  328. Height = Settings.Get(Of Integer)("WindowHeight")
  329. Width = Settings.Get(Of Integer)("WindowWidth")
  330. Catch ex As Exception '修复 #2019
  331. Logger.Error(ex, "读取窗口默认大小失败", LogBehavior.Toast)
  332. Height = MinHeight + 100
  333. Width = MinWidth + 100
  334. End Try
  335. 'MinHeight = 50
  336. 'MinWidth = 50
  337. Topmost = False
  338. If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
  339. '更改窗口
  340. Top = (GetWPFSize(My.Computer.Screen.WorkingArea.Height) - Height) / 2
  341. Left = (GetWPFSize(My.Computer.Screen.WorkingArea.Width) - Width) / 2
  342. IsSizeSaveable = True
  343. ShowWindowToTop()
  344. Dim HwndSource As Interop.HwndSource = PresentationSource.FromVisual(Me)
  345. HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
  346. AniStart({
  347. AaCode(Sub() AniControlEnabled -= 1, 50),
  348. AaOpacity(Me, Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
  349. AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
  350. AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
  351. AaCode(
  352. Sub()
  353. PanBack.RenderTransform = Nothing
  354. IsWindowLoadFinished = True
  355. Logger.Info($"DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathExe}")
  356. End Sub, , True)
  357. }, "Form Show")
  358. 'Timer 启动
  359. AniStart()
  360. TimerMainStart()
  361. '加载池
  362. RunInNewThread(
  363. Sub()
  364. 'EULA 提示
  365. Const EulaVersion As Integer = 2
  366. If Settings.Get(Of Integer)("SystemEulaVersion") < EulaVersion Then
  367. Select Case MyMsgBox(
  368. If(Settings.Get(Of Integer)("SystemEulaVersion") = 0,
  369. "在使用 PCL 前,请先阅读用户协议与免责声明。",
  370. $"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"),
  371. "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
  372. Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
  373. Case 1
  374. Settings.Set("SystemEulaVersion", EulaVersion)
  375. Case 2
  376. EndProgram(False)
  377. End Select
  378. End If
  379. '启动加载器池
  380. Try
  381. JavaInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
  382. Thread.Sleep(100)
  383. DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载
  384. RunCountSub()
  385. ServerLoader.Start()
  386. RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
  387. Catch ex As Exception
  388. Logger.Error(ex, "初始化加载池运行失败")
  389. End Try
  390. '清理自动更新文件
  391. Try
  392. FileUtils.Delete(Paths.Base & "PCL\Plain Craft Launcher 2.exe")
  393. Catch ex As Exception
  394. Logger.Warn(ex, "清理自动更新文件失败")
  395. End Try
  396. '上报
  397. Telemetry("启动")
  398. '开源版本提示
  399. If VersionBranchMain = "OpenSource" Then
  400. MyMsgBox($"该版本中无法使用以下特性:{vbCrLf}- CurseForge API 调用:需要自行申请 API Key,然后添加到 ModSecret.vb 的开头{vbCrLf}- 正版登录:需要自行向微软申请 Client ID,然后添加到 ModSecret.vb 的开头{vbCrLf}- 更新与联网通知:避免滥用隐患{vbCrLf}- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……{vbCrLf}- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了……", "开源版本说明")
  401. End If
  402. End Sub, "初始化", ThreadPriority.Lowest)
  403. Logger.Info($"第三阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms")
  404. End Sub
  405. '根据打开次数触发的事件
  406. Private Sub RunCountSub()
  407. Settings.Set("SystemCount", Settings.Get(Of Integer)("SystemCount") + 1)
  408. If BuildType = BuildTypes.Snapshot Then
  409. Select Case Settings.Get(Of Integer)("SystemCount")
  410. Case 1
  411. MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
  412. "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
  413. "如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
  414. End Select
  415. If Settings.Get(Of Integer)("SystemCount") >= 99 Then
  416. If ThemeUnlock(6, False) Then
  417. MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
  418. "隐藏主题 铁杆粉 已解锁!", "提示")
  419. End If
  420. End If
  421. End If
  422. End Sub
  423. '升级与降级事件
  424. Private Sub UpgradeSub(LastVersionCode As Integer)
  425. Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}")
  426. Settings.Set("SystemLastVersionReg", VersionCode)
  427. '检查有记录的最高版本号
  428. Dim HighestVersionCode As Integer
  429. Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
  430. HighestVersionCode = Settings.Get(Of Integer)(SettingKey)
  431. If HighestVersionCode < VersionCode Then
  432. Settings.Set(SettingKey, VersionCode)
  433. Logger.Info($"最高版本号从 {HighestVersionCode} 升高到 {VersionCode}")
  434. End If
  435. '被移除的窗口设置选项
  436. If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1)
  437. '修改主题设置项名称
  438. If HighestVersionCode <= 207 Then
  439. Dim UnlockedTheme As New List(Of String) From {"2"}
  440. UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide").ToString.Split("|")))
  441. UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|")))
  442. Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Distinct.ToList.Join("|"c))
  443. End If
  444. '重置欧皇彩
  445. If LastVersionCode <= 115 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
  446. Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
  447. UnlockedTheme.Remove("13")
  448. Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
  449. MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
  450. "多谢各位的理解啦!", "重新解锁提醒")
  451. End If
  452. '重置滑稽彩
  453. If LastVersionCode <= 152 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
  454. Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
  455. UnlockedTheme.Remove("12")
  456. Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
  457. MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
  458. "多谢各位的理解啦!", "重新解锁提醒")
  459. End If
  460. '移动自定义皮肤
  461. If LastVersionCode <= 161 AndAlso FileUtils.Exists(Paths.Base & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
  462. FileUtils.Copy(Paths.Base & "PCL\CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
  463. Logger.Info("已移动离线自定义皮肤 (162)")
  464. End If
  465. If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
  466. FileUtils.Copy(PathTemp & "CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
  467. Logger.Info("已移动离线自定义皮肤 (264)")
  468. End If
  469. '解除帮助页面的隐藏
  470. If LastVersionCode <= 205 Then
  471. Settings.Set("UiHiddenOtherHelp", False)
  472. Logger.Info("已解除帮助页面的隐藏")
  473. End If
  474. '单向迁移微软登录结果(#4836)
  475. If Not Settings.Get(Of Boolean)("CacheMsV2Migrated") Then
  476. Settings.Set("CacheMsV2Migrated", True)
  477. Settings.Set("CacheMsV2OAuthRefresh", Settings.Get(Of String)("CacheMsOAuthRefresh"))
  478. Settings.Set("CacheMsV2Access", Settings.Get(Of String)("CacheMsAccess"))
  479. Settings.Set("CacheMsV2ProfileJson", Settings.Get(Of String)("CacheMsProfileJson"))
  480. Settings.Set("CacheMsV2Uuid", Settings.Get(Of String)("CacheMsUuid"))
  481. Settings.Set("CacheMsV2Name", Settings.Get(Of String)("CacheMsName"))
  482. Logger.Info("已从老版本迁移微软登录结果")
  483. End If
  484. 'Mod 命名设置迁移
  485. If Settings.HasSaved("ToolDownloadTranslate") AndAlso Not Settings.HasSaved("ToolDownloadTranslateV2") Then
  486. Settings.Set("ToolDownloadTranslateV2", Settings.Get(Of Integer)("ToolDownloadTranslate") + 1)
  487. Logger.Info("已从老版本迁移 Mod 命名设置")
  488. End If
  489. '重置 JVM 参数设置
  490. If LastVersionCode <= 381 AndAlso Settings.HasSaved("LaunchAdvanceJvm") AndAlso
  491. Settings.Get(Of String)("LaunchAdvanceJvm").ToString.Replace("-XX:+UseG1GC ", "").Replace("-XX:-UseAdaptiveSizePolicy ", "").Trim = Settings.GetDefault("LaunchAdvanceJvm") Then
  492. Settings.Reset("LaunchAdvanceJvm")
  493. Logger.Info("已重置 JVM 参数设置")
  494. End If
  495. '输出更新日志
  496. If LastVersionCode <= 0 Then Return
  497. If HighestVersionCode >= VersionCode Then Return
  498. ShowUpdateLog(HighestVersionCode)
  499. End Sub
  500. Private Sub DowngradeSub(LastVersionCode As Integer)
  501. Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}")
  502. Settings.Set("SystemLastVersionReg", VersionCode)
  503. End Sub
  504. #End Region
  505. #Region "自定义窗口"
  506. '关闭
  507. Private Sub FormMain_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
  508. EndProgram(True)
  509. e.Cancel = True
  510. End Sub
  511. ''' <summary>
  512. ''' 正常关闭程序。程序将在执行此方法后约 0.3s 退出。
  513. ''' </summary>
  514. ''' <param name="SendWarning">是否在还有下载任务未完成时发出警告。</param>
  515. Public Sub EndProgram(SendWarning As Boolean)
  516. '强行结束下载任务?
  517. If HasDownloadingTask() Then
  518. If SendWarning AndAlso MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 2 Then Return
  519. RunInNewThread(
  520. Sub()
  521. Logger.Info("正在强行停止任务")
  522. For Each Task As LoaderBase In LoaderTaskbar.ToList()
  523. Task.Cancel()
  524. Next
  525. End Sub, "强行停止下载任务")
  526. End If
  527. '关闭联机?
  528. If FrmLinkMain?.TryExit(Not SendWarning, True) Then Return
  529. '关闭
  530. RunInUiWait(
  531. Sub()
  532. IsHitTestVisible = False
  533. If PanBack.RenderTransform Is Nothing Then
  534. Dim TransformPos As New TranslateTransform(0, 0)
  535. Dim TransformRotate As New RotateTransform(0)
  536. Dim TransformScale As New ScaleTransform(1, 1)
  537. PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
  538. AniStart({
  539. AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
  540. AaDouble(
  541. Sub(i)
  542. TransformScale.ScaleX += i
  543. TransformScale.ScaleY += i
  544. End Sub, 0.88 - TransformScale.ScaleX, 180),
  545. AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
  546. AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
  547. AaCode(
  548. Sub()
  549. IsHitTestVisible = False
  550. Top = -10000
  551. ShowInTaskbar = False
  552. End Sub, 210),
  553. AaCode(AddressOf EndProgramForce, 230)
  554. }, "Form Close")
  555. Else
  556. EndProgramForce()
  557. End If
  558. Logger.Info("收到关闭指令")
  559. End Sub)
  560. End Sub
  561. Private Shared IsLogShown As Boolean = False
  562. Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success)
  563. On Error Resume Next
  564. IsProgramEnding = True
  565. AniControlEnabled += 1
  566. If IsUpdateWaitingRestart Then UpdateRestart(False)
  567. If ReturnCode = ProcessReturnValues.Exception Then
  568. If Not IsLogShown Then
  569. FeedbackInfo()
  570. Logger.Info("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告,以便于作者解决此问题!")
  571. IsLogShown = True
  572. StartProcess(Paths.Base & "PCL\Log1.txt")
  573. End If
  574. Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
  575. End If
  576. Logger.Info($"程序已退出,返回值:{ReturnCode}")
  577. ConfigUtils.SaveAll()
  578. Logger.Instance.Flush()
  579. If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode)
  580. Process.GetCurrentProcess.Kill()
  581. End Sub
  582. Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click
  583. EndProgram(True)
  584. End Sub
  585. '移动
  586. Private Sub FormDragMove(sender As Object, e As MouseButtonEventArgs) Handles PanTitle.MouseLeftButtonDown, PanMsg.MouseLeftButtonDown
  587. On Error Resume Next
  588. If sender.IsMouseDirectlyOver Then DragMove()
  589. End Sub
  590. '改变大小
  591. ''' <summary>
  592. ''' 是否可以向注册表储存尺寸改变信息。以此避免初始化时误储存。
  593. ''' </summary>
  594. Public IsSizeSaveable As Boolean = False
  595. Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
  596. If IsSizeSaveable Then
  597. Settings.Set("WindowHeight", Height)
  598. Settings.Set("WindowWidth", Width)
  599. End If
  600. RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
  601. PanForm.Width = BorderForm.ActualWidth + 0.001
  602. PanForm.Height = BorderForm.ActualHeight + 0.001
  603. PanMain.Width = PanForm.Width
  604. PanMain.Height = Math.Max(0, PanForm.Height - PanTitle.ActualHeight)
  605. If WindowState = WindowState.Maximized Then WindowState = WindowState.Normal '修复 #1938
  606. End Sub
  607. '最小化
  608. Private Sub BtnTitleMin_Click() Handles BtnTitleMin.Click
  609. WindowState = WindowState.Minimized
  610. End Sub
  611. '背景图片与标题栏
  612. Public Shared Sub UpdateBackgroundAndTitleBar(Value) '从设置更新
  613. If FrmMain Is Nothing OrElse Not FrmMain.IsLoaded Then Return
  614. FrmMain.UpdateBackgroundAndTitleBar()
  615. End Sub
  616. Public Sub UpdateBackgroundAndTitleBar()
  617. Logger.Info("从设置更新背景图片与标题栏样式")
  618. '背景图片透明度
  619. ImgBack.Opacity = Settings.Get(Of Integer)("UiBackgroundOpacity") / 1000
  620. '背景图片模糊
  621. Dim BlurRadius As Double = Settings.Get(Of Integer)("UiBackgroundBlur") + 1
  622. If BlurRadius = 1 Then
  623. ImgBack.Effect = Nothing
  624. Else
  625. ImgBack.Effect = New Effects.BlurEffect With {.Radius = BlurRadius}
  626. End If
  627. ImgBack.Margin = New Thickness(-BlurRadius / 1.8)
  628. '背景图片适应方式
  629. Dim BackgroundType As Integer = Settings.Get(Of Integer)("UiBackgroundSuit")
  630. If ImgBack.Background IsNot Nothing Then
  631. Dim Brush As ImageBrush = CType(ImgBack.Background, ImageBrush)
  632. If BackgroundType = 0 Then
  633. '智能:当图片较小时平铺,较大时适应
  634. If Brush.ImageSource.Width < PanMain.ActualWidth / 2 AndAlso Brush.ImageSource.Height < PanMain.ActualHeight / 2 Then
  635. BackgroundType = 4 '平铺
  636. Else
  637. BackgroundType = 2 '适应
  638. End If
  639. End If
  640. Brush.Stretch = Stretch.UniformToFill
  641. Brush.TileMode = TileMode.None
  642. Brush.Viewport = New Rect(0, 0, 1, 1)
  643. Brush.ViewportUnits = BrushMappingMode.RelativeToBoundingBox
  644. Brush.AlignmentX = AlignmentX.Center
  645. Brush.AlignmentY = AlignmentY.Center
  646. Select Case BackgroundType
  647. Case 1 '中
  648. Brush.Stretch = Stretch.None
  649. Case 3 '拉伸
  650. Brush.Stretch = Stretch.Fill
  651. Case 4 '平铺
  652. Brush.Stretch = Stretch.None
  653. Brush.TileMode = TileMode.Tile
  654. Brush.Viewport = New Rect(0, 0, Brush.ImageSource.Width, Brush.ImageSource.Height)
  655. Brush.ViewportUnits = BrushMappingMode.Absolute
  656. Case 2 '适应
  657. Case 5 '左上
  658. Brush.AlignmentX = AlignmentX.Left
  659. Brush.AlignmentY = AlignmentY.Top
  660. Case 6 '右上
  661. Brush.AlignmentX = AlignmentX.Right
  662. Brush.AlignmentY = AlignmentY.Top
  663. Case 7 '左下
  664. Brush.AlignmentX = AlignmentX.Left
  665. Brush.AlignmentY = AlignmentY.Bottom
  666. Case 8 '右下
  667. Brush.AlignmentX = AlignmentX.Right
  668. Brush.AlignmentY = AlignmentY.Bottom
  669. Case 9 '左
  670. Brush.AlignmentX = AlignmentX.Left
  671. Brush.AlignmentY = AlignmentY.Center
  672. Case 10 '右
  673. Brush.AlignmentX = AlignmentX.Right
  674. Brush.AlignmentY = AlignmentY.Center
  675. Case 11 '上
  676. Brush.AlignmentX = AlignmentX.Center
  677. Brush.AlignmentY = AlignmentY.Top
  678. Case 12 '下
  679. Brush.AlignmentX = AlignmentX.Center
  680. Brush.AlignmentY = AlignmentY.Bottom
  681. End Select
  682. End If
  683. '标题栏显示类型
  684. Select Case Settings.Get(Of Integer)("UiLogoType")
  685. Case 0 '无
  686. ShapeTitleLogo.Visibility = Visibility.Collapsed
  687. LabTitleLogo.Visibility = Visibility.Collapsed
  688. ImageTitleLogo.Visibility = Visibility.Collapsed
  689. If Not IsNothing(FrmSetupUI) Then 'TODO: 和 FrmSetupUI 解耦
  690. FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Visible
  691. FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
  692. FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
  693. End If
  694. Case 1 '默认
  695. ShapeTitleLogo.Visibility = Visibility.Visible
  696. LabTitleLogo.Visibility = Visibility.Collapsed
  697. ImageTitleLogo.Visibility = Visibility.Collapsed
  698. If Not IsNothing(FrmSetupUI) Then
  699. FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
  700. FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
  701. FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
  702. End If
  703. Case 2 '文本
  704. ShapeTitleLogo.Visibility = Visibility.Collapsed
  705. LabTitleLogo.Visibility = Visibility.Visible
  706. ImageTitleLogo.Visibility = Visibility.Collapsed
  707. If Not IsNothing(FrmSetupUI) Then
  708. FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
  709. FrmSetupUI.PanLogoText.Visibility = Visibility.Visible
  710. FrmSetupUI.PanLogoChange.Visibility = Visibility.Collapsed
  711. End If
  712. Case 3 '图片
  713. ShapeTitleLogo.Visibility = Visibility.Collapsed
  714. LabTitleLogo.Visibility = Visibility.Collapsed
  715. ImageTitleLogo.Visibility = Visibility.Visible
  716. If Not IsNothing(FrmSetupUI) Then
  717. FrmSetupUI.CheckLogoLeft.Visibility = Visibility.Collapsed
  718. FrmSetupUI.PanLogoText.Visibility = Visibility.Collapsed
  719. FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
  720. End If
  721. Try
  722. ImageTitleLogo.Source = Paths.Base & "PCL\Logo.png"
  723. Catch ex As Exception
  724. ImageTitleLogo.Source = Nothing
  725. Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert)
  726. End Try
  727. End Select
  728. FrmSetupUI?.CardLogo.TriggerForceResize()
  729. '标题栏文本
  730. LabTitleLogo.Text = Settings.Get(Of String)("UiLogoText")
  731. '标题栏文本是否居左
  732. PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Settings.Get(Of Boolean)("UiLogoLeft") AndAlso Settings.Get(Of Integer)("UiLogoType") = 0, 0, 1), GridUnitType.Star)
  733. End Sub
  734. #End Region
  735. #Region "窗体事件"
  736. '按键事件
  737. Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
  738. If e.IsRepeat Then Return
  739. '修复按下 Alt 后误认为弹出系统菜单导致的冻结
  740. If e.SystemKey = Key.LeftAlt OrElse e.SystemKey = Key.RightAlt Then e.Handled = True
  741. '在有弹窗时:回车选择第一个,Esc 选择最后一个
  742. If PanMsg.Children.Any Then
  743. If e.Key = Key.Enter Then
  744. CType(PanMsg.Children(0), Object).Btn1_Click()
  745. ElseIf e.Key = Key.Escape Then
  746. Dim Msg As Object = PanMsg.Children(0)
  747. If TypeOf Msg IsNot MyMsgInput AndAlso TypeOf Msg IsNot MyMsgSelect AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
  748. Msg.Btn3_Click()
  749. ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
  750. Msg.Btn2_Click()
  751. Else
  752. Msg.Btn1_Click()
  753. End If
  754. End If
  755. Return
  756. End If
  757. '==========================
  758. ' 在没有弹窗时:继续检查……
  759. '==========================
  760. '按 ESC 返回上一级
  761. If e.Key = Key.Escape Then TriggerPageBack()
  762. '更改隐藏版本可见性
  763. If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.InstanceSelect Then
  764. FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
  765. LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
  766. Return
  767. End If
  768. '更改功能隐藏可见性
  769. If e.Key = Key.F12 Then
  770. PageSetupUI.HiddenForceShow = Not PageSetupUI.HiddenForceShow
  771. If PageSetupUI.HiddenForceShow Then
  772. Hint("功能隐藏设置已暂时关闭!", HintType.Green)
  773. Else
  774. Hint("功能隐藏设置已重新开启!", HintType.Green)
  775. End If
  776. PageSetupUI.HiddenRefresh()
  777. Return
  778. End If
  779. '按 F5 刷新页面
  780. If e.Key = Key.F5 Then
  781. If TypeOf PageLeft Is IRefreshable Then CType(PageLeft, IRefreshable).Refresh()
  782. If TypeOf PageRight Is IRefreshable Then CType(PageRight, IRefreshable).Refresh()
  783. Return
  784. End If
  785. '调用启动游戏
  786. If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
  787. If IsAprilEnabled AndAlso Not IsAprilGiveup Then
  788. Hint("木大!")
  789. Else
  790. FrmLaunchLeft.LaunchButtonClick()
  791. End If
  792. End If
  793. End Sub
  794. Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
  795. '鼠标侧键返回上一级
  796. If FrmMain.PanMsg.Children.Count > 0 OrElse WaitingMyMsgBox.Any Then Return '弹窗中(#5513)
  797. If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
  798. End Sub
  799. Private Sub TriggerPageBack()
  800. If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then
  801. FrmDownloadInstall.ExitSelectPage()
  802. Else
  803. PageBack()
  804. End If
  805. End Sub
  806. '切回窗口
  807. Private Sub FormMain_Activated() Handles Me.Activated
  808. '切回窗口时自动刷新
  809. Try
  810. If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then
  811. 'Mod 管理
  812. FrmInstanceMod.ReloadModList()
  813. ElseIf PageCurrent = PageType.InstanceSetup AndAlso (PageCurrentSub = PageSubType.InstanceSetup OrElse PageCurrentSub = PageSubType.InstanceExport) Then
  814. '更新当前选用的 Java
  815. PageInstanceLeft.ReloadCurrentJava()
  816. ElseIf PageCurrent = PageType.InstanceSelect Then
  817. '版本选择
  818. LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
  819. End If
  820. Catch ex As Exception
  821. Logger.Error(ex, "切回窗口时出错")
  822. End Try
  823. '读取剪贴板,自动加入联机房间
  824. Return 'TODO: 联机复活赛
  825. If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
  826. If PageCurrent = PageType.Link Then Return '已在联机界面
  827. Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本
  828. If Settings.Get(Of String)("LinkLastAutoJoinInviteCode") = Code Then Return
  829. If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码
  830. Settings.Set("LinkLastAutoJoinInviteCode", Code)
  831. RunInThread(
  832. Sub()
  833. If MyMsgBox("嘿,是否使用复制的邀请码加入房间?", "加入联机房间", "加入", "取消") = 2 Then Return '防止弹窗阻碍主线程,所以必须放在工作线程
  834. RunInUi(
  835. Sub()
  836. PageLinkMain.Join(Code)
  837. ClipboardSet(Nothing, False)
  838. End Sub)
  839. End Sub)
  840. End Sub
  841. '文件拖放
  842. Private Sub HandleDrag(sender As Object, e As DragEventArgs)
  843. Try
  844. If e.Handled AndAlso (e.Effects <> DragDropEffects.None) Then Return
  845. e.Handled = True
  846. '缓存
  847. Static PrevData As IDataObject, PrevEffects As DragDropEffects
  848. If e.Data Is PrevData Then
  849. e.Effects = PrevEffects
  850. Return
  851. End If
  852. '确定拖放效果
  853. e.Effects = DragDropEffects.None
  854. If e.Data.GetDataPresent(DataFormats.Text) Then
  855. Dim Str As String = e.Data.GetData(DataFormats.Text)
  856. If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
  857. e.Effects = DragDropEffects.Copy
  858. ElseIf Str.StartsWithF("file:///") Then
  859. e.Effects = DragDropEffects.Copy
  860. End If
  861. ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
  862. Dim Files As String() = e.Data.GetData(DataFormats.FileDrop)
  863. If Files IsNot Nothing AndAlso Files.Length > 0 Then
  864. e.Effects = DragDropEffects.Link
  865. End If
  866. End If
  867. PrevData = e.Data
  868. PrevEffects = e.Effects
  869. Logger.Info($"设置拖放类型:{e.Effects}")
  870. Catch ex As Exception
  871. Logger.Error(ex, "处理拖放时出错")
  872. End Try
  873. End Sub
  874. Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
  875. Try
  876. ShowWindowToTop()
  877. If e.Data.GetDataPresent(DataFormats.Text) Then
  878. '获取文本
  879. Try
  880. Dim Str As String = e.Data.GetData(DataFormats.Text)
  881. Logger.Info($"接受文本拖拽:{Str}")
  882. If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
  883. 'Authlib 拖拽
  884. e.Handled = True
  885. e.Effects = DragDropEffects.Copy
  886. Dim AuthlibServer As String = StringUtils.FormUrlUnescape(Str.Substring("authlib-injector:yggdrasil-server:".Length))
  887. Logger.Info($"Authlib 拖拽:{AuthlibServer}")
  888. If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
  889. Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red)
  890. Return
  891. End If
  892. Dim Target = If(PageCurrent = PageType.InstanceSetup, PageInstanceLeft.Instance, McInstanceSelected)
  893. If Target Is Nothing Then
  894. Hint("请先下载游戏,再设置第三方登录!", HintType.Red)
  895. Return
  896. End If
  897. If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
  898. 'LittleSkin
  899. If MyMsgBox($"是否要在版本 {Target.Name} 中开启 LittleSkin 登录?" & vbCrLf &
  900. "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
  901. Return
  902. End If
  903. Settings.Set("VersionServerLogin", 4, Instance:=Target)
  904. Settings.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Instance:=Target)
  905. Settings.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Instance:=Target)
  906. Settings.Set("VersionServerAuthName", "LittleSkin 登录", Instance:=Target)
  907. Else
  908. '第三方 Authlib 服务器
  909. If MyMsgBox($"是否要在版本 {Target.Name} 中开启第三方登录?" & vbCrLf &
  910. $"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
  911. "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
  912. Return
  913. End If
  914. Settings.Set("VersionServerLogin", 4, Instance:=Target)
  915. Settings.Set("VersionServerAuthServer", AuthlibServer, Instance:=Target)
  916. Settings.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Instance:=Target)
  917. Settings.Set("VersionServerAuthName", "", Instance:=Target)
  918. End If
  919. If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceSetup Then
  920. '正在服务器选项页,需要刷新设置项显示
  921. FrmInstanceSetup.Reload()
  922. ElseIf PageCurrent = PageType.Launch Then
  923. '正在主页,需要刷新左边栏
  924. FrmLaunchLeft.RefreshPage(True, False)
  925. End If
  926. ElseIf Str.StartsWithF("file:///") Then
  927. '文件拖拽(例如从浏览器下载窗口拖入)
  928. Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
  929. e.Handled = True
  930. e.Effects = DragDropEffects.Copy
  931. FileDrag(New List(Of String) From {FilePath})
  932. End If
  933. Catch ex As Exception
  934. Logger.Warn(ex, "无法接取文本拖拽事件")
  935. Return
  936. End Try
  937. ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
  938. '获取文件并检查
  939. Dim FilePathRaw = e.Data.GetData(DataFormats.FileDrop)
  940. If FilePathRaw Is Nothing Then '#2690
  941. Hint("请将文件解压后再拖入!", HintType.Red)
  942. Return
  943. End If
  944. e.Handled = True
  945. e.Effects = DragDropEffects.Link
  946. FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
  947. End If
  948. Catch ex As Exception
  949. Logger.Error(ex, "接取拖拽事件失败")
  950. End Try
  951. End Sub
  952. Private Sub FileDrag(FilePathList As IEnumerable(Of String))
  953. RunInNewThread(
  954. Sub()
  955. Dim FilePath As String = FilePathList.First
  956. Logger.Warn($"接受文件拖拽:{FilePath}{If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", "")}")
  957. '基础检查
  958. If DirectoryUtils.Exists(FilePathList.First) AndAlso Not FileUtils.Exists(FilePathList.First) Then
  959. Hint("请拖入一个文件,而非文件夹!", HintType.Red)
  960. Return
  961. ElseIf Not FileUtils.Exists(FilePathList.First) Then
  962. Hint("拖入的文件不存在:" & FilePathList.First, HintType.Red)
  963. Return
  964. End If
  965. '多文件拖拽
  966. Dim PathList As List(Of String) = FilePathList.ToList()
  967. If FilePathList.Count > 1 Then
  968. '必须要求全部为 jar 文件
  969. For Each File In PathList
  970. If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").Lower) Then
  971. Hint("一次请只拖入一个文件!", HintType.Red)
  972. Return
  973. End If
  974. Next
  975. End If
  976. '主页
  977. Dim Extension As String = FilePath.AfterLast(".").Lower
  978. If Extension = "xaml" Then
  979. Logger.Info("文件后缀为 XAML,作为主页加载")
  980. If FileUtils.Exists(Paths.Base & "PCL\Custom.xaml") Then
  981. If MyMsgBox("已存在一个主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
  982. Return
  983. End If
  984. End If
  985. FileUtils.Copy(FilePath, Paths.Base & "PCL\Custom.xaml")
  986. RunInUi(
  987. Sub()
  988. Settings.Set("UiCustomType", 1)
  989. FrmLaunchRight.ForceRefresh()
  990. Hint("已加载主页自定义文件!", HintType.Green)
  991. End Sub)
  992. Return
  993. End If
  994. '安装 Mod
  995. If PageInstanceMod.InstallMods(PathList) Then Return
  996. '安装整合包
  997. If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
  998. Logger.Info("文件为压缩包,尝试作为整合包安装")
  999. Try
  1000. ModpackInstall(FilePath)
  1001. Return
  1002. Catch ex As Exception
  1003. If ex.IsCanceled Then Return
  1004. '安装失败,继续往后尝试
  1005. End Try
  1006. End If
  1007. 'RAR 处理
  1008. If Extension = "rar" Then
  1009. Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
  1010. Return
  1011. End If
  1012. '错误报告分析
  1013. Try
  1014. Logger.Info("尝试进行错误报告分析")
  1015. Dim Analyzer As New CrashAnalyzer
  1016. Analyzer.Import(FilePath)
  1017. If Not Analyzer.Prepare() Then Exit Try
  1018. Analyzer.Analyze()
  1019. Analyzer.Output(True, New List(Of String))
  1020. Return
  1021. Catch ex As Exception
  1022. Logger.Error(ex, "自主错误报告分析失败")
  1023. End Try
  1024. '未知操作
  1025. Hint("PCL 无法确定应当执行的文件拖拽操作……")
  1026. End Sub, "文件拖拽")
  1027. End Sub
  1028. '接受到 Windows 窗体事件
  1029. Public IsSystemTimeChanged As Boolean = False
  1030. Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
  1031. If msg = 30 Then
  1032. Dim NowDate = Date.Now
  1033. If NowDate.Date = ApplicationOpenTime.Date Then
  1034. Logger.Info($"系统时间微调为:{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
  1035. IsSystemTimeChanged = False
  1036. Else
  1037. Logger.Info($"系统时间修改为:{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
  1038. IsSystemTimeChanged = True
  1039. End If
  1040. ElseIf msg = 400 * 16 + 2 Then
  1041. Logger.Info($"收到置顶信息:{hwnd.ToInt64}")
  1042. If Not IsWindowLoadFinished Then
  1043. Logger.Info("窗口尚未加载完成,忽略置顶请求")
  1044. Return IntPtr.Zero
  1045. End If
  1046. ShowWindowToTop()
  1047. handled = True
  1048. End If
  1049. Return IntPtr.Zero
  1050. End Function
  1051. '窗口隐藏与置顶
  1052. Private _Hidden As Boolean = False
  1053. Public Property Hidden As Boolean
  1054. Get
  1055. Return _Hidden
  1056. End Get
  1057. Set(value As Boolean)
  1058. If _Hidden = value Then Return
  1059. _Hidden = value
  1060. If value Then
  1061. '隐藏
  1062. Left -= 10000
  1063. ShowInTaskbar = False
  1064. Visibility = Visibility.Hidden
  1065. Logger.Info($"窗口已隐藏,位置:({Left},{Top})")
  1066. Else
  1067. '取消隐藏
  1068. If Left < -2000 Then Left += 10000
  1069. ShowWindowToTop()
  1070. End If
  1071. End Set
  1072. End Property
  1073. ''' <summary>
  1074. ''' 把当前窗口拖到最前面。
  1075. ''' </summary>
  1076. Public Sub ShowWindowToTop()
  1077. RunInUi(
  1078. Sub()
  1079. '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
  1080. Visibility = Visibility.Visible
  1081. ShowInTaskbar = True
  1082. WindowState = WindowState.Normal
  1083. Hidden = False
  1084. Topmost = True '偶尔 SetForegroundWindow 失效
  1085. Topmost = False
  1086. SetForegroundWindow(Handle)
  1087. Focus()
  1088. Logger.Info($"窗口已置顶,位置:({Left}, {Top}), {Width} x {Height}")
  1089. End Sub)
  1090. End Sub
  1091. #End Region
  1092. #Region "切换页面"
  1093. '页面种类与属性
  1094. ''' <summary>
  1095. ''' 页面种类。
  1096. ''' 该枚举在自定义事件中使用,是公开 API 的一部分。
  1097. ''' </summary>
  1098. Public Enum PageType
  1099. ''' <summary>
  1100. ''' 启动。
  1101. ''' </summary>
  1102. Launch = 0
  1103. ''' <summary>
  1104. ''' 下载。
  1105. ''' </summary>
  1106. Download = 1
  1107. ''' <summary>
  1108. ''' 联机。
  1109. ''' </summary>
  1110. Link = 2
  1111. ''' <summary>
  1112. ''' 设置。
  1113. ''' </summary>
  1114. Setup = 3
  1115. ''' <summary>
  1116. ''' 更多。
  1117. ''' </summary>
  1118. Other = 4
  1119. ''' <summary>
  1120. ''' 版本选择。这是一个副页面。
  1121. ''' </summary>
  1122. InstanceSelect = 5
  1123. ''' <summary>
  1124. ''' 下载管理。这是一个副页面。
  1125. ''' </summary>
  1126. DownloadManager = 6
  1127. ''' <summary>
  1128. ''' 版本设置。这是一个副页面。
  1129. ''' </summary>
  1130. InstanceSetup = 7
  1131. ''' <summary>
  1132. ''' 社区资源详情。这是一个副页面。
  1133. ''' </summary>
  1134. ResourceDetail = 8
  1135. ''' <summary>
  1136. ''' 帮助详情。这是一个副页面。
  1137. ''' </summary>
  1138. HelpDetail = 9
  1139. End Enum
  1140. ''' <summary>
  1141. ''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。
  1142. ''' 该枚举在自定义事件中使用,是公开 API 的一部分。
  1143. ''' </summary>
  1144. Public Enum PageSubType
  1145. [Default] = 0
  1146. DownloadInstall = 0
  1147. DownloadMod = 2
  1148. DownloadPack = 3
  1149. DownloadDataPack = 4
  1150. DownloadResourcePack = 5
  1151. DownloadShader = 6
  1152. SetupLaunch = 0
  1153. SetupLink = 1
  1154. SetupUI = 2
  1155. SetupSystem = 3
  1156. LinkMain = 0
  1157. OtherHelp = 0
  1158. OtherAbout = 1
  1159. OtherTest = 2
  1160. InstanceOverall = 0
  1161. InstanceSetup = 1
  1162. InstanceMod = 2
  1163. InstanceModDisabled = 3
  1164. InstanceExport = 4
  1165. End Enum
  1166. ''' <summary>
  1167. ''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
  1168. ''' </summary>
  1169. Private Function PageNameGet(Stack As PageStackData) As String
  1170. Select Case Stack.Page
  1171. Case PageType.InstanceSelect
  1172. Return "版本选择"
  1173. Case PageType.DownloadManager
  1174. Return "下载管理"
  1175. Case PageType.InstanceSetup
  1176. Return "版本设置 - " & If(PageInstanceLeft.Instance Is Nothing, "未知版本", PageInstanceLeft.Instance.Name)
  1177. Case PageType.ResourceDetail
  1178. Return CType(Stack.Additional(0), ResourceProject).TranslatedName
  1179. Case PageType.HelpDetail
  1180. Return CType(Stack.Additional(0), HelpEntry).Title
  1181. Case Else
  1182. Return ""
  1183. End Select
  1184. End Function
  1185. ''' <summary>
  1186. ''' 刷新次级页面的名称。
  1187. ''' </summary>
  1188. Public Sub PageNameRefresh(Type As PageStackData)
  1189. LabTitleInner.Text = PageNameGet(Type)
  1190. End Sub
  1191. ''' <summary>
  1192. ''' 刷新次级页面的名称。
  1193. ''' </summary>
  1194. Public Sub PageNameRefresh()
  1195. PageNameRefresh(PageCurrent)
  1196. End Sub
  1197. '页面状态存储
  1198. ''' <summary>
  1199. ''' 当前的主页面。
  1200. ''' </summary>
  1201. Public PageCurrent As PageStackData = PageType.Launch
  1202. ''' <summary>
  1203. ''' 上一个主页面。
  1204. ''' </summary>
  1205. Public PageLast As PageStackData = PageType.Launch
  1206. ''' <summary>
  1207. ''' 当前的子页面。
  1208. ''' </summary>
  1209. Public ReadOnly Property PageCurrentSub As PageSubType
  1210. Get
  1211. Select Case PageCurrent
  1212. Case PageType.Download
  1213. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1214. Return FrmDownloadLeft.PageID
  1215. Case PageType.Setup
  1216. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1217. Return FrmSetupLeft.PageID
  1218. Case PageType.Other
  1219. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1220. Return FrmOtherLeft.PageID
  1221. Case PageType.InstanceSetup
  1222. If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
  1223. Return FrmInstanceLeft.PageID
  1224. Case Else
  1225. Return 0 '没有子页面
  1226. End Select
  1227. End Get
  1228. End Property
  1229. ''' <summary>
  1230. ''' 上层页面的编号堆栈,用于返回。
  1231. ''' </summary>
  1232. Public PageStack As New List(Of PageStackData)
  1233. Public Class PageStackData
  1234. Public Page As PageType
  1235. Public Additional As Object
  1236. Public Overrides Function Equals(other As Object) As Boolean
  1237. If other Is Nothing Then Return False
  1238. If TypeOf other Is PageStackData Then
  1239. Dim PageOther As PageStackData = other
  1240. If Page <> PageOther.Page Then Return False
  1241. If Additional Is Nothing Then
  1242. Return PageOther.Additional Is Nothing
  1243. Else
  1244. Return PageOther.Additional IsNot Nothing AndAlso Additional.Equals(PageOther.Additional)
  1245. End If
  1246. ElseIf TypeOf other Is Integer Then
  1247. If Page <> other Then Return False
  1248. Return Additional Is Nothing
  1249. Else
  1250. Return False
  1251. End If
  1252. End Function
  1253. Public Shared Operator =(left As PageStackData, right As PageStackData) As Boolean
  1254. Return EqualityComparer(Of PageStackData).Default.Equals(left, right)
  1255. End Operator
  1256. Public Shared Operator <>(left As PageStackData, right As PageStackData) As Boolean
  1257. Return Not left = right
  1258. End Operator
  1259. Public Shared Widening Operator CType(Value As PageType) As PageStackData
  1260. Return New PageStackData With {.Page = Value}
  1261. End Operator
  1262. Public Shared Widening Operator CType(Value As PageStackData) As PageType
  1263. Return Value.Page
  1264. End Operator
  1265. End Class
  1266. Public PageLeft As MyPageLeft, PageRight As MyPageRight
  1267. '引发实际页面切换的入口
  1268. Private IsChangingPage As Boolean = False
  1269. ''' <summary>
  1270. ''' 切换页面,并引起对应选择 UI 的改变。
  1271. ''' </summary>
  1272. Public Sub PageChange(Stack As PageStackData, Optional SubType As PageSubType = PageSubType.Default)
  1273. If PageNameGet(Stack) = "" Then
  1274. '切换到主页面
  1275. PageChangeExit()
  1276. IsChangingPage = True '防止下面的勾选直接触发了 PageChangeActual
  1277. CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "")
  1278. IsChangingPage = False
  1279. Select Case Stack.Page
  1280. Case PageType.Download
  1281. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1282. CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1283. Case PageType.Setup
  1284. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1285. CType(FrmSetupLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1286. Case PageType.Other
  1287. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1288. CType(FrmOtherLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1289. End Select
  1290. PageChangeActual(Stack, SubType)
  1291. Else
  1292. '切换到次页面
  1293. Select Case Stack.Page
  1294. Case PageType.InstanceSetup
  1295. If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
  1296. CType(FrmInstanceLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1297. End Select
  1298. PageChangeActual(Stack, SubType)
  1299. End If
  1300. End Sub
  1301. ''' <summary>
  1302. ''' 通过点击导航栏改变页面。
  1303. ''' </summary>
  1304. Private Sub BtnTitleSelect_Click(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTitleSelect0.Check, BtnTitleSelect1.Check, BtnTitleSelect2.Check, BtnTitleSelect3.Check, BtnTitleSelect4.Check
  1305. If IsChangingPage Then Return
  1306. PageChangeActual(Val(sender.Tag))
  1307. End Sub
  1308. ''' <summary>
  1309. ''' 通过点击返回按钮或手动触发返回来改变页面。
  1310. ''' </summary>
  1311. Public Sub PageBack() Handles BtnTitleInner.Click
  1312. If PageStack.Any() Then
  1313. PageChangeActual(PageStack(0))
  1314. Else
  1315. PageChange(PageType.Launch)
  1316. End If
  1317. End Sub
  1318. '实际处理页面切换
  1319. ''' <summary>
  1320. ''' 切换现有页面的实际方法。
  1321. ''' </summary>
  1322. Private Sub PageChangeActual(Stack As PageStackData, Optional SubType As PageSubType = -1)
  1323. If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Return
  1324. AniControlEnabled += 1
  1325. Try
  1326. #Region "子页面处理"
  1327. Dim PageName As String = PageNameGet(Stack)
  1328. If PageName = "" Then
  1329. '即将切换到一个顶级页面
  1330. PageChangeExit()
  1331. Else
  1332. '即将切换到一个子页面
  1333. If PageStack.Any Then
  1334. '子页面 → 另一个子页面,更新
  1335. AniStart({
  1336. AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
  1337. AaCode(Sub() LabTitleInner.Text = PageName,, True),
  1338. AaOpacity(LabTitleInner, 1, 150, 30)
  1339. }, "FrmMain Titlebar SubLayer")
  1340. If PageStack.Contains(Stack) Then
  1341. '返回到更上层的子页面
  1342. Do While PageStack.Contains(Stack)
  1343. PageStack.RemoveAt(0)
  1344. Loop
  1345. Else
  1346. '进入更深层的子页面
  1347. PageStack.Insert(0, PageCurrent)
  1348. End If
  1349. Else
  1350. '主页面 → 子页面,进入
  1351. PanTitleInner.Visibility = Visibility.Visible
  1352. PanTitleMain.IsHitTestVisible = False
  1353. PanTitleInner.IsHitTestVisible = True
  1354. PageNameRefresh(Stack)
  1355. AniStart({
  1356. AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
  1357. AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
  1358. AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
  1359. AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
  1360. AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
  1361. }, "FrmMain Titlebar FirstLayer")
  1362. PageStack.Insert(0, PageCurrent)
  1363. End If
  1364. End If
  1365. #End Region
  1366. #Region "实际更改页面框架 UI"
  1367. PageLast = PageCurrent
  1368. PageCurrent = Stack
  1369. Select Case Stack.Page
  1370. Case PageType.Launch '启动
  1371. PageChangeAnim(FrmLaunchLeft, FrmLaunchRight)
  1372. Case PageType.Download '下载
  1373. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1374. 'PageGet 方法会在未设置 SubType 时指定默认值,并建立相关页面的实例
  1375. PageChangeAnim(FrmDownloadLeft, FrmDownloadLeft.PageGet(SubType))
  1376. Case PageType.Link '联机
  1377. If FrmLinkMain Is Nothing Then FrmLinkMain = New PageLinkMain
  1378. PageChangeAnim(New MyPageLeft, FrmLinkMain)
  1379. Case PageType.Setup '设置
  1380. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1381. PageChangeAnim(FrmSetupLeft, FrmSetupLeft.PageGet(SubType))
  1382. Case PageType.Other '更多
  1383. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1384. PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType))
  1385. Case PageType.InstanceSelect '版本选择
  1386. If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft
  1387. If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight
  1388. PageChangeAnim(FrmSelectLeft, FrmSelectRight)
  1389. Case PageType.DownloadManager '下载管理
  1390. If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft
  1391. If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight
  1392. PageChangeAnim(FrmSpeedLeft, FrmSpeedRight)
  1393. Case PageType.InstanceSetup '版本设置
  1394. If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
  1395. PageChangeAnim(FrmInstanceLeft, FrmInstanceLeft.PageGet(SubType))
  1396. Case PageType.ResourceDetail '社区资源详情
  1397. If FrmDownloadResourceDetail Is Nothing Then FrmDownloadResourceDetail = New PageDownloadResourceDetail
  1398. PageChangeAnim(New MyPageLeft, FrmDownloadResourceDetail)
  1399. Case PageType.HelpDetail '帮助详情
  1400. PageChangeAnim(New MyPageLeft, Stack.Additional(1))
  1401. End Select
  1402. #End Region
  1403. #Region "设置为最新状态"
  1404. BtnExtraDownload.ShowRefresh()
  1405. BtnExtraApril.ShowRefresh()
  1406. #End Region
  1407. Logger.Info($"切换主要页面:{Stack}, {SubType}")
  1408. Catch ex As Exception
  1409. Logger.Error(ex, $"切换主要页面失败(ID {PageCurrent.Page})")
  1410. Finally
  1411. AniControlEnabled -= 1
  1412. End Try
  1413. End Sub
  1414. Private Sub PageChangeAnim(TargetLeft As FrameworkElement, TargetRight As FrameworkElement)
  1415. AniStop("FrmMain LeftChange")
  1416. AniStop("PageLeft PageChange") '停止左边栏变更导致的右页面切换动画,防止它与本动画一起触发多次 PageOnEnter
  1417. AniControlEnabled += 1
  1418. '清除新页面关联性
  1419. If Not IsNothing(TargetLeft.Parent) Then TargetLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
  1420. If Not IsNothing(TargetRight) AndAlso Not IsNothing(TargetRight.Parent) Then TargetRight.SetValue(ContentPresenter.ContentProperty, Nothing)
  1421. PageLeft = TargetLeft
  1422. PageRight = TargetRight
  1423. '触发页面通用动画
  1424. CType(PanMainLeft.Child, MyPageLeft).TriggerHideAnimation()
  1425. CType(PanMainRight.Child, MyPageRight).PageOnExit()
  1426. AniControlEnabled -= 1
  1427. '执行动画
  1428. AniStart({
  1429. AaCode(
  1430. Sub()
  1431. AniControlEnabled += 1
  1432. '把新页面添加进容器
  1433. PanMainLeft.Child = PageLeft
  1434. PageLeft.Opacity = 0
  1435. PanMainLeft.Background = Nothing
  1436. AniControlEnabled -= 1
  1437. RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
  1438. End Sub, 110),
  1439. AaCode(
  1440. Sub()
  1441. '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
  1442. PageLeft.Opacity = 1
  1443. PageLeft.TriggerShowAnimation()
  1444. End Sub, 30, True)
  1445. }, "FrmMain PageChangeLeft")
  1446. AniStart({
  1447. AaCode(
  1448. Sub()
  1449. AniControlEnabled += 1
  1450. CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
  1451. '把新页面添加进容器
  1452. PanMainRight.Child = PageRight
  1453. PageRight.Opacity = 0
  1454. PanMainRight.Background = Nothing
  1455. AniControlEnabled -= 1
  1456. RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
  1457. End Sub, 110),
  1458. AaCode(
  1459. Sub()
  1460. '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
  1461. PageRight.Opacity = 1
  1462. PageRight.PageOnEnter()
  1463. End Sub, 30, True)
  1464. }, "FrmMain PageChangeRight")
  1465. End Sub
  1466. ''' <summary>
  1467. ''' 退出子界面。
  1468. ''' </summary>
  1469. Private Sub PageChangeExit()
  1470. If PageStack.Any Then
  1471. '子页面 → 主页面,退出
  1472. PanTitleMain.Visibility = Visibility.Visible
  1473. PanTitleMain.IsHitTestVisible = True
  1474. PanTitleInner.IsHitTestVisible = False
  1475. AniStart({
  1476. AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
  1477. AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
  1478. AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
  1479. AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
  1480. AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
  1481. }, "FrmMain Titlebar FirstLayer")
  1482. PageStack.Clear()
  1483. Else
  1484. '主页面 → 主页面,无事发生
  1485. End If
  1486. End Sub
  1487. '左边栏改变
  1488. Private Sub PanMainLeft_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanMainLeft.SizeChanged
  1489. If Not e.WidthChanged Then Return
  1490. PanMainLeft_Resize(e.NewSize.Width)
  1491. End Sub
  1492. Private Sub PanMainLeft_Resize(NewWidth As Double)
  1493. Dim Delta As Double = NewWidth - RectLeftBackground.Width
  1494. If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then
  1495. If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
  1496. If NewWidth > 0 Then
  1497. '宽度足够,显示
  1498. AniStart({
  1499. AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 180,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
  1500. AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 180),
  1501. AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 150)
  1502. }, "FrmMain LeftChange", True)
  1503. Else
  1504. '宽度不足,隐藏
  1505. AniStart({
  1506. AaWidth(RectLeftBackground, -RectLeftBackground.Width, 180,, New AniEaseOutFluent),
  1507. AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 180),
  1508. AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 150)
  1509. }, "FrmMain LeftChange", True)
  1510. End If
  1511. Else
  1512. RectLeftBackground.Width = NewWidth
  1513. PanMainLeft.IsHitTestVisible = True
  1514. AniStop("FrmMain LeftChange")
  1515. End If
  1516. End Sub
  1517. #End Region
  1518. #Region "控件拖动"
  1519. '在时钟中调用,使得即使鼠标在窗口外松开,也可以释放控件
  1520. Public Sub DragTick()
  1521. If DragControl Is Nothing Then Return
  1522. If Not Mouse.LeftButton = MouseButtonState.Pressed Then
  1523. DragStop()
  1524. End If
  1525. End Sub
  1526. '在鼠标移动时调用,以改变 Slider 位置
  1527. Public Sub DragDoing() Handles PanBack.MouseMove
  1528. If DragControl Is Nothing Then Return
  1529. If Mouse.LeftButton = MouseButtonState.Pressed Then
  1530. DragControl.DragDoing()
  1531. Else
  1532. DragStop()
  1533. End If
  1534. End Sub
  1535. Public Sub DragStop()
  1536. '存在其他线程调用的可能性,因此需要确保在 UI 线程运行
  1537. RunInUi(Sub()
  1538. If DragControl Is Nothing Then Return
  1539. Dim Control = DragControl
  1540. DragControl = Nothing
  1541. Control.DragStop() '控件会在该事件中判断 DragControl,所以得放在后面
  1542. End Sub)
  1543. End Sub
  1544. #End Region
  1545. #Region "附加按钮"
  1546. '音乐
  1547. Private Sub BtnExtraMusic_Click(sender As Object, e As EventArgs) Handles BtnExtraMusic.Click
  1548. MusicControlPause()
  1549. End Sub
  1550. Private Sub BtnExtraMusic_RightClick(sender As Object, e As EventArgs) Handles BtnExtraMusic.RightClick
  1551. MusicControlNext()
  1552. End Sub
  1553. '下载管理
  1554. Private Sub BtnExtraDownload_Click(sender As Object, e As EventArgs) Handles BtnExtraDownload.Click
  1555. PageChange(PageType.DownloadManager)
  1556. End Sub
  1557. Private Function BtnExtraDownload_ShowCheck() As Boolean
  1558. Return HasDownloadingTask() AndAlso Not PageCurrent = PageType.DownloadManager
  1559. End Function
  1560. '投降
  1561. Public Sub AprilGiveup() Handles BtnExtraApril.Click
  1562. If IsAprilEnabled AndAlso Not IsAprilGiveup Then
  1563. Hint("=D", HintType.Green)
  1564. IsAprilGiveup = True
  1565. FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
  1566. FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
  1567. BtnExtraApril.ShowRefresh()
  1568. End If
  1569. End Sub
  1570. Public Function BtnExtraApril_ShowCheck() As Boolean
  1571. Return IsAprilEnabled AndAlso Not IsAprilGiveup AndAlso PageCurrent = PageType.Launch
  1572. End Function
  1573. '关闭 Minecraft
  1574. Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
  1575. Try
  1576. If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Cancel()
  1577. For Each Watcher In McWatcherList
  1578. Watcher.Kill()
  1579. Next
  1580. Hint("已关闭运行中的 Minecraft!", HintType.Green)
  1581. Catch ex As Exception
  1582. Logger.Error(ex, "强制关闭所有 Minecraft 失败")
  1583. End Try
  1584. End Sub
  1585. Public Function BtnExtraShutdown_ShowCheck() As Boolean
  1586. Return HasRunningMinecraft
  1587. End Function
  1588. ''' <summary>
  1589. ''' 返回顶部。
  1590. ''' </summary>
  1591. Public Sub BackToTop() Handles BtnExtraBack.Click
  1592. Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
  1593. If RealScroll IsNot Nothing Then
  1594. RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
  1595. Else
  1596. Logger.Error("无法返回顶部,未找到合适的 RealScroll", LogBehavior.Toast)
  1597. End If
  1598. End Sub
  1599. Private Function BtnExtraBack_ShowCheck() As Boolean
  1600. Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
  1601. Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 700)
  1602. End Function
  1603. Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
  1604. If PanMainRight.Child Is Nothing OrElse TypeOf PanMainRight.Child IsNot MyPageRight Then Return Nothing
  1605. Dim Page As MyPageRight = PanMainRight.Child
  1606. Return Page.FindName(Page.PanScroll)
  1607. End Function
  1608. #End Region
  1609. '愚人节鼠标位置
  1610. Public lastMouseArg As MouseEventArgs = Nothing
  1611. Private Sub FormMain_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
  1612. lastMouseArg = e
  1613. End Sub
  1614. End Class