FormMain.xaml.vb 70 KB

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