FormMain.xaml.vb 72 KB

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