FormMain.xaml.vb 76 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518
  1. Imports System.ComponentModel
  2. Public Class FormMain
  3. #Region "基础"
  4. '更新日志
  5. Private Sub ShowUpdateLog(LastVersion As Integer)
  6. Dim FeatureCount As Integer = 0, BugCount As Integer = 0
  7. Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
  8. '统计更新日志条目
  9. #If BETA Then
  10. If LastVersion < 293 Then 'Release 2.6.1
  11. BugCount += 1
  12. End If
  13. If LastVersion < 292 Then 'Release 2.6.0
  14. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
  15. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
  16. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
  17. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
  18. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
  19. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
  20. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
  21. FeatureCount += 24
  22. BugCount += 24
  23. End If
  24. If LastVersion < 286 Then 'Release 2.5.2
  25. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、安装 Modrinth 的 Mod 与整合包"))
  26. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
  27. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
  28. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
  29. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
  30. FeatureCount += 35
  31. BugCount += 36
  32. End If
  33. If LastVersion < 281 Then 'Release 2.4.9
  34. If LastVersion = 279 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
  35. FeatureCount += 1
  36. BugCount += 5
  37. End If
  38. If LastVersion < 279 Then 'Release 2.4.8
  39. FeatureCount += 1
  40. BugCount += 10
  41. End If
  42. If LastVersion < 276 Then 'Release 2.4.7
  43. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
  44. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
  45. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
  46. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
  47. FeatureCount += 25
  48. BugCount += 56
  49. End If
  50. If LastVersion < 272 Then 'Release 2.4.4
  51. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
  52. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
  53. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色,让整体边框变得更淡"))
  54. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
  55. If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
  56. FeatureCount += 13
  57. BugCount += 23
  58. End If
  59. If LastVersion < 268 Then 'Release 2.4.2
  60. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
  61. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
  62. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
  63. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
  64. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
  65. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
  66. FeatureCount += 14
  67. BugCount += 33
  68. End If
  69. If LastVersion < 265 Then 'Release 2.3.5
  70. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
  71. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
  72. FeatureCount += 13
  73. BugCount += 9
  74. End If
  75. If LastVersion < 260 Then 'Release 2.3.2
  76. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
  77. FeatureCount += 22
  78. BugCount += 4
  79. End If
  80. If LastVersion < 257 Then 'Release 2.3.0
  81. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug"))
  82. FeatureCount += 4
  83. BugCount += 4
  84. End If
  85. If LastVersion < 255 Then 'Release 2.2.14
  86. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
  87. FeatureCount += 5
  88. BugCount += 3
  89. End If
  90. If LastVersion < 253 Then 'Release 2.2.13
  91. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
  92. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
  93. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
  94. FeatureCount += 13
  95. BugCount += 27
  96. End If
  97. If LastVersion < 250 Then 'Release 2.2.11
  98. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持将 Mod 文件拖入窗口进行安装"))
  99. If LastVersion = 246 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用中文搜索 Mod 的 Bug"))
  100. FeatureCount += 8
  101. BugCount += 33
  102. End If
  103. #Else
  104. '5: FEAT+
  105. '4: IMP+ FEAT*
  106. '3:BUG+ IMP* FEAT-
  107. '2:BUG* IMP-
  108. '1:BUG-
  109. If LastVersion < 294 Then 'Snapshot 2.6.2
  110. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3"))
  111. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric"))
  112. FeatureCount += 9
  113. BugCount += 16
  114. End If
  115. If LastVersion < 291 Then 'Snapshot 2.6.0
  116. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
  117. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
  118. FeatureCount += 10
  119. BugCount += 2
  120. End If
  121. If LastVersion < 289 Then 'Snapshot 2.5.4
  122. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
  123. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
  124. FeatureCount += 6
  125. BugCount += 14
  126. End If
  127. If LastVersion < 288 Then 'Snapshot 2.5.3
  128. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
  129. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
  130. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
  131. FeatureCount += 8
  132. BugCount += 8
  133. End If
  134. If LastVersion < 285 Then 'Snapshot 2.5.2
  135. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
  136. If LastVersion = 284 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复打开部分帮助报错的 Bug"))
  137. FeatureCount += 8
  138. BugCount += 8
  139. End If
  140. If LastVersion < 284 Then 'Snapshot 2.5.1
  141. If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
  142. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
  143. FeatureCount += 22
  144. BugCount += 21
  145. End If
  146. If LastVersion < 283 Then 'Snapshot 2.5.0
  147. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包"))
  148. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
  149. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包"))
  150. FeatureCount += 5
  151. BugCount += 5
  152. End If
  153. If LastVersion < 282 Then 'Snapshot 2.4.9
  154. FeatureCount += 1
  155. BugCount += 5
  156. If LastVersion = 280 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
  157. End If
  158. If LastVersion < 280 Then 'Snapshot 2.4.8
  159. FeatureCount += 1
  160. BugCount += 10
  161. End If
  162. If LastVersion < 278 Then 'Snapshot 2.4.7
  163. If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
  164. BugCount += 2
  165. End If
  166. If LastVersion < 277 Then 'Snapshot 2.4.6
  167. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
  168. FeatureCount += 8
  169. BugCount += 21
  170. End If
  171. If LastVersion < 275 Then 'Snapshot 2.4.5
  172. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
  173. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
  174. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
  175. FeatureCount += 17
  176. BugCount += 35
  177. End If
  178. If LastVersion < 273 Then 'Snapshot 2.4.4
  179. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
  180. If LastVersion = 271 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法同时开启多个 Minecraft 客户端的 Bug"))
  181. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
  182. FeatureCount += 7
  183. BugCount += 8
  184. End If
  185. If LastVersion < 271 Then 'Snapshot 2.4.3
  186. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
  187. If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
  188. FeatureCount += 6
  189. BugCount += 15
  190. End If
  191. If LastVersion < 269 Then 'Snapshot 2.4.2
  192. If LastVersion = 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载 CurseForge 整合包的 Bug"))
  193. FeatureCount += 2
  194. BugCount += 3
  195. End If
  196. If LastVersion < 267 Then 'Snapshot 2.4.1
  197. FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
  198. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
  199. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
  200. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
  201. FeatureCount += 12
  202. BugCount += 22
  203. End If
  204. If LastVersion < 266 Then 'Snapshot 2.4.0
  205. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
  206. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
  207. FeatureCount += 3
  208. BugCount += 11
  209. End If
  210. If LastVersion < 264 Then 'Snapshot 2.3.5
  211. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动部分 Forge 版本的 Bug"))
  212. FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
  213. FeatureCount += 2
  214. BugCount += 3
  215. End If
  216. If LastVersion < 263 Then 'Snapshot 2.3.4
  217. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
  218. FeatureCount += 11
  219. BugCount += 5
  220. End If
  221. If LastVersion < 262 Then 'Snapshot 2.3.3
  222. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "修复无法使用 Mod、整合包搜索功能的 Bug"))
  223. BugCount += 1
  224. End If
  225. If LastVersion < 261 Then 'Snapshot 2.3.2
  226. FeatureCount += 8
  227. BugCount += 4
  228. End If
  229. If LastVersion < 259 Then 'Snapshot 2.3.1
  230. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
  231. FeatureCount += 14
  232. End If
  233. If LastVersion < 258 Then 'Snapshot 2.3.0
  234. FeatureCount += 4
  235. BugCount += 4
  236. End If
  237. If LastVersion < 256 Then 'Snapshot 2.2.14
  238. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug"))
  239. FeatureCount += 5
  240. BugCount += 3
  241. End If
  242. If LastVersion < 254 Then 'Snapshot 2.2.13
  243. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持调整 Mod 文件名中中文译名的位置"))
  244. FeatureCount += 3
  245. BugCount += 17
  246. End If
  247. If LastVersion < 252 Then 'Snapshot 2.2.12
  248. FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在安装菜单中直接安装 OptiFabric"))
  249. FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "崩溃分析优化,支持分析更多 Forge 相关的崩溃"))
  250. If LastVersion = 251 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复同时安装 Forge 和 OptiFine 时 OptiFine 无效的 Bug"))
  251. FeatureCount += 10
  252. BugCount += 10
  253. End If
  254. If LastVersion < 251 Then 'Snapshot 2.2.11
  255. FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持将 Mod 文件拖入窗口进行安装"))
  256. FeatureCount += 2
  257. BugCount += 16
  258. End If
  259. #End If
  260. '整理更新日志文本
  261. Dim ContentList As New List(Of String)
  262. Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
  263. Return Left.Key > Right.Key
  264. End Function)
  265. If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
  266. ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
  267. End If
  268. For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
  269. ContentList.Add(SortedFeatures(i).Value)
  270. Next
  271. If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
  272. If FeatureCount > 0 OrElse BugCount > 0 Then
  273. ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") &
  274. If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
  275. If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
  276. ",详见完整更新日志")
  277. End If
  278. Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ")
  279. '输出更新日志
  280. RunInNewThread(Sub()
  281. If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
  282. OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
  283. End If
  284. End Sub, "UpdateLog Output")
  285. End Sub
  286. '窗口加载
  287. Private IsWindowLoadFinished As Boolean = False
  288. ''' <summary>
  289. ''' 是否为联机提权后自动重启。
  290. ''' </summary>
  291. Public Shared IsLinkRestart As Boolean = False
  292. Public Sub New()
  293. ApplicationStartTick = GetTimeTick()
  294. '窗体参数初始化
  295. FrmMain = Me
  296. FrmLaunchLeft = New PageLaunchLeft
  297. FrmLaunchRight = New PageLaunchRight
  298. '版本号改变
  299. Dim LastVersion As Integer = Setup.Get("SystemLastVersionReg")
  300. If LastVersion < VersionCode Then
  301. '触发升级
  302. UpgradeSub(LastVersion)
  303. ElseIf LastVersion > VersionCode Then
  304. '触发降级
  305. DowngradeSub(LastVersion)
  306. End If
  307. ''刷新语言
  308. 'Lang = ReadReg("Lang", "zh_CN")
  309. 'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)}
  310. '刷新主题
  311. ThemeCheckAll(False)
  312. Setup.Load("UiLauncherTheme")
  313. '加载 UI
  314. InitializeComponent()
  315. Opacity = 0
  316. '切换到首页
  317. If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
  318. If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
  319. PanMainLeft.Child = FrmLaunchLeft
  320. PanMainRight.Child = FrmLaunchRight
  321. FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
  322. If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
  323. '模式提醒
  324. #If DEBUG Then
  325. Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
  326. #End If
  327. If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会造成性能的下降,若无必要请不要开启!")
  328. '尽早执行的加载池
  329. McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
  330. Log("[Start] 第二阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
  331. End Sub
  332. Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
  333. ApplicationStartTick = GetTimeTick()
  334. Handle = New Interop.WindowInteropHelper(Me).Handle
  335. '读取设置
  336. Setup.Load("UiBackgroundOpacity")
  337. Setup.Load("UiBackgroundBlur")
  338. Setup.Load("UiLogoType")
  339. Setup.Load("UiHiddenPageDownload")
  340. BackgroundRefresh(False, True)
  341. MusicRefreshPlay(False, True)
  342. '扩展按钮
  343. BtnExtraDownload.ShowCheck = AddressOf BtnExtraDownload_ShowCheck
  344. BtnExtraBack.ShowCheck = AddressOf BtnExtraBack_ShowCheck
  345. BtnExtraApril.ShowCheck = AddressOf BtnExtraApril_ShowCheck
  346. BtnExtraShutdown.ShowCheck = AddressOf BtnExtraShutdown_ShowCheck
  347. BtnExtraApril.ShowRefresh()
  348. '初始化尺寸改变
  349. Dim Resizer As New MyResizer(Me)
  350. Resizer.addResizerDown(ResizerB)
  351. Resizer.addResizerLeft(ResizerL)
  352. Resizer.addResizerLeftDown(ResizerLB)
  353. Resizer.addResizerLeftUp(ResizerLT)
  354. Resizer.addResizerRight(ResizerR)
  355. Resizer.addResizerRightDown(ResizerRB)
  356. Resizer.addResizerRightUp(ResizerRT)
  357. Resizer.addResizerUp(ResizerT)
  358. 'PLC 彩蛋
  359. If RandomInteger(1, 1000) = 233 Then
  360. 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")
  361. End If
  362. '加载窗口
  363. ThemeRefreshMain()
  364. Height = ReadReg("WindowHeight", MinHeight + 50)
  365. Width = ReadReg("WindowWidth", MinWidth + 50)
  366. Topmost = False
  367. If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
  368. '更改窗口
  369. Top = (GetWPFSize(My.Computer.Screen.WorkingArea.Height) - Height) / 2
  370. Left = (GetWPFSize(My.Computer.Screen.WorkingArea.Width) - Width) / 2
  371. IsSizeSaveable = True
  372. ShowWindowToTop()
  373. Dim HwndSource As Interop.HwndSource = PresentationSource.FromVisual(Me)
  374. HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
  375. AniStart({
  376. AaCode(Sub() AniControlEnabled -= 1, 50),
  377. AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
  378. AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
  379. AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
  380. AaCode(Sub()
  381. PanBack.RenderTransform = Nothing
  382. IsWindowLoadFinished = True
  383. Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
  384. End Sub, , True)
  385. }, "Form Show")
  386. 'Timer 启动
  387. AniStartRun()
  388. TimerMainStartRun()
  389. '加载池
  390. RunInNewThread(Sub()
  391. If Not Setup.Get("SystemEula") Then
  392. Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
  393. Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
  394. Case 1
  395. Setup.Set("SystemEula", True)
  396. Case 2
  397. EndProgram(False)
  398. End Select
  399. End If
  400. Try
  401. JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
  402. Thread.Sleep(200)
  403. DlClientListMojangLoader.Start(1)
  404. RunCountSub()
  405. ServerLoader.Start(1)
  406. Catch ex As Exception
  407. Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
  408. End Try
  409. Try
  410. If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
  411. Catch ex As Exception
  412. Log(ex, "清理自动更新文件失败")
  413. End Try
  414. End Sub, "Start Loader", ThreadPriority.Lowest)
  415. Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
  416. End Sub
  417. '根据打开次数触发的事件
  418. Private Sub RunCountSub()
  419. Setup.Set("SystemCount", Setup.Get("SystemCount") + 1)
  420. #If Not BETA Then
  421. Select Case Setup.Get("SystemCount")
  422. Case 1
  423. MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
  424. "快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
  425. "如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
  426. End Select
  427. If Setup.Get("SystemCount") >= 99 Then
  428. If ThemeUnlock(6, False) Then
  429. MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
  430. "隐藏主题 铁杆粉 已解锁!", "提示")
  431. End If
  432. End If
  433. #End If
  434. End Sub
  435. '升级与降级事件
  436. Private Sub UpgradeSub(LastVersionCode As Integer)
  437. Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode)
  438. Setup.Set("SystemLastVersionReg", VersionCode)
  439. '检查有记录的最高版本号
  440. Dim LowerVersionCode As Integer
  441. #If BETA Then
  442. LowerVersionCode = Setup.Get("SystemHighestBetaVersionReg")
  443. If LowerVersionCode < VersionCode Then
  444. Setup.Set("SystemHighestBetaVersionReg", VersionCode)
  445. Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
  446. End If
  447. #Else
  448. LowerVersionCode = Setup.Get("SystemHighestAlphaVersionReg")
  449. If LowerVersionCode < VersionCode Then
  450. Setup.Set("SystemHighestAlphaVersionReg", VersionCode)
  451. Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
  452. End If
  453. #End If
  454. '修改主题设置项名称
  455. If LowerVersionCode <= 207 Then
  456. Dim UnlockedTheme As New List(Of String) From {"2"}
  457. UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide").ToString.Split("|")))
  458. UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")))
  459. Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme.Distinct.ToList, "|"))
  460. End If
  461. '重置欧皇彩
  462. If LastVersionCode <= 115 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
  463. Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
  464. UnlockedTheme.Remove("13")
  465. Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
  466. MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
  467. "多谢各位的理解啦!", "重新解锁提醒")
  468. End If
  469. '重置滑稽彩
  470. If LastVersionCode <= 152 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
  471. Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
  472. UnlockedTheme.Remove("12")
  473. Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
  474. MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
  475. "多谢各位的理解啦!", "重新解锁提醒")
  476. End If
  477. '移动自定义皮肤
  478. If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
  479. CopyFile(Path & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
  480. Log("[Start] 已移动离线自定义皮肤 (162)")
  481. End If
  482. If LastVersionCode <= 263 AndAlso File.Exists(PathTemp & "CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
  483. CopyFile(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
  484. Log("[Start] 已移动离线自定义皮肤 (264)")
  485. End If
  486. '解除帮助页面的隐藏
  487. If LastVersionCode <= 205 Then
  488. Setup.Set("UiHiddenOtherHelp", False)
  489. Log("[Start] 已解除帮助页面的隐藏")
  490. End If
  491. '输出更新日志
  492. If LastVersionCode = 0 Then Exit Sub
  493. If LowerVersionCode >= VersionCode Then Exit Sub
  494. ShowUpdateLog(LowerVersionCode)
  495. End Sub
  496. Private Sub DowngradeSub(LastVersionCode As Integer)
  497. Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode)
  498. Setup.Set("SystemLastVersionReg", VersionCode)
  499. End Sub
  500. #End Region
  501. #Region "自定义窗口"
  502. '关闭
  503. Private Sub FormMain_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
  504. EndProgram(True)
  505. e.Cancel = True
  506. End Sub
  507. ''' <summary>
  508. ''' 正常关闭程序。程序将在执行此方法后约 0.3s 退出。
  509. ''' </summary>
  510. ''' <param name="SendWarning">是否在还有下载任务未完成时发出警告。</param>
  511. Public Sub EndProgram(SendWarning As Boolean)
  512. '发出警告
  513. If SendWarning AndAlso HasDownloadingTask() Then
  514. If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then
  515. '强行结束下载任务
  516. RunInNewThread(Sub()
  517. Log("[System] 正在强行停止任务")
  518. For Each Task As LoaderBase In LoaderTaskbar.ToArray
  519. Task.Abort()
  520. Next
  521. End Sub, "强行停止下载任务")
  522. Else
  523. Exit Sub
  524. End If
  525. End If
  526. '关闭
  527. RunInUiWait(
  528. Sub()
  529. IsHitTestVisible = False
  530. If PanBack.RenderTransform Is Nothing Then
  531. Dim TransformPos As New TranslateTransform(0, 0)
  532. Dim TransformRotate As New RotateTransform(0)
  533. Dim TransformScale As New ScaleTransform(1, 1)
  534. PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
  535. AniStart({
  536. AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
  537. AaDouble(Sub(i)
  538. TransformScale.ScaleX += i
  539. TransformScale.ScaleY += i
  540. End Sub, 0.88 - TransformScale.ScaleX, 180),
  541. AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
  542. AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
  543. AaCode(Sub()
  544. IsHitTestVisible = False
  545. Top = -10000
  546. ShowInTaskbar = False
  547. End Sub, 210),
  548. AaCode(AddressOf EndProgramForce, 230)
  549. }, "Form Close")
  550. Else
  551. EndProgramForce()
  552. End If
  553. Log("[System] 收到关闭指令")
  554. End Sub)
  555. End Sub
  556. Private Shared IsLogShown As Boolean = False
  557. Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success)
  558. On Error Resume Next
  559. IsProgramEnded = True
  560. AniControlEnabled += 1
  561. PageLinkIoi.IoiStop(False)
  562. PageLinkHiper.HiperStop(False)
  563. If IsUpdateWaitingRestart Then UpdateRestart(False)
  564. If ReturnCode = Result.Exception Then
  565. If Not IsLogShown Then
  566. FeedbackInfo()
  567. Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告,以便于作者解决此问题!")
  568. IsLogShown = True
  569. ShellOnly(Path & "PCL\Log1.txt")
  570. End If
  571. Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
  572. End If
  573. Log("[System] 程序已退出,返回值:" & GetStringFromEnum(CType(ReturnCode, [Enum])))
  574. LogFlush()
  575. If ReturnCode = Result.Success Then
  576. Process.GetCurrentProcess.Kill()
  577. Else
  578. Environment.Exit(ReturnCode)
  579. End If
  580. End Sub
  581. Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click
  582. EndProgram(True)
  583. End Sub
  584. '移动
  585. Private Sub FormDragMove(sender As Object, e As MouseButtonEventArgs) Handles PanTitle.MouseLeftButtonDown, PanMsg.MouseLeftButtonDown
  586. On Error Resume Next
  587. If sender.IsMouseDirectlyOver Then DragMove()
  588. End Sub
  589. '改变大小
  590. ''' <summary>
  591. ''' 是否可以向注册表储存尺寸改变信息。以此避免初始化时误储存。
  592. ''' </summary>
  593. Public IsSizeSaveable As Boolean = False
  594. Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
  595. If IsSizeSaveable Then
  596. WriteReg("WindowHeight", Height)
  597. WriteReg("WindowWidth", Width)
  598. End If
  599. RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
  600. PanForm.Width = BorderForm.ActualWidth + 0.001
  601. PanForm.Height = BorderForm.ActualHeight + 0.001
  602. PanMain.Width = PanForm.Width
  603. PanMain.Height = Math.Max(0, PanForm.Height - PanTitle.ActualHeight)
  604. End Sub
  605. '最小化
  606. Private Sub BtnTitleMin_Click() Handles BtnTitleMin.Click
  607. WindowState = WindowState.Minimized
  608. End Sub
  609. #End Region
  610. #Region "窗体事件"
  611. '按键事件
  612. Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
  613. If e.IsRepeat Then Exit Sub
  614. '调用弹窗:回车选择第一个,Esc 选择最后一个
  615. If PanMsg.Children.Count > 0 Then
  616. If e.Key = Key.Enter Then
  617. CType(PanMsg.Children(0), Object).Btn1_Click()
  618. Exit Sub
  619. ElseIf e.Key = Key.Escape Then
  620. Dim Msg As Object = PanMsg.Children(0)
  621. If TypeOf Msg Is MyMsgText AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
  622. Msg.Btn3_Click()
  623. ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
  624. Msg.Btn2_Click()
  625. Else
  626. Msg.Btn1_Click()
  627. End If
  628. Exit Sub
  629. End If
  630. End If
  631. '按 ESC 返回上一级
  632. If e.Key = Key.Escape Then TriggerPageBack()
  633. '更改隐藏版本可见性
  634. If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.VersionSelect Then
  635. FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
  636. LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
  637. Exit Sub
  638. End If
  639. '更改功能隐藏可见性
  640. If e.Key = Key.F12 Then
  641. PageSetupUI.HiddenForceShow = Not PageSetupUI.HiddenForceShow
  642. If PageSetupUI.HiddenForceShow Then
  643. Hint("功能隐藏设置已暂时关闭!", HintType.Finish)
  644. Else
  645. Hint("功能隐藏设置已重新开启!", HintType.Finish)
  646. End If
  647. PageSetupUI.HiddenRefresh()
  648. Exit Sub
  649. End If
  650. '调用启动游戏
  651. If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
  652. If IsAprilEnabled AndAlso Not IsAprilGiveup Then
  653. Hint("木大!")
  654. Else
  655. FrmLaunchLeft.LaunchButtonClick()
  656. End If
  657. End If
  658. '修复按下 Alt 后误认为弹出系统菜单导致的冻结
  659. If e.SystemKey = Key.LeftAlt OrElse e.SystemKey = Key.RightAlt Then e.Handled = True
  660. End Sub
  661. Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
  662. '鼠标侧键返回上一级
  663. If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
  664. End Sub
  665. Private Sub TriggerPageBack()
  666. If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
  667. FrmDownloadInstall.ExitSelectPage()
  668. Else
  669. PageBack()
  670. End If
  671. End Sub
  672. '切回窗口
  673. Private Sub FormMain_Activated() Handles Me.Activated
  674. Try
  675. If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
  676. 'Mod 管理自动刷新
  677. FrmVersionMod.RefreshList()
  678. ElseIf PageCurrent = PageType.VersionSelect Then
  679. '版本选择自动刷新
  680. LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
  681. End If
  682. Catch ex As Exception
  683. Log(ex, "切回窗口时出错", LogLevel.Feedback)
  684. End Try
  685. End Sub
  686. '文件拖放
  687. Private Sub FrmMain_PreviewDragOver(sender As Object, e As DragEventArgs) Handles Me.PreviewDragOver
  688. If e.Data.GetFormats.Contains("FileDrop") Then
  689. e.Effects = DragDropEffects.Link
  690. Else
  691. e.Effects = DragDropEffects.None
  692. End If
  693. End Sub
  694. Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.PreviewDrop
  695. Try
  696. If e.Data.GetDataPresent(DataFormats.Text) Then
  697. '获取文本
  698. Try
  699. Dim Str As String = e.Data.GetData(DataFormats.Text)
  700. Log("[System] 接受文本拖拽:" & Str)
  701. If Str.StartsWith("authlib-injector:yggdrasil-server:") Then
  702. 'Authlib 拖拽
  703. e.Handled = True
  704. Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
  705. Log("[System] Authlib 拖拽:" & AuthlibServer)
  706. If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
  707. Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Critical)
  708. Exit Sub
  709. End If
  710. If McVersionCurrent Is Nothing Then
  711. Hint("请先下载游戏,再设置第三方登录!", HintType.Critical)
  712. Exit Sub
  713. End If
  714. If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
  715. 'LittleSkin
  716. If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启 LittleSkin 登录?" & vbCrLf &
  717. "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
  718. Exit Sub
  719. End If
  720. Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
  721. Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent)
  722. Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent)
  723. Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=McVersionCurrent)
  724. Else
  725. '第三方 Authlib 服务器
  726. If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启第三方登录?" & vbCrLf &
  727. $"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
  728. "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
  729. Exit Sub
  730. End If
  731. Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
  732. Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=McVersionCurrent)
  733. Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=McVersionCurrent)
  734. Setup.Set("VersionServerAuthName", "", Version:=McVersionCurrent)
  735. End If
  736. If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionSetup Then
  737. '正在服务器选项页,需要刷新设置项显示
  738. FrmVersionSetup.Reload()
  739. ElseIf PageCurrent = PageType.Launch Then
  740. '正在主页,需要刷新左边栏
  741. FrmLaunchLeft.RefreshPage(True, False)
  742. End If
  743. End If
  744. Catch ex As Exception
  745. Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
  746. Exit Sub
  747. End Try
  748. ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
  749. '获取文件并检查
  750. Dim FilePathList As New List(Of String)(CType(e.Data.GetData(DataFormats.FileDrop), Array))
  751. e.Handled = True
  752. If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
  753. Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
  754. Exit Sub
  755. End If
  756. '多文件拖拽
  757. If FilePathList.Count > 1 Then
  758. '必须要求全部为 jar 文件
  759. For Each File In FilePathList
  760. Dim Extension As String = File.Split(".").Last.ToLower
  761. If Not {"jar", "litemod", "disabled"}.Contains(Extension) Then
  762. Hint("一次请只拖入一个文件!", HintType.Critical)
  763. Exit Sub
  764. End If
  765. Next
  766. End If
  767. '实际执行事件
  768. Dim FilePath As String = FilePathList.First
  769. Log("[System] 接受文件拖拽:" & FilePath, LogLevel.Developer)
  770. RunInNewThread(Sub()
  771. Dim Extension As String = FilePath.Split(".").Last.ToLower
  772. '自定义主页
  773. If Extension = "xaml" Then
  774. Log("[System] 文件后缀为 XAML,作为自定义主页加载")
  775. If File.Exists(Path & "PCL\Custom.xaml") Then
  776. If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
  777. Exit Sub
  778. End If
  779. End If
  780. CopyFile(FilePath, Path & "PCL\Custom.xaml")
  781. RunInUi(Sub()
  782. Setup.Set("UiCustomType", 1)
  783. FrmLaunchRight.ForceRefresh()
  784. End Sub)
  785. Exit Sub
  786. End If
  787. 'Mod 安装
  788. If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then
  789. Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
  790. '获取并检查目标版本
  791. Dim TargetVersion As McVersion = McVersionCurrent
  792. If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
  793. If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
  794. '正在选择版本,或当前版本不能安装 Mod
  795. Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
  796. ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
  797. '未处于 Mod 管理页面
  798. If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
  799. Else
  800. '处于 Mod 管理页面
  801. Install:
  802. Try
  803. For Each ModFile In FilePathList
  804. CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
  805. Next
  806. If FilePathList.Count = 1 Then
  807. Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish)
  808. Else
  809. Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
  810. End If
  811. '刷新列表
  812. If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
  813. LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
  814. End If
  815. Catch ex As Exception
  816. Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
  817. End Try
  818. End If
  819. Exit Sub
  820. End If
  821. '安装整合包
  822. If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
  823. Log("[System] 文件为压缩包,尝试作为整合包安装")
  824. If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
  825. End If
  826. 'RAR 处理
  827. If Extension = "rar" Then
  828. Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
  829. Exit Sub
  830. End If
  831. '错误报告分析
  832. Try
  833. Log("[System] 尝试进行错误报告分析")
  834. Dim Analyzer As New CrashAnalyzer(GetUuid())
  835. Analyzer.Import(FilePath)
  836. If Analyzer.Prepare() = 0 Then Exit Try
  837. Analyzer.Analyze()
  838. Analyzer.Output(True, New List(Of String))
  839. Exit Sub
  840. Catch ex As Exception
  841. Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
  842. End Try
  843. '未知操作
  844. Hint("PCL 无法确定应当执行的文件拖拽操作……")
  845. End Sub, "文件拖拽")
  846. End If
  847. Catch ex As Exception
  848. Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
  849. End Try
  850. End Sub
  851. '接受到 Windows 窗体事件
  852. Public IsSystemTimeChanged As Boolean = False
  853. Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
  854. If msg = 30 Then
  855. Dim NowDate = Date.Now
  856. If NowDate.Date = ApplicationOpenTime.Date Then
  857. Log("[System] 系统时间微调为:" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
  858. IsSystemTimeChanged = False
  859. Else
  860. Log("[System] 系统时间修改为:" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
  861. IsSystemTimeChanged = True
  862. End If
  863. ElseIf msg = 400 * 16 + 2 Then
  864. Log("[System] 收到置顶信息:" & hwnd.ToInt64)
  865. If Not IsWindowLoadFinished Then
  866. Log("[System] 窗口尚未加载完成,忽略置顶请求")
  867. Return IntPtr.Zero
  868. End If
  869. ShowWindowToTop()
  870. handled = True
  871. End If
  872. Return IntPtr.Zero
  873. End Function
  874. '窗口隐藏与置顶
  875. Private _Hidden As Boolean = False
  876. Public Property Hidden As Boolean
  877. Get
  878. Return _Hidden
  879. End Get
  880. Set(ByVal value As Boolean)
  881. If _Hidden = value Then Exit Property
  882. _Hidden = value
  883. If value Then
  884. '隐藏
  885. Left -= 10000
  886. ShowInTaskbar = False
  887. Visibility = Visibility.Hidden
  888. 'SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
  889. Log("[System] 窗口已隐藏,位置:(" & Left & "," & Top & ")")
  890. Else
  891. '取消隐藏
  892. If Left < -2000 Then Left += 10000
  893. ShowWindowToTop()
  894. End If
  895. End Set
  896. End Property
  897. ''' <summary>
  898. ''' 把当前窗口拖到最前面。
  899. ''' </summary>
  900. Public Sub ShowWindowToTop()
  901. RunInUi(Sub()
  902. '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
  903. Visibility = Visibility.Visible
  904. ShowInTaskbar = True
  905. WindowState = WindowState.Normal
  906. Hidden = False
  907. Topmost = True '偶尔 SetForegroundWindow 失效
  908. Topmost = False
  909. SetForegroundWindow(Handle)
  910. Focus()
  911. 'ShowWindow(Handle, 1) 'SW_RESTORE
  912. 'SetWindowPos(Handle, 0, 0, 0, 0, 0, 3) 'InsertAfter: TOP, NOMOVE & NOSIZE
  913. 'SetFocus(Handle)
  914. Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height)
  915. End Sub)
  916. End Sub
  917. 'Private Declare Function SetFocus Lib "user32" (hWnd As IntPtr) As IntPtr
  918. '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
  919. 'Private Declare Function AttachThreadInput Lib "user32" (attachFrom As IntPtr, attachTo As IntPtr, isAttach As Boolean) As Boolean
  920. 'Private Declare Function SendMessage Lib "user32" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As IntPtr
  921. #End Region
  922. #Region "切换页面"
  923. '页面种类与属性
  924. ''' <summary>
  925. ''' 页面种类。
  926. ''' </summary>
  927. Public Enum PageType
  928. ''' <summary>
  929. ''' 启动。
  930. ''' </summary>
  931. Launch
  932. ''' <summary>
  933. ''' 下载。
  934. ''' </summary>
  935. Download
  936. ''' <summary>
  937. ''' 联机。
  938. ''' </summary>
  939. Link
  940. ''' <summary>
  941. ''' 设置。
  942. ''' </summary>
  943. Setup
  944. ''' <summary>
  945. ''' 更多。
  946. ''' </summary>
  947. Other
  948. ''' <summary>
  949. ''' 版本选择。这是一个副页面。
  950. ''' </summary>
  951. VersionSelect
  952. ''' <summary>
  953. ''' 下载管理。这是一个副页面。
  954. ''' </summary>
  955. DownloadManager
  956. ''' <summary>
  957. ''' 版本设置。这是一个副页面。
  958. ''' </summary>
  959. VersionSetup
  960. ''' <summary>
  961. ''' 资源工程详情。这是一个副页面。
  962. ''' </summary>
  963. CompDetail
  964. ''' <summary>
  965. ''' 帮助详情。这是一个副页面。
  966. ''' </summary>
  967. HelpDetail
  968. End Enum
  969. ''' <summary>
  970. ''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。
  971. ''' </summary>
  972. Public Enum PageSubType
  973. [Default] = 0
  974. DownloadInstall = 1
  975. DownloadClient = 4
  976. DownloadOptiFine = 5
  977. DownloadForge = 6
  978. DownloadFabric = 7
  979. DownloadLiteLoader = 8
  980. DownloadMod = 10
  981. DownloadPack = 11
  982. SetupLaunch = 0
  983. SetupUI = 1
  984. SetupSystem = 2
  985. SetupLink = 3
  986. LinkHiper = 1
  987. LinkIoi = 2
  988. LinkSetup = 4
  989. LinkHelp = 5
  990. LinkFeedback = 6
  991. OtherHelp = 0
  992. OtherAbout = 1
  993. OtherTest = 2
  994. VersionOverall = 0
  995. VersionSetup = 1
  996. VersionMod = 2
  997. VersionModDisabled = 3
  998. End Enum
  999. ''' <summary>
  1000. ''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
  1001. ''' </summary>
  1002. Private Function PageNameGet(Stack As PageStackData) As String
  1003. Select Case Stack.Page
  1004. Case PageType.VersionSelect
  1005. Return "版本选择"
  1006. Case PageType.DownloadManager
  1007. Return "下载管理"
  1008. Case PageType.VersionSetup
  1009. Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
  1010. Case PageType.CompDetail
  1011. If Stack.Additional Is Nothing Then
  1012. Log("[Control] 资源工程详情页面未提供关键项", LogLevel.Feedback)
  1013. Return "未知页面"
  1014. Else
  1015. Dim Project As CompProject = Stack.Additional
  1016. Select Case Project.Type
  1017. Case CompType.Mod
  1018. Return "Mod 下载 - " & Project.TranslatedName
  1019. Case CompType.ModPack
  1020. Return "整合包下载 - " & Project.TranslatedName
  1021. Case Else 'CompType.ResourcePack
  1022. Return "资源包下载 - " & Project.TranslatedName
  1023. End Select
  1024. End If
  1025. Case PageType.HelpDetail
  1026. If Stack.Additional Is Nothing Then
  1027. Log("[Control] 帮助详情页面未提供关键项", LogLevel.Msgbox)
  1028. Return "未知页面"
  1029. Else
  1030. Dim Entry As HelpEntry = Stack.Additional(0)
  1031. Return Entry.Title
  1032. End If
  1033. Case Else
  1034. Return ""
  1035. End Select
  1036. End Function
  1037. ''' <summary>
  1038. ''' 刷新次级页面的名称。
  1039. ''' </summary>
  1040. Public Sub PageNameRefresh(Type As PageStackData)
  1041. LabTitleInner.Text = PageNameGet(Type)
  1042. End Sub
  1043. ''' <summary>
  1044. ''' 刷新次级页面的名称。
  1045. ''' </summary>
  1046. Public Sub PageNameRefresh()
  1047. PageNameRefresh(PageCurrent)
  1048. End Sub
  1049. '页面状态存储
  1050. ''' <summary>
  1051. ''' 当前的主页面。
  1052. ''' </summary>
  1053. Public PageCurrent As PageStackData = PageType.Launch
  1054. ''' <summary>
  1055. ''' 当前的子页面。
  1056. ''' </summary>
  1057. Public ReadOnly Property PageCurrentSub As PageSubType
  1058. Get
  1059. Select Case PageCurrent
  1060. Case PageType.Download
  1061. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1062. Return FrmDownloadLeft.PageID
  1063. Case PageType.Link
  1064. If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
  1065. Return FrmLinkLeft.PageID
  1066. Case PageType.Setup
  1067. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1068. Return FrmSetupLeft.PageID
  1069. Case PageType.Other
  1070. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1071. Return FrmOtherLeft.PageID
  1072. Case PageType.VersionSetup
  1073. If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
  1074. Return FrmVersionLeft.PageID
  1075. Case Else
  1076. Return 0 '没有子页面
  1077. End Select
  1078. End Get
  1079. End Property
  1080. ''' <summary>
  1081. ''' 上层页面的编号堆栈,用于返回。
  1082. ''' </summary>
  1083. Public PageStack As New List(Of PageStackData)
  1084. Public Class PageStackData
  1085. Public Page As PageType
  1086. Public Additional As Object
  1087. Public Overrides Function Equals(other As Object) As Boolean
  1088. If other Is Nothing Then Return False
  1089. If TypeOf other Is PageStackData Then
  1090. Dim PageOther As PageStackData = other
  1091. If Page <> PageOther.Page Then Return False
  1092. If Additional Is Nothing Then
  1093. Return PageOther.Additional Is Nothing
  1094. Else
  1095. Return PageOther.Additional IsNot Nothing AndAlso Additional.Equals(PageOther.Additional)
  1096. End If
  1097. ElseIf TypeOf other Is Integer Then
  1098. If Page <> other Then Return False
  1099. Return Additional Is Nothing
  1100. Else
  1101. Return False
  1102. End If
  1103. End Function
  1104. Public Shared Operator =(left As PageStackData, right As PageStackData) As Boolean
  1105. Return EqualityComparer(Of PageStackData).Default.Equals(left, right)
  1106. End Operator
  1107. Public Shared Operator <>(left As PageStackData, right As PageStackData) As Boolean
  1108. Return Not left = right
  1109. End Operator
  1110. Public Shared Widening Operator CType(Value As PageType) As PageStackData
  1111. Return New PageStackData With {.Page = Value}
  1112. End Operator
  1113. Public Shared Widening Operator CType(Value As PageStackData) As PageType
  1114. Return Value.Page
  1115. End Operator
  1116. End Class
  1117. Public PageLeft As MyPageLeft, PageRight As MyPageRight
  1118. '引发实际页面切换的入口
  1119. Private IsChangingPage As Boolean = False
  1120. ''' <summary>
  1121. ''' 切换页面,并引起对应选择 UI 的改变。
  1122. ''' </summary>
  1123. Public Sub PageChange(Stack As PageStackData, Optional SubType As PageSubType = PageSubType.Default)
  1124. If PageNameGet(Stack) = "" Then
  1125. '切换到主页面
  1126. PageChangeExit()
  1127. IsChangingPage = True '防止下面的勾选直接触发了 PageChangeActual
  1128. CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "")
  1129. IsChangingPage = False
  1130. Select Case Stack.Page
  1131. Case PageType.Link
  1132. If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
  1133. CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1134. Case PageType.Download
  1135. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1136. CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1137. Case PageType.Setup
  1138. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1139. CType(FrmSetupLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1140. Case PageType.Other
  1141. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1142. CType(FrmOtherLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1143. End Select
  1144. PageChangeActual(Stack, SubType)
  1145. Else
  1146. '切换到次页面
  1147. Select Case Stack.Page
  1148. Case PageType.VersionSetup
  1149. If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
  1150. CType(FrmVersionLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
  1151. End Select
  1152. PageChangeActual(Stack, SubType)
  1153. End If
  1154. End Sub
  1155. ''' <summary>
  1156. ''' 通过点击导航栏改变页面。
  1157. ''' </summary>
  1158. Private Sub BtnTitleSelect_Click(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTitleSelect0.Check, BtnTitleSelect1.Check, BtnTitleSelect2.Check, BtnTitleSelect3.Check, BtnTitleSelect4.Check
  1159. If IsChangingPage Then Exit Sub
  1160. PageChangeActual(Val(sender.Tag))
  1161. End Sub
  1162. Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick
  1163. If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
  1164. "PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
  1165. "联机功能已暂时关闭", "查看详情", "确定") = 1 Then
  1166. OpenWebsite("https://www.bilibili.com/read/cv19845645")
  1167. End If
  1168. e.Handled = True
  1169. End Sub
  1170. ''' <summary>
  1171. ''' 通过点击返回按钮或手动触发返回来改变页面。
  1172. ''' </summary>
  1173. Public Sub PageBack() Handles BtnTitleInner.Click
  1174. If PageStack.Count = 0 Then Exit Sub
  1175. PageChangeActual(PageStack(0))
  1176. End Sub
  1177. '实际处理页面切换
  1178. ''' <summary>
  1179. ''' 切换现有页面的实际方法。
  1180. ''' </summary>
  1181. Private Sub PageChangeActual(Stack As PageStackData, Optional SubType As PageSubType = -1)
  1182. If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Exit Sub
  1183. AniControlEnabled += 1
  1184. Try
  1185. #Region "子页面处理"
  1186. Dim PageName As String = PageNameGet(Stack)
  1187. If PageName = "" Then
  1188. '即将切换到一个顶级页面
  1189. PageChangeExit()
  1190. Else
  1191. '即将切换到一个子页面
  1192. If PageStack.Count = 0 Then
  1193. '主页面 → 子页面,进入
  1194. PanTitleInner.Visibility = Visibility.Visible
  1195. PanTitleMain.IsHitTestVisible = False
  1196. PanTitleInner.IsHitTestVisible = True
  1197. PageNameRefresh(Stack)
  1198. AniStart({
  1199. AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
  1200. AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
  1201. AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
  1202. AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
  1203. AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
  1204. }, "FrmMain Titlebar FirstLayer")
  1205. PageStack.Insert(0, PageCurrent)
  1206. Else
  1207. '子页面 → 另一个子页面,更新
  1208. AniStart({
  1209. AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
  1210. AaCode(Sub() LabTitleInner.Text = PageName,, True),
  1211. AaOpacity(LabTitleInner, 1, 150, 30)
  1212. }, "FrmMain Titlebar SubLayer")
  1213. If PageStack.Contains(Stack) Then
  1214. '返回到更上层的子页面
  1215. Do While PageStack.Contains(Stack)
  1216. PageStack.RemoveAt(0)
  1217. Loop
  1218. Else
  1219. '进入更深层的子页面
  1220. PageStack.Insert(0, PageCurrent)
  1221. End If
  1222. End If
  1223. End If
  1224. #End Region
  1225. #Region "实际更改页面框架 UI"
  1226. PageCurrent = Stack
  1227. Select Case Stack.Page
  1228. Case PageType.Launch '启动
  1229. PageChangeAnim(FrmLaunchLeft, FrmLaunchRight)
  1230. Case PageType.Download '下载
  1231. If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
  1232. 'PageGet 方法会在未设置 SubType 时指定默认值,并建立相关页面的实例
  1233. PageChangeAnim(FrmDownloadLeft, FrmDownloadLeft.PageGet(SubType))
  1234. Case PageType.Link '联机
  1235. If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
  1236. PageChangeAnim(FrmLinkLeft, FrmLinkLeft.PageGet(SubType))
  1237. Case PageType.Setup '设置
  1238. If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
  1239. PageChangeAnim(FrmSetupLeft, FrmSetupLeft.PageGet(SubType))
  1240. Case PageType.Other '更多
  1241. If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
  1242. PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType))
  1243. Case PageType.VersionSelect '版本选择
  1244. If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft
  1245. If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight
  1246. PageChangeAnim(FrmSelectLeft, FrmSelectRight)
  1247. Case PageType.DownloadManager '下载管理
  1248. If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft
  1249. If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight
  1250. PageChangeAnim(FrmSpeedLeft, FrmSpeedRight)
  1251. Case PageType.VersionSetup '版本设置
  1252. If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
  1253. PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType))
  1254. Case PageType.CompDetail 'Mod 信息
  1255. If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
  1256. PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
  1257. Case PageType.HelpDetail '帮助详情
  1258. PageChangeAnim(New MyPageLeft, Stack.Additional(1))
  1259. End Select
  1260. #End Region
  1261. #Region "设置为最新状态"
  1262. BtnExtraDownload.ShowRefresh()
  1263. BtnExtraApril.ShowRefresh()
  1264. #End Region
  1265. Log("[Control] 切换主要页面:" & GetStringFromEnum(Stack) & ", " & SubType)
  1266. Catch ex As Exception
  1267. Log(ex, "切换主要页面失败(ID " & PageCurrent.Page & ")", LogLevel.Feedback)
  1268. Finally
  1269. AniControlEnabled -= 1
  1270. End Try
  1271. End Sub
  1272. Private Sub PageChangeAnim(TargetLeft As FrameworkElement, TargetRight As FrameworkElement)
  1273. AniStop("FrmMain LeftChange")
  1274. AniStop("PageLeft PageChange") '停止左边栏变更导致的右页面切换动画,防止它与本动画一起触发多次 PageOnEnter
  1275. AniControlEnabled += 1
  1276. '清除新页面关联性
  1277. If Not IsNothing(TargetLeft.Parent) Then TargetLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
  1278. If Not IsNothing(TargetRight) AndAlso Not IsNothing(TargetRight.Parent) Then TargetRight.SetValue(ContentPresenter.ContentProperty, Nothing)
  1279. PageLeft = TargetLeft
  1280. PageRight = TargetRight
  1281. '触发页面通用动画
  1282. CType(PanMainLeft.Child, MyPageLeft).TriggerHideAnimation()
  1283. CType(PanMainRight.Child, MyPageRight).PageOnExit()
  1284. AniControlEnabled -= 1
  1285. '执行动画
  1286. AniStart({
  1287. AaCode(Sub()
  1288. AniControlEnabled += 1
  1289. '把新页面添加进容器
  1290. PanMainLeft.Child = PageLeft
  1291. PageLeft.Opacity = 0
  1292. PanMainLeft.Background = Nothing
  1293. AniControlEnabled -= 1
  1294. RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
  1295. End Sub, 130),
  1296. AaCode(Sub()
  1297. '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
  1298. PageLeft.Opacity = 1
  1299. PageLeft.TriggerShowAnimation()
  1300. End Sub, 30, True)
  1301. }, "FrmMain PageChangeLeft")
  1302. AniStart({
  1303. AaCode(Sub()
  1304. AniControlEnabled += 1
  1305. CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
  1306. '把新页面添加进容器
  1307. PanMainRight.Child = PageRight
  1308. PageRight.Opacity = 0
  1309. PanMainRight.Background = Nothing
  1310. AniControlEnabled -= 1
  1311. RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
  1312. End Sub, 130),
  1313. AaCode(Sub()
  1314. '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
  1315. PageRight.Opacity = 1
  1316. PageRight.PageOnEnter()
  1317. End Sub, 30, True)
  1318. }, "FrmMain PageChangeRight")
  1319. End Sub
  1320. ''' <summary>
  1321. ''' 退出子界面。
  1322. ''' </summary>
  1323. Private Sub PageChangeExit()
  1324. If PageStack.Count = 0 Then
  1325. '主页面 → 主页面,无事发生
  1326. Else
  1327. '子页面 → 主页面,退出
  1328. PanTitleMain.Visibility = Visibility.Visible
  1329. PanTitleMain.IsHitTestVisible = True
  1330. PanTitleInner.IsHitTestVisible = False
  1331. AniStart({
  1332. AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
  1333. AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
  1334. AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
  1335. AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
  1336. AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
  1337. }, "FrmMain Titlebar FirstLayer")
  1338. PageStack.Clear()
  1339. End If
  1340. End Sub
  1341. '左边栏改变
  1342. Private Sub PanMainLeft_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanMainLeft.SizeChanged
  1343. If Not e.WidthChanged Then Exit Sub
  1344. PanMainLeft_Resize(e.NewSize.Width)
  1345. End Sub
  1346. Private Sub PanMainLeft_Resize(NewWidth As Double)
  1347. Dim Delta As Double = NewWidth - RectLeftBackground.Width
  1348. If Math.Abs(Delta) < 0.1 Then Exit Sub
  1349. If AniControlEnabled = 0 Then
  1350. If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
  1351. If NewWidth > 0 Then
  1352. '宽度足够,显示
  1353. AniStart({
  1354. AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
  1355. AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
  1356. AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
  1357. }, "FrmMain LeftChange", True)
  1358. Else
  1359. '宽度不足,隐藏
  1360. AniStart({
  1361. AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
  1362. AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
  1363. AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
  1364. }, "FrmMain LeftChange", True)
  1365. End If
  1366. Else
  1367. RectLeftBackground.Width = NewWidth
  1368. PanMainLeft.IsHitTestVisible = True
  1369. AniStop("FrmMain LeftChange")
  1370. End If
  1371. End Sub
  1372. #End Region
  1373. #Region "控件拖动"
  1374. '在时钟中调用,使得即使鼠标在窗口外松开,也可以释放控件
  1375. Public Sub DragTick()
  1376. If DragControl Is Nothing Then Exit Sub
  1377. If Not Mouse.LeftButton = MouseButtonState.Pressed Then
  1378. DragStop()
  1379. End If
  1380. End Sub
  1381. '在鼠标移动时调用,以改变 Slider 位置
  1382. Public Sub DragDoing() Handles PanBack.MouseMove
  1383. If DragControl Is Nothing Then Exit Sub
  1384. If Mouse.LeftButton = MouseButtonState.Pressed Then
  1385. DragControl.DragDoing()
  1386. Else
  1387. DragStop()
  1388. End If
  1389. End Sub
  1390. Public Sub DragStop()
  1391. '存在其他线程调用的可能性,因此需要确保在 UI 线程运行
  1392. RunInUi(Sub()
  1393. If DragControl Is Nothing Then Exit Sub
  1394. Dim Control = DragControl
  1395. DragControl = Nothing
  1396. Control.DragStop() '控件会在该事件中判断 DragControl,所以得放在后面
  1397. End Sub)
  1398. End Sub
  1399. #End Region
  1400. #Region "附加按钮"
  1401. '音乐
  1402. Private Sub BtnExtraMusic_Click(sender As Object, e As EventArgs) Handles BtnExtraMusic.Click
  1403. MusicControlPause()
  1404. End Sub
  1405. Private Sub BtnExtraMusic_RightClick(sender As Object, e As EventArgs) Handles BtnExtraMusic.RightClick
  1406. MusicControlNext()
  1407. End Sub
  1408. '下载管理
  1409. Private Sub BtnExtraDownload_Click(sender As Object, e As EventArgs) Handles BtnExtraDownload.Click
  1410. PageChange(PageType.DownloadManager)
  1411. End Sub
  1412. Private Function BtnExtraDownload_ShowCheck() As Boolean
  1413. Return HasDownloadingTask() AndAlso Not PageCurrent = PageType.DownloadManager
  1414. End Function
  1415. '投降
  1416. Public Sub AprilGiveup() Handles BtnExtraApril.Click
  1417. If IsAprilEnabled AndAlso Not IsAprilGiveup Then
  1418. Hint("=D", HintType.Finish)
  1419. IsAprilGiveup = True
  1420. FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
  1421. FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
  1422. BtnExtraApril.ShowRefresh()
  1423. End If
  1424. End Sub
  1425. Public Function BtnExtraApril_ShowCheck() As Boolean
  1426. Return IsAprilEnabled AndAlso Not IsAprilGiveup AndAlso PageCurrent = PageType.Launch
  1427. End Function
  1428. '关闭 Minecraft
  1429. Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
  1430. Try
  1431. If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Abort()
  1432. For Each Watcher In McWatcherList
  1433. Watcher.Kill()
  1434. Next
  1435. Hint("已关闭运行中的 Minecraft!", HintType.Finish)
  1436. Catch ex As Exception
  1437. Log(ex, "强制关闭所有 Minecraft 失败", LogLevel.Feedback)
  1438. End Try
  1439. End Sub
  1440. Public Function BtnExtraShutdown_ShowCheck() As Boolean
  1441. Return HasRunningMinecraft
  1442. End Function
  1443. ''' <summary>
  1444. ''' 返回顶部。
  1445. ''' </summary>
  1446. Public Sub BackToTop() Handles BtnExtraBack.Click
  1447. Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
  1448. RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
  1449. End Sub
  1450. Private Function BtnExtraBack_ShowCheck() As Boolean
  1451. Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
  1452. Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 700)
  1453. End Function
  1454. Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
  1455. If PanMainRight.Child Is Nothing Then Return Nothing
  1456. Dim RightChild = CType(PanMainRight.Child, AdornerDecorator).Child
  1457. If RightChild Is Nothing Then
  1458. Return Nothing
  1459. ElseIf TypeOf RightChild Is MyScrollViewer Then
  1460. Return RightChild
  1461. ElseIf TypeOf RightChild Is Grid AndAlso TypeOf CType(RightChild, Grid).Children(0) Is MyScrollViewer Then
  1462. Return CType(RightChild, Grid).Children(0)
  1463. Else
  1464. Return Nothing
  1465. End If
  1466. End Function
  1467. #End Region
  1468. '愚人节鼠标位置
  1469. Public lastMouseArg As MouseEventArgs = Nothing
  1470. Private Sub FormMain_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
  1471. lastMouseArg = e
  1472. End Sub
  1473. End Class