ModMain.vb 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979
  1. Imports System.Windows.Interop
  2. Imports System.Windows.Threading
  3. Public Module ModMain
  4. #Region "弹出提示"
  5. ''' <summary>
  6. ''' 提示信息的种类。
  7. ''' </summary>
  8. Public Enum HintType
  9. ''' <summary>
  10. ''' 信息,通常是蓝色的“i”。
  11. ''' </summary>
  12. ''' <remarks></remarks>
  13. Info
  14. ''' <summary>
  15. ''' 已完成,通常是绿色的“√”。
  16. ''' </summary>
  17. ''' <remarks></remarks>
  18. Finish
  19. ''' <summary>
  20. ''' 错误,通常是红色的“×”。
  21. ''' </summary>
  22. ''' <remarks></remarks>
  23. Critical
  24. End Enum
  25. Private Structure HintMessage
  26. Public Text As String
  27. Public Type As HintType
  28. Public Log As Boolean
  29. End Structure
  30. ''' <summary>
  31. ''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
  32. ''' </summary>
  33. Private HintWaiting As SafeList(Of HintMessage) = If(HintWaiting, New SafeList(Of HintMessage))
  34. ''' <summary>
  35. ''' 在窗口左下角弹出提示文本。
  36. ''' </summary>
  37. Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
  38. If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
  39. HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
  40. End Sub
  41. Private Sub HintTick()
  42. Try
  43. 'Tag 存储了:{ 是否可以重用, Uuid }
  44. If Not HintWaiting.Any() Then Return
  45. Do While HintWaiting.Any
  46. ''清除空提示
  47. 'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
  48. ' HintWaiting.RemoveAt(0)
  49. ' Continue Do
  50. 'End If
  51. Dim CurrentHint = HintWaiting(0)
  52. '去回车
  53. CurrentHint.Text = CurrentHint.Text.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
  54. '超量提示直接忽略
  55. If FrmMain.PanHint.Children.Count >= 20 Then GoTo EndHint
  56. '检查是否有重复提示
  57. Dim DoubleStack As Border = Nothing
  58. For Each stack As Border In FrmMain.PanHint.Children
  59. If stack.Tag(0) AndAlso CType(stack.Child, TextBlock).Text = CurrentHint.Text Then DoubleStack = stack
  60. Next
  61. '获取渐变颜色
  62. Dim TargetColor0, TargetColor1 As MyColor
  63. Dim Percent As Double = 0.3
  64. Select Case CurrentHint.Type
  65. Case HintType.Info
  66. TargetColor0 = New MyColor(215, 37, 155, 252)
  67. TargetColor1 = New MyColor(215, 10, 142, 252)
  68. Case HintType.Finish
  69. TargetColor0 = New MyColor(215, 33, 177, 33)
  70. TargetColor1 = New MyColor(215, 29, 160, 29)
  71. Case Else 'HintType.Critical
  72. TargetColor0 = New MyColor(215, 255, 53, 11)
  73. TargetColor1 = New MyColor(215, 255, 43, 0)
  74. End Select
  75. If Not IsNothing(DoubleStack) Then
  76. '有重复提示,且该提示的进入动画已播放
  77. If Not AniIsRun("Hint Show " & DoubleStack.Tag(1)) Then
  78. AniStop("Hint Hide " & DoubleStack.Tag(1))
  79. Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
  80. AniStart({
  81. AaX(DoubleStack, -12 - DoubleStack.Margin.Left, 50,, New AniEaseOutFluent),
  82. AaX(DoubleStack, -8, 50, 50, New AniEaseInFluent),
  83. AaX(DoubleStack, 8, 50, 100, New AniEaseOutFluent),
  84. AaX(DoubleStack, -8, 50, 150, New AniEaseInFluent),
  85. AaDouble(Sub(i)
  86. Percent += i
  87. Dim Gradient As LinearGradientBrush = DoubleStack.Background
  88. Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
  89. Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
  90. End Sub, 0.7, 250),
  91. AaX(DoubleStack, -50, 200, Delay, New AniEaseInFluent),
  92. AaOpacity(DoubleStack, -1, 150, Delay),
  93. AaCode(Sub() DoubleStack.Tag(0) = False, Delay),
  94. AaHeight(DoubleStack, -26, 100,, New AniEaseOutFluent, True),
  95. AaCode(Sub() FrmMain.PanHint.Children.Remove(DoubleStack), , True)
  96. }, "Hint Hide " & DoubleStack.Tag(1))
  97. End If
  98. Else
  99. '准备控件
  100. Dim NewHintControl As New Border With {.Tag = {True, GetUuid()}, .Margin = New Thickness(-70, 0, 20, 0), .Opacity = 0, .Height = 0, .HorizontalAlignment = HorizontalAlignment.Left, .CornerRadius = New CornerRadius(0, 6, 6, 0)}
  101. NewHintControl.Background = New LinearGradientBrush(New GradientStopCollection(New List(Of GradientStop) From {
  102. New GradientStop(TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 0),
  103. New GradientStop(TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 1)}), 90)
  104. NewHintControl.Child = New TextBlock With {.TextTrimming = TextTrimming.CharacterEllipsis, .FontSize = 13, .Text = CurrentHint.Text, .Foreground = New MyColor(255, 255, 255), .Margin = New Thickness(33, 5, 8, 5)}
  105. 'AddHandler NewHintControl.MouseLeftButtonDown, AddressOf HideAllHint
  106. FrmMain.PanHint.Children.Add(NewHintControl)
  107. '控件动画
  108. Dim Animations As New List(Of AniData)
  109. If FrmMain.PanHint.Children.Count > 1 Then
  110. '已有提示
  111. Animations.Add(AaHeight(NewHintControl, 26, 150, , New AniEaseOutFluent))
  112. Else
  113. '是唯一提示
  114. NewHintControl.Height = 26
  115. End If
  116. '开始动画
  117. Animations.AddRange({
  118. AaX(NewHintControl, 30, 400, , New AniEaseOutElastic(AniEasePower.Weak)),
  119. AaX(NewHintControl, 20, 200, , New AniEaseOutFluent),
  120. AaOpacity(NewHintControl, 1, 100),
  121. AaDouble(Sub(i)
  122. Percent += i
  123. Dim Gradient As LinearGradientBrush = NewHintControl.Background
  124. Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
  125. Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
  126. End Sub, 0.7, 250, 100)
  127. })
  128. AniStart(Animations, "Hint Show " & NewHintControl.Tag(1))
  129. '结束动画
  130. Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
  131. AniStart({
  132. AaX(NewHintControl, -50, 200, Delay, New AniEaseInFluent),
  133. AaOpacity(NewHintControl, -1, 150, Delay),
  134. AaCode(Sub() NewHintControl.Tag(0) = False, Delay),
  135. AaHeight(NewHintControl, -26, 100,, New AniEaseOutFluent, True),
  136. AaCode(Sub() FrmMain.PanHint.Children.Remove(NewHintControl), , True)
  137. }, "Hint Hide " & NewHintControl.Tag(1))
  138. End If
  139. '结束处理
  140. EndHint:
  141. If CurrentHint.Log Then Log("[UI] 弹出提示:" & CurrentHint.Text)
  142. HintWaiting.RemoveAt(0)
  143. Loop
  144. Catch ex As Exception
  145. Log(ex, "显示弹出提示失败", LogLevel.Normal)
  146. End Try
  147. End Sub
  148. Private Sub HideAllHint()
  149. For Each Control As Border In FrmMain.PanHint.Children
  150. Control.IsHitTestVisible = False
  151. AniStart({
  152. AaX(Control, -50, 200, , New AniEaseInFluent),
  153. AaOpacity(Control, -1, 150, , New AniEaseInFluent),
  154. AaCode(Sub() Control.Tag(0) = False),
  155. AaHeight(Control, -26, 100,, New AniEaseOutFluent, True),
  156. AaCode(Sub() FrmMain.PanHint.Children.Remove(Control), , True)
  157. }, "Hint Hide " & Control.Tag(1))
  158. Next
  159. End Sub
  160. #End Region
  161. #Region "弹窗"
  162. ''' <summary>
  163. ''' 存储弹窗信息的转换器。
  164. ''' </summary>
  165. Public Class MyMsgBoxConverter
  166. Public Type As MyMsgBoxType
  167. Public Title As String
  168. Public Text As String
  169. ''' <summary>
  170. ''' 输入模式:文本框的文本。
  171. ''' 选择模式:需要放进去的 List(Of MyListItem)。
  172. ''' 登录模式:登录步骤 1 中返回的 JSON。
  173. ''' </summary>
  174. Public Content As Object
  175. ''' <summary>
  176. ''' 输入模式:输入验证规则。
  177. ''' </summary>
  178. Public ValidateRules As ObjectModel.Collection(Of Validate)
  179. ''' <summary>
  180. ''' 输入模式:提示文本。
  181. ''' </summary>
  182. Public HintText As String = ""
  183. ''' <summary>
  184. ''' 有多个按钮时,是否给第一个按钮加高亮。
  185. ''' </summary>
  186. Public HighLight As Boolean
  187. Public Button1 As String = "确定"
  188. Public Button2 As String = ""
  189. Public Button3 As String = ""
  190. ''' <summary>
  191. ''' 点击第一个按钮将执行该方法,不关闭弹窗。
  192. ''' </summary>
  193. Public Button1Action As Action = Nothing
  194. ''' <summary>
  195. ''' 点击第二个按钮将执行该方法,不关闭弹窗。
  196. ''' </summary>
  197. Public Button2Action As Action = Nothing
  198. ''' <summary>
  199. ''' 点击第三个按钮将执行该方法,不关闭弹窗。
  200. ''' </summary>
  201. Public Button3Action As Action = Nothing
  202. Public IsWarn As Boolean = False
  203. Public ForceWait As Boolean = False
  204. Public WaitFrame As New DispatcherFrame(True)
  205. ''' <summary>
  206. ''' 弹窗是否已经关闭。
  207. ''' </summary>
  208. Public IsExited As Boolean = False
  209. ''' <summary>
  210. ''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
  211. ''' 选择模式:点击的按钮编号,从 1 开始。
  212. ''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
  213. ''' </summary>
  214. Public Result As Object
  215. End Class
  216. Public Enum MyMsgBoxType
  217. Text
  218. [Select]
  219. Input
  220. Login
  221. End Enum
  222. ''' <summary>
  223. ''' 显示弹窗,返回点击按钮的编号(从 1 开始)。
  224. ''' </summary>
  225. ''' <param name="Title">弹窗的标题。</param>
  226. ''' <param name="Caption">弹窗的内容。</param>
  227. ''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
  228. ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
  229. ''' <param name="Button3">显示的第三个按钮,默认为空。</param>
  230. ''' <param name="Button1Action">点击第一个按钮将执行该方法,不关闭弹窗。</param>
  231. ''' <param name="Button2Action">点击第二个按钮将执行该方法,不关闭弹窗。</param>
  232. ''' <param name="Button3Action">点击第三个按钮将执行该方法,不关闭弹窗。</param>
  233. ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
  234. Public Function MyMsgBox(Caption As String, Optional Title As String = "提示",
  235. Optional Button1 As String = "确定", Optional Button2 As String = "", Optional Button3 As String = "",
  236. Optional IsWarn As Boolean = False, Optional HighLight As Boolean = True, Optional ForceWait As Boolean = False,
  237. Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
  238. '将弹窗列入队列
  239. Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
  240. WaitingMyMsgBox.Add(Converter)
  241. If RunInUi() Then
  242. '若为 UI 线程,立即执行弹窗刻, 避免快速(连点器)点击时多次弹窗
  243. MyMsgBoxTick()
  244. End If
  245. If Button2.Length > 0 OrElse ForceWait Then
  246. '若有多个按钮则开始等待
  247. If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
  248. '主窗体尚未加载,用老土的弹窗来替代
  249. WaitingMyMsgBox.Remove(Converter)
  250. If Button2.Length > 0 Then
  251. Dim RawResult As MsgBoxResult = MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
  252. Select Case RawResult
  253. Case MsgBoxResult.Yes
  254. Converter.Result = 1
  255. Case MsgBoxResult.No
  256. Converter.Result = 2
  257. Case MsgBoxResult.Cancel
  258. Converter.Result = 3
  259. End Select
  260. Else
  261. MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
  262. Converter.Result = 1
  263. End If
  264. Log("[Control] 主窗体加载完成前出现意料外的等待弹窗:" & Button1 & "," & Button2 & "," & Button3, LogLevel.Debug)
  265. Else
  266. Try
  267. FrmMain.DragStop()
  268. ComponentDispatcher.PushModal()
  269. Dispatcher.PushFrame(Converter.WaitFrame)
  270. Finally
  271. ComponentDispatcher.PopModal()
  272. End Try
  273. End If
  274. Log("[Control] 普通弹框返回:" & If(Converter.Result, "null"))
  275. Return Converter.Result
  276. Else
  277. '不进行等待,直接返回
  278. Return 1
  279. End If
  280. End Function
  281. ''' <summary>
  282. ''' 显示输入框并返回输入的文本。若点击第二个按钮,则返回 Nothing。
  283. ''' </summary>
  284. ''' <param name="Title">弹窗的标题。</param>
  285. ''' <param name="ValidateRules">文本框的输入检测。</param>
  286. ''' <param name="Text">弹窗的介绍文本。</param>
  287. ''' <param name="DefaultInput">文本框的默认内容。</param>
  288. ''' <param name="HintText">文本框的提示内容。</param>
  289. ''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
  290. ''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param>
  291. ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
  292. Public Function MyMsgBoxInput(Title As String, Optional Text As String = "", Optional DefaultInput As String = "", Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
  293. '将弹窗列入队列
  294. Dim Converter As New MyMsgBoxConverter With {.Text = Text, .HintText = HintText, .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
  295. WaitingMyMsgBox.Add(Converter)
  296. '虽然我也不知道这是啥但是能用就成了 :)
  297. Try
  298. If FrmMain IsNot Nothing Then FrmMain.DragStop()
  299. ComponentDispatcher.PushModal()
  300. Dispatcher.PushFrame(Converter.WaitFrame)
  301. Finally
  302. ComponentDispatcher.PopModal()
  303. End Try
  304. Log("[Control] 输入弹框返回:" & If(Converter.Result, "null"))
  305. Return Converter.Result
  306. End Function
  307. ''' <summary>
  308. ''' 显示选择框并返回选择的第几项(从 0 开始)。若点击第二个按钮,则返回 Nothing。
  309. ''' </summary>
  310. ''' <param name="Title">弹窗的标题。</param>
  311. ''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param>
  312. ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
  313. ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
  314. Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
  315. '将弹窗列入队列
  316. Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
  317. WaitingMyMsgBox.Add(Converter)
  318. '虽然我也不知道这是啥但是能用就成了 :)
  319. Try
  320. If FrmMain IsNot Nothing Then FrmMain.DragStop()
  321. ComponentDispatcher.PushModal()
  322. Dispatcher.PushFrame(Converter.WaitFrame)
  323. Finally
  324. ComponentDispatcher.PopModal()
  325. End Try
  326. Log("[Control] 选择弹框返回:" & If(Converter.Result, "null"))
  327. Return Converter.Result
  328. End Function
  329. ''' <summary>
  330. ''' 等待显示的弹窗。
  331. ''' </summary>
  332. Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
  333. Public Sub MyMsgBoxTick()
  334. Try
  335. If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
  336. If FrmMain.PanMsg.Children.Count > 0 Then
  337. '弹窗中
  338. FrmMain.PanMsg.Visibility = Visibility.Visible
  339. ElseIf WaitingMyMsgBox.Any Then
  340. '没有弹窗,显示一个等待的弹窗
  341. FrmMain.PanMsg.Visibility = Visibility.Visible
  342. Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
  343. Case MyMsgBoxType.Input
  344. FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
  345. Case MyMsgBoxType.Select
  346. FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
  347. Case MyMsgBoxType.Text
  348. FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
  349. Case MyMsgBoxType.Login
  350. FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
  351. End Select
  352. WaitingMyMsgBox.RemoveAt(0)
  353. Else
  354. '没有弹窗,没有等待的弹窗
  355. If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
  356. End If
  357. Catch ex As Exception
  358. Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
  359. End Try
  360. End Sub
  361. #End Region
  362. #Region "页面声明"
  363. '在最后进行页面声明,避免颜色尚未加载完毕
  364. '窗体声明
  365. Public FrmMain As FormMain
  366. Public FrmStart As SplashScreen
  367. '页面声明(出于单元测试考虑,初始化页面已转入 FormMain 中)
  368. Public FrmLaunchLeft As PageLaunchLeft
  369. Public FrmLaunchRight As PageLaunchRight
  370. Public FrmSelectLeft As PageSelectLeft
  371. Public FrmSelectRight As PageSelectRight
  372. Public FrmSpeedLeft As PageSpeedLeft
  373. Public FrmSpeedRight As PageSpeedRight
  374. '联机页面声明
  375. Public FrmLinkLeft As PageLinkLeft
  376. Public FrmLinkIoi As PageLinkIoi
  377. Public FrmLinkHiper As PageLinkHiper
  378. Public FrmLinkHelp As PageOtherHelpDetail
  379. Public FrmLinkFeedback As PageLinkFeedback
  380. '下载页面声明
  381. Public FrmDownloadLeft As PageDownloadLeft
  382. Public FrmDownloadInstall As PageDownloadInstall
  383. Public FrmDownloadClient As PageDownloadClient
  384. Public FrmDownloadOptiFine As PageDownloadOptiFine
  385. Public FrmDownloadLiteLoader As PageDownloadLiteLoader
  386. Public FrmDownloadForge As PageDownloadForge
  387. Public FrmDownloadNeoForge As PageDownloadNeoForge
  388. Public FrmDownloadFabric As PageDownloadFabric
  389. Public FrmDownloadMod As PageDownloadMod
  390. Public FrmDownloadPack As PageDownloadPack
  391. Public FrmDownloadDataPack As PageDownloadDataPack
  392. Public FrmDownloadShader As PageDownloadShader
  393. Public FrmDownloadResourcePack As PageDownloadResourcePack
  394. '设置页面声明
  395. Public FrmSetupLeft As PageSetupLeft
  396. Public FrmSetupLaunch As PageSetupLaunch
  397. Public FrmSetupUI As PageSetupUI
  398. Public FrmSetupSystem As PageSetupSystem
  399. Public FrmSetupLink As PageSetupLink
  400. '其他页面声明
  401. Public FrmOtherLeft As PageOtherLeft
  402. Public FrmOtherHelp As PageOtherHelp
  403. Public FrmOtherAbout As PageOtherAbout
  404. Public FrmOtherTest As PageOtherTest
  405. '登录页面声明
  406. Public FrmLoginLegacy As PageLoginLegacy
  407. Public FrmLoginNide As PageLoginNide
  408. Public FrmLoginNideSkin As PageLoginNideSkin
  409. Public FrmLoginAuth As PageLoginAuth
  410. Public FrmLoginAuthSkin As PageLoginAuthSkin
  411. Public FrmLoginMs As PageLoginMs
  412. Public FrmLoginMsSkin As PageLoginMsSkin
  413. '版本设置页面声明
  414. Public FrmVersionLeft As PageVersionLeft
  415. Public FrmVersionOverall As PageVersionOverall
  416. Public FrmVersionMod As PageVersionMod
  417. Public FrmVersionModDisabled As PageVersionModDisabled
  418. Public FrmVersionSetup As PageVersionSetup
  419. Public FrmVersionExport As PageVersionExport
  420. '资源信息分页声明
  421. Public FrmDownloadCompDetail As PageDownloadCompDetail
  422. #End Region
  423. #Region "帮助"
  424. Public Class HelpEntry
  425. ''' <summary>
  426. ''' 原始信息路径。用于刷新。
  427. ''' </summary>
  428. Public RawPath As String
  429. '基础
  430. ''' <summary>
  431. ''' 显示标题。
  432. ''' </summary>
  433. Public Title As String
  434. ''' <summary>
  435. ''' 显示描述。
  436. ''' </summary>
  437. Public Desc As String
  438. ''' <summary>
  439. ''' 检索关键字。
  440. ''' </summary>
  441. Public Search As String
  442. ''' <summary>
  443. ''' 用于分类的标签列表。
  444. ''' </summary>
  445. Public Types As List(Of String)
  446. '显示(可选)
  447. ''' <summary>
  448. ''' 帮助项的自定义图标。可能为 Nothing。
  449. ''' </summary>
  450. Public Logo As String = Nothing
  451. ''' <summary>
  452. ''' 是否显示在搜索结果。默认为 True。
  453. ''' </summary>
  454. Public ShowInSearch As Boolean = True
  455. ''' <summary>
  456. ''' 是否在公开版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
  457. ''' </summary>
  458. Public ShowInPublic As Boolean = True
  459. ''' <summary>
  460. ''' 是否在快照版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
  461. ''' </summary>
  462. Public ShowInSnapshot As Boolean = True
  463. '动作
  464. ''' <summary>
  465. ''' 是否为 “执行事件”。
  466. ''' </summary>
  467. Public IsEvent As Boolean
  468. Public EventType As String
  469. Public EventData As String
  470. ''' <summary>
  471. ''' 若非执行事件,其对应的 .xaml 本地文件内容。
  472. ''' </summary>
  473. Public XamlContent As String
  474. '转换
  475. ''' <summary>
  476. ''' 从文件初始化 HelpEntry 对象,失败会抛出异常。
  477. ''' </summary>
  478. Public Sub New(FilePath As String)
  479. RawPath = FilePath
  480. Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
  481. If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
  482. '加载常规信息
  483. If JsonData("Title") IsNot Nothing Then
  484. Title = JsonData("Title")
  485. Else
  486. Throw New ArgumentException("未找到 Title 项")
  487. End If
  488. Desc = If(JsonData("Description"), "")
  489. Search = If(JsonData("Keywords"), "")
  490. Logo = JsonData("Logo") '为保持 Nothing,不要加 If
  491. ShowInSearch = If(JsonData("ShowInSearch"), ShowInSearch)
  492. ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
  493. ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
  494. Types = New List(Of String)
  495. For Each NameOfType In If(JsonData("Types"), GetJson("[]"))
  496. Types.Add(NameOfType)
  497. Next
  498. '加载事件信息
  499. If If(JsonData("IsEvent"), False) Then
  500. EventType = JsonData("EventType")
  501. If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
  502. EventData = If(JsonData("EventData"), "")
  503. IsEvent = True
  504. Else
  505. Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml")
  506. If File.Exists(XamlAddress) Then
  507. XamlContent = ReadFile(XamlAddress)
  508. IsEvent = False
  509. Else
  510. Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件(" & XamlAddress & ")")
  511. End If
  512. End If
  513. End Sub
  514. ''' <summary>
  515. ''' 获取该 HelpEntry 对应的 MyListItem。
  516. ''' </summary>
  517. Public Function ToListItem() As MyListItem
  518. Return SetToListItem(New MyListItem)
  519. End Function
  520. ''' <summary>
  521. ''' 将属性设置入一个现有的 ListItem。
  522. ''' </summary>
  523. Public Function SetToListItem(Item As MyListItem) As MyListItem
  524. Dim Logo As String
  525. If IsEvent Then
  526. If EventType = "弹出窗口" Then
  527. Logo = PathImage & "Blocks/GrassPath.png"
  528. Else
  529. Logo = PathImage & "Blocks/CommandBlock.png"
  530. End If
  531. Else
  532. Logo = PathImage & "Blocks/Grass.png"
  533. End If
  534. '设置属性
  535. With Item
  536. .SnapsToDevicePixels = True
  537. .Title = Title
  538. .Info = Desc
  539. .Logo = If(Me.Logo, Logo)
  540. .Height = 42
  541. .Type = MyListItem.CheckType.Clickable
  542. .Tag = Me
  543. .EventType = Nothing
  544. .EventData = Nothing
  545. End With
  546. '项目的点击事件
  547. AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
  548. Return Item
  549. End Function
  550. End Class
  551. Public HelpLoader As New LoaderTask(Of Integer, List(Of HelpEntry))("Help Page", AddressOf HelpLoad,, ThreadPriority.BelowNormal)
  552. Private ReadOnly HelpLoadLock As New Object
  553. ''' <summary>
  554. ''' 初始化帮助列表对象。
  555. ''' </summary>
  556. Private Sub HelpLoad(Loader As LoaderTask(Of Integer, List(Of HelpEntry)))
  557. SyncLock HelpLoadLock '避免重复解压文件导致出错
  558. Try
  559. '解压内置文件
  560. HelpTryExtract()
  561. '遍历文件
  562. Dim FileList As New List(Of String)
  563. Try
  564. Dim IgnoreList As New List(Of String)
  565. '读取自定义文件
  566. If Directory.Exists(Path & "PCL\Help\") Then
  567. For Each File In EnumerateFiles(Path & "PCL\Help\")
  568. Select Case File.Extension.ToLower
  569. Case ".helpignore"
  570. '加载忽略列表
  571. Log("[Help] 发现 .helpignore 文件:" & File.FullName)
  572. For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
  573. Dim RealString As String = Line.BeforeFirst("#").Trim
  574. If String.IsNullOrWhiteSpace(RealString) Then Continue For
  575. IgnoreList.Add(RealString)
  576. If ModeDebug Then Log("[Help] > " & RealString)
  577. Next
  578. Case ".json"
  579. FileList.Add(File.FullName)
  580. End Select
  581. Next
  582. End If
  583. Log("[Help] 已扫描 PCL 文件夹下的帮助文件,目前总计 " & FileList.Count & " 条")
  584. '读取自带文件
  585. For Each File In EnumerateFiles(PathTemp & "Help")
  586. '跳过非 json 文件与以 . 开头的文件夹
  587. If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
  588. '检查忽略列表
  589. Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
  590. For Each Ignore In IgnoreList
  591. If RegexCheck(RealPath, Ignore) Then
  592. If ModeDebug Then Log("[Help] 已忽略 " & RealPath & ":" & Ignore)
  593. GoTo NextFile
  594. End If
  595. Next
  596. FileList.Add(File.FullName)
  597. NextFile:
  598. Next
  599. Log("[Help] 已扫描缓存文件夹下的帮助文件,目前总计 " & FileList.Count & " 条")
  600. Catch ex As Exception
  601. Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
  602. End Try
  603. If Loader.IsAborted Then Return
  604. '将文件实例化
  605. Dim Dict As New List(Of HelpEntry)
  606. For Each FilePath As String In FileList
  607. Try
  608. Dim Entry As New HelpEntry(FilePath)
  609. Dict.Add(Entry)
  610. If ModeDebug Then Log("[Help] 已加载的帮助条目:" & Entry.Title & " ← " & FilePath)
  611. Catch ex As Exception
  612. Log(ex, "初始化帮助条目失败(" & FilePath & ")", LogLevel.Msgbox)
  613. End Try
  614. Next
  615. '回设
  616. If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
  617. If Loader.IsAborted Then Return
  618. Loader.Output = Dict
  619. Catch ex As Exception
  620. Log(ex, "帮助列表初始化失败")
  621. Throw
  622. End Try
  623. End SyncLock
  624. End Sub
  625. ''' <summary>
  626. ''' 尝试解压内置帮助文件。
  627. ''' </summary>
  628. Public Sub HelpTryExtract()
  629. If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
  630. DeleteDirectory(PathTemp & "Help")
  631. Directory.CreateDirectory(PathTemp & "Help")
  632. WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
  633. ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8)
  634. Setup.Set("SystemHelpVersion", VersionCode)
  635. Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
  636. End If
  637. End Sub
  638. ''' <summary>
  639. ''' 对帮助文件约定的替换标记进行处理,如果遇到需要转义的字符会进行转义。
  640. ''' </summary>
  641. Public Function HelpArgumentReplace(Xaml As String) As String
  642. Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
  643. Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
  644. Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
  645. Return Result
  646. End Function
  647. #End Region
  648. #Region "愚人节"
  649. Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1
  650. Public IsAprilGiveup As Boolean = False
  651. Private AprilSpeed As New Vector(0, 0)
  652. Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
  653. Private AprilDistance As Integer = 0
  654. Private Sub TimerFool()
  655. Try
  656. If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
  657. If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Return
  658. '计算是否空闲
  659. Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
  660. If MousePos = AprilMousePosLast Then
  661. AprilIdieCount += 1
  662. Else
  663. AprilMousePosLast = MousePos
  664. AprilIdieCount = 0
  665. End If
  666. '计算躲避移动
  667. Dim Direction As Vector
  668. Dim Distance As Double
  669. Dim ButtonWidth = FrmLaunchLeft.BtnLaunch.ActualWidth / 2, ButtonHeight = FrmLaunchLeft.BtnLaunch.ActualHeight / 2
  670. Dim Vec As Vector = FrmMain.lastMouseArg.GetPosition(FrmLaunchLeft.BtnLaunch) - New Vector(ButtonWidth, ButtonHeight)
  671. Dim Dir As New Vector(Vec.X, Vec.Y)
  672. Dir.Normalize()
  673. Direction = -Dir
  674. Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
  675. Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
  676. Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度
  677. '计算回归移动
  678. If AprilIdieCount >= 64 * 5 Then
  679. Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
  680. Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
  681. If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
  682. Acc -= Back * 0.0005
  683. Back.Normalize()
  684. Acc -= Back * 0.15
  685. End If
  686. End If
  687. '回到边界
  688. Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
  689. If Relative.X < -ButtonWidth * 2 Then
  690. FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
  691. AprilSpeed.X -= 80
  692. If Relative.Y < 0 Then
  693. FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
  694. ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
  695. FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
  696. End If
  697. ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
  698. FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
  699. AprilSpeed.X += 80
  700. If Relative.Y < 0 Then
  701. FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
  702. ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
  703. FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
  704. End If
  705. ElseIf Relative.Y < -ButtonHeight * 2 Then
  706. FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
  707. AprilSpeed.Y -= 25
  708. If Relative.X < 0 Then
  709. FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
  710. ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
  711. FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
  712. End If
  713. ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
  714. FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
  715. AprilSpeed.Y += 25
  716. If Relative.X < 0 Then
  717. FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
  718. ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
  719. FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
  720. End If
  721. End If
  722. '移动
  723. AprilSpeed = AprilSpeed * 0.8 + Acc
  724. Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
  725. If SpeedValue < 0.01 Then Return
  726. AprilSpeed.Normalize()
  727. AprilSpeed *= SpeedValue
  728. AprilDistance += SpeedValue
  729. FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X
  730. FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y
  731. '大小改变
  732. FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
  733. FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
  734. '放弃提示
  735. If AprilDistance > 4000 Then
  736. AprilDistance = -4000
  737. Select Case RandomInteger(0, 3)
  738. Case 0
  739. Hint("放弃吧!只需要点一下右下角的小白旗……")
  740. Case 1
  741. Hint("看到右下角的那面小白旗了吗?")
  742. Case 2
  743. Hint("这里建议点一下右下角的小白旗投降呢.jpg")
  744. Case 3
  745. Hint("右下角的小白旗永远等着你……")
  746. End Select
  747. End If
  748. Catch ex As Exception
  749. Log(ex, "愚人节移动出错", LogLevel.Feedback)
  750. End Try
  751. End Sub
  752. #End Region
  753. #Region "系统"
  754. ''' <summary>
  755. ''' 把某个 PCL 窗口拖到最前面。
  756. ''' </summary>
  757. Public Sub ShowWindowToTop(Handle As IntPtr)
  758. Try
  759. PostMessage(Handle, 400 * 16 + 2, 0, 0)
  760. SetForegroundWindow(Handle) '不在这里放不行,神秘 WinAPI,建议别动
  761. Catch ex As Exception
  762. Log(ex, "设置窗口置顶失败", LogLevel.Hint)
  763. End Try
  764. End Sub
  765. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
  766. Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
  767. Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
  768. ''' <summary>
  769. ''' 将特定程序设置为使用高性能显卡启动。
  770. ''' 如果失败,则抛出异常。
  771. ''' </summary>
  772. Public Sub SetGPUPreference(Executeable As String)
  773. Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
  774. Const REG_VALUE As String = "GpuPreference=2;"
  775. '查看现有设置
  776. Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
  777. If ReadOnlyKey IsNot Nothing Then
  778. Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
  779. If REG_VALUE = CurrentValue?.ToString() Then
  780. Log($"[System] 无需调整显卡设置:{Executeable}")
  781. Return
  782. End If
  783. Else
  784. '创建父级键
  785. Log($"[System] 需要创建显卡设置的父级键")
  786. My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
  787. End If
  788. End Using
  789. '写入新设置
  790. Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
  791. WriteKey.SetValue(Executeable, REG_VALUE)
  792. Log($"[System] 已调整显卡设置:{Executeable}")
  793. End Using
  794. End Sub
  795. #End Region
  796. #Region "任务缓存"
  797. Private IsTaskTempCleared As Boolean = False
  798. Private IsTaskTempClearing As Boolean = False
  799. ''' <summary>
  800. ''' 尝试清理任务缓存文件夹。
  801. ''' 在整次运行中只会实际清理一次。
  802. ''' </summary>
  803. Public Sub TryClearTaskTemp()
  804. If Not IsTaskTempCleared Then
  805. IsTaskTempCleared = True
  806. IsTaskTempClearing = True
  807. Try
  808. Log("[System] 开始清理任务缓存文件夹")
  809. DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
  810. DeleteDirectory($"{PathTemp}TaskTemp\")
  811. Log("[System] 已清理任务缓存文件夹")
  812. Catch ex As Exception
  813. Log(ex, "清理任务缓存文件夹失败")
  814. Finally
  815. IsTaskTempClearing = False
  816. End Try
  817. ElseIf IsTaskTempClearing Then
  818. '等待另一个清理步骤完成
  819. Do While IsTaskTempClearing
  820. Thread.Sleep(1)
  821. Loop
  822. End If
  823. End Sub
  824. ''' <summary>
  825. ''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
  826. ''' 若所有缓存位置均没有权限,会抛出异常。
  827. ''' </summary>
  828. ''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
  829. Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
  830. TryClearTaskTemp()
  831. Dim ResultFolder As String
  832. Try
  833. ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
  834. If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
  835. Directory.CreateDirectory(ResultFolder)
  836. CheckPermissionWithException(ResultFolder)
  837. Return ResultFolder
  838. Catch
  839. End Try
  840. '使用备用路径
  841. ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
  842. Directory.CreateDirectory(ResultFolder)
  843. CheckPermission(ResultFolder)
  844. Return ResultFolder
  845. End Function
  846. #End Region
  847. Public DragControl = Nothing
  848. Private Timer4Count As Integer = 0
  849. Private Timer150Count As Integer = 0
  850. Private Sub TimerMain()
  851. Try
  852. #Region "每 50ms 执行一次的代码"
  853. HintTick()
  854. MyMsgBoxTick()
  855. FrmMain.DragTick()
  856. LoaderTaskbarProgressRefresh()
  857. If ThemeDontClick = 2 Then ThemeRefresh()
  858. #End Region
  859. Catch ex As Exception
  860. Log(ex, "短程主时钟执行异常", LogLevel.Critical)
  861. End Try
  862. Timer4Count += 1
  863. If Timer4Count = 4 Then
  864. Timer4Count = 0
  865. Try
  866. #Region "每 250ms 执行一次的代码"
  867. If ThemeNow = 12 Then ThemeRefresh()
  868. #End Region
  869. Catch ex As Exception
  870. Log(ex, "中程主时钟执行异常", LogLevel.Debug)
  871. End Try
  872. End If
  873. Timer150Count += 1
  874. If Timer150Count = 150 Then
  875. Timer150Count = 0
  876. Try
  877. #Region "每 7.5s 执行一次的代码"
  878. If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
  879. '以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
  880. RunInUi(
  881. Sub()
  882. If Not FrmMain.Hidden Then
  883. If FrmMain.Top < -9000 Then FrmMain.Top = 100
  884. If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
  885. End If
  886. End Sub)
  887. #End Region
  888. Catch ex As Exception
  889. Log(ex, "长程主时钟执行异常", LogLevel.Critical)
  890. End Try
  891. End If
  892. End Sub
  893. Public Sub TimerMainStart()
  894. RunInNewThread(
  895. Sub()
  896. Try
  897. Do While True
  898. RunInUiWait(AddressOf TimerMain)
  899. Thread.Sleep(50 * 0.98)
  900. Loop
  901. Catch ex As Exception
  902. Log(ex, "程序主时钟出错", LogLevel.Feedback)
  903. End Try
  904. End Sub, "Timer Main")
  905. If Not IsAprilEnabled Then Return
  906. RunInNewThread(
  907. Sub()
  908. Try
  909. Dim LastTime = My.Computer.Clock.TickCount
  910. Do While True
  911. If LastTime <> My.Computer.Clock.TickCount Then
  912. LastTime = My.Computer.Clock.TickCount
  913. RunInUiWait(AddressOf TimerFool)
  914. End If
  915. Thread.Sleep(1)
  916. Loop
  917. Catch ex As Exception
  918. Log(ex, "愚人节主时钟出错", LogLevel.Feedback)
  919. End Try
  920. End Sub, "Timer Main Fool")
  921. End Sub
  922. End Module