FormMain.xaml.vb 71 KB

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