| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084 |
- Imports System.Collections.ObjectModel
- Imports System.Windows.Interop
- Imports System.Windows.Threading
- Public Module ModMain
- #Region "弹出提示"
- ''' <summary>
- ''' 提示信息的种类。
- ''' 该枚举在自定义事件中使用,是公开 API 的一部分。
- ''' </summary>
- Public Enum HintType
- Blue
- Green
- Red
- End Enum
- Private Structure HintMessage
- Public Text As String
- Public Type As HintType
- Public Log As Boolean
- End Structure
- ''' <summary>
- ''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
- ''' </summary>
- Private HintWaiting As New ConcurrentQueue(Of HintMessage)
- ''' <summary>
- ''' 在窗口左下角弹出提示文本。
- ''' </summary>
- Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
- HintWaiting.Enqueue(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
- End Sub
- Private Sub HintTick()
- Try
- 'Tag 存储了:{ 是否可以重用, Uuid }
- Dim CurrentHint As HintMessage = Nothing
- Do While HintWaiting.TryDequeue(CurrentHint)
- ''清除空提示
- 'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
- ' HintWaiting.RemoveAt(0)
- ' Continue Do
- 'End If
- '去回车
- CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
- '超量提示直接忽略
- If FrmMain.PanHint.Children.Count >= 20 Then GoTo EndHint
- '检查是否有重复提示
- Dim DoubleStack As Border = Nothing
- For Each stack As Border In FrmMain.PanHint.Children
- If stack.Tag(0) AndAlso CType(stack.Child, TextBlock).Text = CurrentHint.Text Then DoubleStack = stack
- Next
- '获取渐变颜色
- Dim TargetColor0, TargetColor1 As MyColor
- Dim Percent As Double = 0.3
- Select Case CurrentHint.Type
- Case HintType.Blue
- TargetColor0 = New MyColor(215, 37, 155, 252)
- TargetColor1 = New MyColor(215, 10, 142, 252)
- Case HintType.Green
- TargetColor0 = New MyColor(215, 33, 177, 33)
- TargetColor1 = New MyColor(215, 29, 160, 29)
- Case Else 'HintType.Red
- TargetColor0 = New MyColor(215, 255, 53, 11)
- TargetColor1 = New MyColor(215, 255, 43, 0)
- End Select
- If Not IsNothing(DoubleStack) Then
- '有重复提示,且该提示的进入动画已播放
- If Not AniIsRun("Hint Show " & DoubleStack.Tag(1)) Then
- AniStop("Hint Hide " & DoubleStack.Tag(1))
- Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
- AniStart({
- AaX(DoubleStack, -12 - DoubleStack.Margin.Left, 50,, New AniEaseOutFluent),
- AaX(DoubleStack, -8, 50, 50, New AniEaseInFluent),
- AaX(DoubleStack, 8, 50, 100, New AniEaseOutFluent),
- AaX(DoubleStack, -8, 50, 150, New AniEaseInFluent),
- AaDouble(Sub(i)
- Percent += i
- Dim Gradient As LinearGradientBrush = DoubleStack.Background
- Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
- Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
- End Sub, 0.7, 250),
- AaX(DoubleStack, -50, 200, Delay, New AniEaseInFluent),
- AaOpacity(DoubleStack, -1, 150, Delay),
- AaCode(Sub() DoubleStack.Tag(0) = False, Delay),
- AaHeight(DoubleStack, -26, 100,, New AniEaseOutFluent, True),
- AaCode(Sub() FrmMain.PanHint.Children.Remove(DoubleStack), , True)
- }, "Hint Hide " & DoubleStack.Tag(1))
- End If
- Else
- '准备控件
- 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)}
- NewHintControl.Background = New LinearGradientBrush(New GradientStopCollection(New List(Of GradientStop) From {
- New GradientStop(TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 0),
- New GradientStop(TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent), 1)}), 90)
- 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)}
- 'AddHandler NewHintControl.MouseLeftButtonDown, AddressOf HideAllHint
- FrmMain.PanHint.Children.Add(NewHintControl)
- '控件动画
- Dim Animations As New List(Of AniData)
- If FrmMain.PanHint.Children.Count > 1 Then
- '已有提示
- Animations.Add(AaHeight(NewHintControl, 26, 150, , New AniEaseOutFluent))
- Else
- '是唯一提示
- NewHintControl.Height = 26
- End If
- '开始动画
- Animations.AddRange({
- AaX(NewHintControl, 30, 400, , New AniEaseOutElastic(AniEasePower.Weak)),
- AaX(NewHintControl, 20, 200, , New AniEaseOutFluent),
- AaOpacity(NewHintControl, 1, 100),
- AaDouble(Sub(i)
- Percent += i
- Dim Gradient As LinearGradientBrush = NewHintControl.Background
- Gradient.GradientStops(0).Color = TargetColor0 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
- Gradient.GradientStops(1).Color = TargetColor1 * Percent + New MyColor(255, 255, 255) * (1 - Percent)
- End Sub, 0.7, 250, 100)
- })
- AniStart(Animations, "Hint Show " & NewHintControl.Tag(1))
- '结束动画
- Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
- AniStart({
- AaX(NewHintControl, -50, 200, Delay, New AniEaseInFluent),
- AaOpacity(NewHintControl, -1, 150, Delay),
- AaCode(Sub() NewHintControl.Tag(0) = False, Delay),
- AaHeight(NewHintControl, -26, 100,, New AniEaseOutFluent, True),
- AaCode(Sub() FrmMain.PanHint.Children.Remove(NewHintControl), , True)
- }, "Hint Hide " & NewHintControl.Tag(1))
- End If
- '结束处理
- EndHint:
- If CurrentHint.Log Then Logger.Info($"弹出提示:{CurrentHint.Text}")
- Loop
- Catch ex As Exception
- Logger.Info(ex, "显示弹出提示失败")
- End Try
- End Sub
- Private Sub HideAllHint()
- For Each Control As Border In FrmMain.PanHint.Children
- Control.IsHitTestVisible = False
- AniStart({
- AaX(Control, -50, 200, , New AniEaseInFluent),
- AaOpacity(Control, -1, 150, , New AniEaseInFluent),
- AaCode(Sub() Control.Tag(0) = False),
- AaHeight(Control, -26, 100,, New AniEaseOutFluent, True),
- AaCode(Sub() FrmMain.PanHint.Children.Remove(Control), , True)
- }, "Hint Hide " & Control.Tag(1))
- Next
- End Sub
- #End Region
- #Region "弹窗"
- ''' <summary>
- ''' 存储弹窗信息的转换器。
- ''' </summary>
- Public Class MyMsgBoxConverter
- Public Type As MyMsgBoxType
- Public Title As String
- Public Text As String
- ''' <summary>
- ''' 输入模式:文本框的文本。
- ''' 选择模式:需要放进去的 IEnumberable(Of IMyRadio)。
- ''' 登录模式:登录步骤 1 中返回的 JSON。
- ''' </summary>
- Public Content As Object
- ''' <summary>
- ''' 输入模式:输入验证规则。
- ''' </summary>
- Public ValidateRules As Collection(Of Validate)
- ''' <summary>
- ''' 输入模式:提示文本。
- ''' </summary>
- Public HintText As String = ""
- ''' <summary>
- ''' 有多个按钮时,是否给第一个按钮加高亮。
- ''' </summary>
- Public HighLight As Boolean
- Public Button1 As String = "确定"
- Public Button2 As String = ""
- Public Button3 As String = ""
- ''' <summary>
- ''' 点击第一个按钮将执行该方法,不关闭弹窗。
- ''' </summary>
- Public Button1Action As Action = Nothing
- ''' <summary>
- ''' 点击第二个按钮将执行该方法,不关闭弹窗。
- ''' </summary>
- Public Button2Action As Action = Nothing
- ''' <summary>
- ''' 点击第三个按钮将执行该方法,不关闭弹窗。
- ''' </summary>
- Public Button3Action As Action = Nothing
- Public IsWarn As Boolean = False
- Public ForceWait As Boolean = False
- Public WaitFrame As New DispatcherFrame(True)
- ''' <summary>
- ''' 弹窗是否已经关闭。
- ''' </summary>
- Public IsExited As Boolean = False
- ''' <summary>
- ''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
- ''' 选择模式:点击的按钮编号,从 1 开始。
- ''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
- ''' </summary>
- Public Result As Object
- End Class
- Public Enum MyMsgBoxType
- Text
- [Select]
- Input
- Login
- End Enum
- ''' <summary>
- ''' 显示弹窗,返回点击按钮的编号(从 1 开始)。
- ''' </summary>
- ''' <param name="Title">弹窗的标题。</param>
- ''' <param name="Caption">弹窗的内容。</param>
- ''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
- ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
- ''' <param name="Button3">显示的第三个按钮,默认为空。</param>
- ''' <param name="Button1Action">点击第一个按钮将执行该方法,不关闭弹窗。</param>
- ''' <param name="Button2Action">点击第二个按钮将执行该方法,不关闭弹窗。</param>
- ''' <param name="Button3Action">点击第三个按钮将执行该方法,不关闭弹窗。</param>
- ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
- Public Function MyMsgBox(Caption As String, Optional Title As String = "提示",
- Optional Button1 As String = "确定", Optional Button2 As String = "", Optional Button3 As String = "",
- Optional IsWarn As Boolean = False, Optional HighLight As Boolean = True, Optional ForceWait As Boolean = False,
- Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
- '将弹窗列入队列
- 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}
- If Button2.Length > 0 OrElse ForceWait Then
- '若有多个按钮则开始等待
- If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
- '主窗体尚未加载,用老土的弹窗来替代
- If Button2.Length > 0 Then
- Dim RawResult As MsgBoxResult =
- MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
- Select Case RawResult
- Case MsgBoxResult.Yes
- Converter.Result = 1
- Case MsgBoxResult.No
- Converter.Result = 2
- Case MsgBoxResult.Cancel
- Converter.Result = 3
- End Select
- Else
- MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
- Converter.Result = 1
- End If
- Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗:{Button1},{Button2},{Button3}")
- Else
- WaitingMyMsgBox.Enqueue(Converter)
- Try
- FrmMain.DragStop()
- If RunInUi() Then MyMsgBoxTick()
- ComponentDispatcher.PushModal()
- Dispatcher.PushFrame(Converter.WaitFrame)
- Finally
- ComponentDispatcher.PopModal()
- End Try
- End If
- Logger.Info($"普通弹框返回:{If(Converter.Result, "null")}")
- Return Converter.Result
- Else
- '不进行等待,直接返回
- WaitingMyMsgBox.Enqueue(Converter)
- Return 1
- End If
- End Function
- ''' <summary>
- ''' 显示输入框并返回输入的文本。若点击第二个按钮,则返回 Nothing。
- ''' </summary>
- ''' <param name="Title">弹窗的标题。</param>
- ''' <param name="ValidateRules">文本框的输入检测。</param>
- ''' <param name="Text">弹窗的介绍文本。</param>
- ''' <param name="DefaultInput">文本框的默认内容。</param>
- ''' <param name="HintText">文本框的提示内容。</param>
- ''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
- ''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param>
- ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
- Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
- '将弹窗列入队列
- Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
- WaitingMyMsgBox.Enqueue(Converter)
- '虽然我也不知道这是啥但是能用就成了 :)
- Try
- If FrmMain IsNot Nothing Then FrmMain.DragStop()
- If RunInUi() Then MyMsgBoxTick()
- ComponentDispatcher.PushModal()
- Dispatcher.PushFrame(Converter.WaitFrame)
- Finally
- ComponentDispatcher.PopModal()
- End Try
- Logger.Info($"输入弹框返回:{If(Converter.Result, "null")}")
- Return Converter.Result
- End Function
- ''' <summary>
- ''' 显示选择框并返回选择的第几项(从 0 开始)。若点击第二个按钮,则返回 Nothing。
- ''' </summary>
- ''' <param name="Title">弹窗的标题。</param>
- ''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param>
- ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
- ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
- Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
- '将弹窗列入队列
- Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
- WaitingMyMsgBox.Enqueue(Converter)
- '虽然我也不知道这是啥但是能用就成了 :)
- Try
- If FrmMain IsNot Nothing Then FrmMain.DragStop()
- If RunInUi() Then MyMsgBoxTick()
- ComponentDispatcher.PushModal()
- Dispatcher.PushFrame(Converter.WaitFrame)
- Finally
- ComponentDispatcher.PopModal()
- End Try
- Logger.Info($"选择弹框返回:{If(Converter.Result, "null")}")
- Return Converter.Result
- End Function
- ''' <summary>
- ''' 等待显示的弹窗。
- ''' </summary>
- Public WaitingMyMsgBox As New ConcurrentQueue(Of MyMsgBoxConverter)
- Public Sub MyMsgBoxTick()
- Try
- If FrmMain?.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
- Dim TargetMsgBox As MyMsgBoxConverter = Nothing
- If FrmMain.PanMsg.Children.Count > 0 Then
- '弹窗中
- FrmMain.PanMsg.Visibility = Visibility.Visible
- ElseIf WaitingMyMsgBox.TryDequeue(TargetMsgBox) Then
- '没有弹窗,显示一个等待的弹窗
- FrmMain.PanMsg.Visibility = Visibility.Visible
- Select Case TargetMsgBox.Type
- Case MyMsgBoxType.Input
- FrmMain.PanMsg.Children.Add(New MyMsgInput(TargetMsgBox))
- Case MyMsgBoxType.Select
- FrmMain.PanMsg.Children.Add(New MyMsgSelect(TargetMsgBox))
- Case MyMsgBoxType.Text
- FrmMain.PanMsg.Children.Add(New MyMsgText(TargetMsgBox))
- Case MyMsgBoxType.Login
- FrmMain.PanMsg.Children.Add(New MyMsgLogin(TargetMsgBox))
- End Select
- Else
- '没有弹窗,没有等待的弹窗
- If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
- End If
- Catch ex As Exception
- Logger.Error(ex, "处理等待中的弹窗失败")
- End Try
- End Sub
- #End Region
- #Region "页面声明"
- '在最后进行页面声明,避免颜色尚未加载完毕
- '窗体声明
- Public FrmMain As FormMain
- Public FrmStart As SplashScreen
- '页面声明(出于单元测试考虑,初始化页面已转入 FormMain 中)
- Public FrmLaunchLeft As PageLaunchLeft
- Public FrmLaunchRight As PageLaunchRight
- Public FrmSelectLeft As PageSelectLeft
- Public FrmSelectRight As PageSelectRight
- Public FrmSpeedLeft As PageSpeedLeft
- Public FrmSpeedRight As PageSpeedRight
- '联机页面声明
- Public FrmLinkMain As PageLinkMain
- '下载页面声明
- Public FrmDownloadLeft As PageDownloadLeft
- Public FrmDownloadInstall As PageDownloadInstall
- Public FrmDownloadMod As PageDownloadMod
- Public FrmDownloadPack As PageDownloadPack
- Public FrmDownloadDataPack As PageDownloadDataPack
- Public FrmDownloadShader As PageDownloadShader
- Public FrmDownloadResourcePack As PageDownloadResourcePack
- '设置页面声明
- Public FrmSetupLeft As PageSetupLeft
- Public FrmSetupLaunch As PageSetupLaunch
- Public FrmSetupUI As PageSetupUI
- Public FrmSetupSystem As PageSetupSystem
- Public FrmSetupLink As PageSetupLink
- '其他页面声明
- Public FrmOtherLeft As PageOtherLeft
- Public FrmOtherHelp As PageOtherHelp
- Public FrmOtherAbout As PageOtherAbout
- Public FrmOtherTest As PageOtherTest
- '登录页面声明
- Public FrmLoginLegacy As PageLoginLegacy
- Public FrmLoginNide As PageLoginNide
- Public FrmLoginNideSkin As PageLoginNideSkin
- Public FrmLoginAuth As PageLoginAuth
- Public FrmLoginAuthSkin As PageLoginAuthSkin
- Public FrmLoginMs As PageLoginMs
- Public FrmLoginMsSkin As PageLoginMsSkin
- '版本设置页面声明
- Public FrmInstanceLeft As PageInstanceLeft
- Public FrmInstanceOverall As PageInstanceOverall
- Public FrmInstanceMod As PageInstanceMod
- Public FrmInstanceModDisabled As PageInstanceModDisabled
- Public FrmInstanceSetup As PageInstanceSetup
- Public FrmInstanceExport As PageInstanceExport
- '资源信息分页声明
- Public FrmDownloadResourceDetail As PageDownloadResourceDetail
- #End Region
- #Region "帮助"
- Public Class HelpEntry
- ''' <summary>
- ''' 原始信息路径。用于刷新。
- ''' </summary>
- Public RawPath As String
- '基础
- ''' <summary>
- ''' 显示标题。
- ''' </summary>
- Public Title As String
- ''' <summary>
- ''' 显示描述。
- ''' </summary>
- Public Desc As String
- ''' <summary>
- ''' 检索关键字。
- ''' </summary>
- Public Search As String
- ''' <summary>
- ''' 用于分类的标签列表。
- ''' </summary>
- Public Types As List(Of String)
- '显示(可选)
- ''' <summary>
- ''' 帮助项的自定义图标。可能为 Nothing。
- ''' </summary>
- Public Logo As String = Nothing
- ''' <summary>
- ''' 是否显示在搜索结果。默认为 True。
- ''' </summary>
- Public ShowInSearch As Boolean = True
- ''' <summary>
- ''' 是否在公开版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
- ''' </summary>
- Public ShowInPublic As Boolean = True
- ''' <summary>
- ''' 是否在快照版的 PCL 中显示(这会影响主页与搜索)。默认为 True。
- ''' </summary>
- Public ShowInSnapshot As Boolean = True
- '动作
- ''' <summary>
- ''' 是否为 “执行事件”。
- ''' </summary>
- Public IsEvent As Boolean
- Public EventType As CustomEvent.EventType
- Public EventData As String
- ''' <summary>
- ''' 若非执行事件,其对应的 .xaml 本地文件内容。
- ''' </summary>
- Public XamlContent As String
- '转换
- ''' <summary>
- ''' 从文件初始化 HelpEntry 对象,失败会抛出异常。
- ''' </summary>
- Public Sub New(FilePath As String)
- RawPath = FilePath
- If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
- Dim JsonData As JObject = ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf StringUtils.XmlEscape).DeserializeJson()
- '加载常规信息
- If JsonData("Title") IsNot Nothing Then
- Title = JsonData("Title")
- Else
- Throw New ArgumentException("未找到 Title 项")
- End If
- Desc = If(JsonData("Description"), "")
- Search = If(JsonData("Keywords"), "")
- Logo = JsonData("Logo") '为保持 Nothing,不要加 If
- ShowInSearch = If(JsonData("ShowInSearch"), ShowInSearch)
- ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
- ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
- Types = New List(Of String)
- For Each NameOfType In If(JsonData("Types"), New JArray)
- Types.Add(NameOfType)
- Next
- '加载事件信息
- If If(JsonData("IsEvent"), False) Then
- EventType = JsonData("EventType").ToObject(Of CustomEvent.EventType)
- EventData = If(JsonData("EventData"), "")
- IsEvent = True
- Else
- Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
- If FileUtils.Exists(XamlAddress) Then
- XamlContent = FileUtils.ReadAsString(XamlAddress)
- IsEvent = False
- Else
- Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件(" & XamlAddress & ")")
- End If
- End If
- End Sub
- ''' <summary>
- ''' 获取该 HelpEntry 对应的 MyListItem。
- ''' </summary>
- Public Function ToListItem() As MyListItem
- Return SetToListItem(New MyListItem)
- End Function
- ''' <summary>
- ''' 将属性设置入一个现有的 ListItem。
- ''' </summary>
- Public Function SetToListItem(Item As MyListItem) As MyListItem
- Dim Logo As String
- If IsEvent Then
- If EventType = CustomEvent.EventType.弹出窗口 Then
- Logo = PathImage & "Blocks/GrassPath.png"
- Else
- Logo = PathImage & "Blocks/CommandBlock.png"
- End If
- Else
- Logo = PathImage & "Blocks/Grass.png"
- End If
- '设置属性
- With Item
- .SnapsToDevicePixels = True
- .Title = Title
- .Info = Desc
- .Logo = If(Me.Logo, Logo)
- .Height = 42
- .Type = MyListItem.CheckType.Clickable
- .Tag = Me
- End With
- CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性,它们会被下面的点击事件处理
- CustomEventService.SetEventData(Item, Nothing)
- '项目的点击事件
- AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
- Return Item
- End Function
- End Class
- Public HelpLoader As New LoaderTask(Of Integer, List(Of HelpEntry))("Help Page", AddressOf HelpLoad,, ThreadPriority.BelowNormal)
- Private ReadOnly HelpLoadLock As New Object
- ''' <summary>
- ''' 初始化帮助列表对象。
- ''' </summary>
- Private Sub HelpLoad(Loader As LoaderTask(Of Integer, List(Of HelpEntry)))
- SyncLock HelpLoadLock '避免重复解压文件导致出错
- Try
- '解压内置文件
- HelpTryExtract()
- '遍历文件
- Dim FileList As New List(Of String)
- Try
- Dim IgnoreList As New List(Of String)
- '读取自定义文件
- If DirectoryUtils.Exists(Paths.Base & "PCL\Help\") Then
- For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Help\", True)
- Select Case PathUtils.GetExtension(File)
- Case "helpignore"
- '加载忽略列表
- Logger.Info($"发现 .helpignore 文件:{File}")
- For Each Line In FileUtils.ReadAsLines(File, True)
- Dim RealString As String = Line.BeforeFirst("#").Trim
- If String.IsNullOrWhiteSpace(RealString) Then Continue For
- IgnoreList.Add(RealString)
- Logger.Trace($"> {RealString}")
- Next
- Case "json"
- FileList.Add(File)
- End Select
- Next
- End If
- Logger.Info($"已扫描 PCL 文件夹下的帮助文件,目前总计 {FileList.Count} 条")
- '读取自带文件
- For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
- '跳过非 json 文件与以 . 开头的文件夹
- If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
- '检查忽略列表
- Dim RealPath As String = File.Replace(PathTemp & "Help\", "")
- For Each Ignore In IgnoreList
- If RealPath.RegexCheck(Ignore) Then
- Logger.Trace($"已忽略 {RealPath}:{Ignore}")
- GoTo NextFile
- End If
- Next
- FileList.Add(File)
- NextFile:
- Next
- Logger.Info($"已扫描缓存文件夹下的帮助文件,目前总计 {FileList.Count} 条")
- Catch ex As Exception
- Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
- End Try
- If Loader.IsCanceled Then Return
- '将文件实例化
- Dim Dict As New List(Of HelpEntry)
- For Each FilePath As String In FileList
- Try
- Dim Entry As New HelpEntry(FilePath)
- Dict.Add(Entry)
- Logger.Trace($"已加载的帮助条目:{Entry.Title} ← {FilePath}")
- Catch ex As Exception
- Logger.Error(ex, $"初始化帮助条目失败({FilePath})", LogBehavior.Alert)
- End Try
- Next
- '回设
- If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
- If Loader.IsCanceled Then Return
- Loader.Output = Dict
- Catch ex As Exception
- Logger.Warn(ex, "帮助列表初始化失败")
- Throw
- End Try
- End SyncLock
- End Sub
- ''' <summary>
- ''' 尝试解压内置帮助文件。
- ''' </summary>
- Public Sub HelpTryExtract()
- If Settings.Get(Of Integer)("SystemHelpVersion") <> VersionCode OrElse Not FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
- DirectoryUtils.Delete(PathTemp & "Help")
- ExtractResources(PathTemp & "Cache\Help.zip", "Help")
- FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
- Settings.Set("SystemHelpVersion", VersionCode)
- Logger.Info($"已解压内置帮助文件,目前状态:{FileUtils.Exists(PathTemp + "Help\启动器\备份设置.xaml")}")
- End If
- End Sub
- #End Region
- #Region "愚人节"
- Private _IsAprilEnabled As Boolean? = Nothing
- Public ReadOnly Property IsAprilEnabled As Boolean
- Get
- If _IsAprilEnabled Is Nothing Then
- _IsAprilEnabled =
- Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
- Settings.Get(Of Integer)("AprilYear") <> Date.Now.Year '成功后同年内则不再触发
- End If
- Return _IsAprilEnabled.Value
- End Get
- End Property
- Public IsAprilGiveup As Boolean = False
- Private AprilDifficultiedDistance As Integer = 0
- Private Sub TimerFool()
- Try
- If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
- If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Return
- '计算是否空闲
- Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
- Static IdieCount As Integer = 0
- Static MousePosLast As New Point(0, 0)
- If MousePos = MousePosLast Then
- IdieCount += 1
- Else
- MousePosLast = MousePos
- IdieCount = 0
- End If
- '计算躲避移动
- Dim Direction As Vector
- Dim Distance As Double
- Dim ButtonWidth = FrmLaunchLeft.BtnLaunch.ActualWidth / 2, ButtonHeight = FrmLaunchLeft.BtnLaunch.ActualHeight / 2
- Dim Vec As Vector = FrmMain.lastMouseArg.GetPosition(FrmLaunchLeft.BtnLaunch) - New Vector(ButtonWidth, ButtonHeight)
- Dim Dir As New Vector(Vec.X, Vec.Y)
- Dir.Normalize()
- Direction = -Dir
- Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
- Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
- Dim Difficulty As Double = 1 / (1 + (AprilDifficultiedDistance / 6000) ^ 2) + 0.25 '难度,初始为 1.25x,6000 距离为 0.75x,12000 为 0.5x,24000 为 0.256x,最低 0.25x
- Dim Acc = Math.Max(0, -0.65 - Math.Log((Distance / Difficulty + 0.4) / 200)) * Direction * Difficulty '加速度
- 'FrmMain.Title = CInt(AprilTotalDistance) & " - " & Difficulty
- '5s 不动时回到起始点
- If IdieCount >= 64 * 5 Then
- Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
- Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
- If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
- Acc -= Back * 0.0005
- Back.Normalize()
- Acc -= Back * 0.15
- End If
- End If
- '回到边界
- Static Speed As New Vector(0, 0)
- Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
- If Relative.X < -ButtonWidth * 2 Then
- FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
- Speed.X -= 80
- If Relative.Y < 0 Then
- FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
- ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
- FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
- End If
- ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
- FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
- Speed.X += 80
- If Relative.Y < 0 Then
- FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
- ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
- FrmLaunchLeft.AprilPosTrans.Y -= ButtonHeight * 2.5
- End If
- ElseIf Relative.Y < -ButtonHeight * 2 Then
- FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
- Speed.Y -= 25
- If Relative.X < 0 Then
- FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
- ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
- FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
- End If
- ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
- FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
- Speed.Y += 25
- If Relative.X < 0 Then
- FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
- ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
- FrmLaunchLeft.AprilPosTrans.X -= ButtonWidth * 2
- End If
- End If
- '移动
- Speed = Speed * 0.8 + Acc
- Dim SpeedValue = Math.Min(60, Speed.Length)
- If SpeedValue < 0.01 Then Return
- Speed.Normalize()
- Speed *= SpeedValue
- AprilDifficultiedDistance += SpeedValue
- FrmLaunchLeft.AprilPosTrans.X += Speed.X
- FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
- '大小改变
- FrmLaunchLeft.AprilScaleTrans.ScaleX = (1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160)).Clamp(0.2, 1.8)
- FrmLaunchLeft.AprilScaleTrans.ScaleY = (1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100)).Clamp(0.2, 1.8)
- '放弃提示
- Static GiveUpDistance As Double = -1500
- GiveUpDistance += SpeedValue
- If GiveUpDistance > 2500 Then
- GiveUpDistance = 0
- Select Case RandomInteger(0, 3)
- Case 0
- Hint("放弃吧!只需要点一下右下角的小白旗……", HintType.Red)
- Case 1
- Hint("看到右下角的那面小白旗了吗?", HintType.Red)
- Case 2
- Hint("这里建议点一下右下角的小白旗投降呢.jpg", HintType.Red)
- Case 3
- Hint("右下角的小白旗永远等着你……", HintType.Red)
- End Select
- End If
- Catch ex As Exception
- Logger.Error(ex, "愚人节移动出错")
- End Try
- End Sub
- #End Region
- #Region "系统"
- ''' <summary>
- ''' 把某个 PCL 窗口拖到最前面。
- ''' </summary>
- Public Sub ShowWindowToTop(Handle As IntPtr)
- Try
- PostMessage(Handle, 400 * 16 + 2, 0, 0)
- SetForegroundWindow(Handle) '不在这里放不行,神秘 WinAPI,建议别动
- Catch ex As Exception
- Logger.Error(ex, "设置窗口置顶失败", LogBehavior.Toast)
- End Try
- End Sub
- Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
- Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
- Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
- ''' <summary>
- ''' 将特定程序设置为使用高性能显卡启动。
- ''' 如果失败,则抛出异常。
- ''' </summary>
- Public Sub SetGPUPreference(Executeable As String)
- Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
- Const REG_VALUE As String = "GpuPreference=2;"
- '查看现有设置
- Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
- If ReadOnlyKey IsNot Nothing Then
- If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
- Logger.Info($"无需调整显卡设置:{Executeable}")
- Return
- End If
- Else
- '创建父级键
- Logger.Info($"需要创建显卡设置的父级键")
- My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
- End If
- End Using
- '写入新设置
- Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
- WriteKey.SetValue(Executeable, REG_VALUE)
- Logger.Info($"已调整显卡设置:{Executeable}")
- End Using
- End Sub
- ''' <summary>
- ''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
- ''' </summary>
- Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
- If Text Is Nothing OrElse Not Text.Contains("{") Then Return Text
- '预处理(注意,文件夹必须以 \ 结尾)
- Static Replacer As Func(Of String, String) =
- Function(s As String) As String
- If s Is Nothing Then Return ""
- If EscapeHandler Is Nothing Then Return s
- If s.Contains(":\") Then
- Dim IsFolder = s.EndsWithF("\") OrElse s.EndsWithF("/")
- s = PathUtils.ToShortPath(s)
- If IsFolder Then s = PathUtils.AddSlashSuffix(s)
- End If
- Return EscapeHandler(s)
- End Function
- '基础
- Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
- Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
- Text = Text.Replace("{pcl_version_branch}", Replacer(BuildTypeDisplay))
- Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
- Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
- Text = Text.Replace("{identify}", Replacer(Identify))
- Text = Text.Replace("{path}", Replacer(Paths.Base))
- Text = Text.Replace("{path_with_name}", Replacer(PathExe))
- Text = Text.Replace("{path_temp}", Replacer(PathTemp))
- Text = Text.Replace("{pcl_md5}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Md5)))
- Text = Text.Replace("{pcl_sha1}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Sha1)))
- '时间
- If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
- Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
- Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
- End If
- 'Minecraft
- Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.Folder))
- Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
- If McInstanceSelected?.IsLoaded Then
- Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
- Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
- Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
- If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.Lower) Then
- Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
- Else
- Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
- End If
- Else
- Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
- Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
- Text = Text.Replace("{name}", Replacer(Nothing))
- Text = Text.Replace("{version}", Replacer(Nothing))
- End If
- '登录信息
- If McLoginLoader.State = LoadState.Finished Then
- Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
- Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.Lower))
- Select Case McLoginLoader.Input.Type
- Case McLoginType.Legacy
- Text = Text.Replace("{login}", Replacer("离线"))
- Case McLoginType.Ms
- Text = Text.Replace("{login}", Replacer("正版"))
- Case McLoginType.Nide
- Text = Text.Replace("{login}", Replacer("统一通行证"))
- Case McLoginType.Auth
- Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
- End Select
- Else
- Text = Text.Replace("{user}", Replacer(Nothing))
- Text = Text.Replace("{uuid}", Replacer(Nothing))
- Text = Text.Replace("{login}", Replacer(Nothing))
- End If
- '高级
- Text = Text.RegexReplace("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
- Text = Text.RegexReplace("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
- Text = Text.RegexReplace("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
- Text = Text.RegexReplace("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
- Text = Text.RegexReplace("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
- Return Text
- End Function
- #End Region
- #Region "任务缓存"
- Private IsTaskTempCleared As Boolean = False
- Private IsTaskTempClearing As Boolean = False
- ''' <summary>
- ''' 尝试清理任务缓存文件夹。
- ''' 在整次运行中只会实际清理一次。
- ''' </summary>
- Public Sub TryClearTaskTemp()
- If Not IsTaskTempCleared Then
- IsTaskTempCleared = True
- IsTaskTempClearing = True
- Try
- Logger.Info("开始清理任务缓存文件夹")
- DirectoryUtils.Delete($"{OsDrive}ProgramData\PCL\TaskTemp\")
- DirectoryUtils.Delete($"{PathTemp}TaskTemp\")
- Logger.Info("已清理任务缓存文件夹")
- Catch ex As Exception
- Logger.Warn(ex, "清理任务缓存文件夹失败")
- Finally
- IsTaskTempClearing = False
- End Try
- ElseIf IsTaskTempClearing Then
- '等待另一个清理步骤完成
- Do While IsTaskTempClearing
- Thread.Sleep(1)
- Loop
- End If
- End Sub
- ''' <summary>
- ''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
- ''' 若所有缓存位置均没有权限,会抛出异常。
- ''' </summary>
- ''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
- Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
- TryClearTaskTemp()
- Dim ResultFolder As String
- Try
- ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
- If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
- DirectoryUtils.Create(ResultFolder)
- CheckPermissionWithException(ResultFolder)
- Return ResultFolder
- Catch
- End Try
- '使用备用路径
- ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
- DirectoryUtils.Create(ResultFolder)
- CheckPermission(ResultFolder)
- Return ResultFolder
- End Function
- #End Region
- #Region "反馈与遥测"
- '反馈
- Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
- On Error Resume Next
- FeedbackInfo()
- If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
- OpenExplorer(Paths.Base & "PCL\Log1.txt")
- End If
- OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
- End Sub
- ''' <summary>
- ''' 在日志中输出系统诊断信息。
- ''' </summary>
- Public Sub FeedbackInfo()
- On Error Resume Next
- Logger.Warn($"诊断信息:{vbCrLf}" &
- "操作系统:" & My.Computer.Info.OSFullName & vbCrLf &
- "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
- "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
- "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
- "文件位置:" & Paths.Base)
- End Sub
- '遥测
- Public Sub Telemetry([Event] As String, ParamArray Datas As String())
- If BuildType = BuildTypes.Debug Then Return '开发版不上传遥测
- If Not Settings.Get(Of Boolean)("SystemSystemTelemetry") Then Return '用户关闭了遥测
- If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
- RunInNewThread(
- Sub()
- Try
- Logger.Info($"匿名数据上报:{[Event]}")
- Dim Url As String = $"{ClsBaseUrl}&Event={StringUtils.UrlEscape([Event])}"
- For i = 0 To Datas.Length - 1 Step 2
- Url &= "&" & StringUtils.UrlEscape(Datas(i)) & "=" & StringUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
- Next
- NetRequestByClient(Url, MakeLog:=False)
- Catch ex As Exception
- Logger.Warn(ex, "匿名数据上报失败")
- End Try
- End Sub, "Telemetry", ThreadPriority.Lowest)
- End Sub
- #End Region
- Public DragControl = Nothing
- Private Timer4Count As Integer = 0
- Private Timer150Count As Integer = 0
- Private Sub TimerMain()
- Try
- #Region "每 50ms 执行一次的代码"
- HintTick()
- MyMsgBoxTick()
- FrmMain.DragTick()
- LoaderTaskbarProgressRefresh()
- If ThemeDontClick = 2 Then ThemeRefresh()
- #End Region
- Catch ex As Exception
- Logger.Error(ex, "短程主时钟执行异常", LogBehavior.AlertThenCrash)
- End Try
- Timer4Count += 1
- If Timer4Count = 4 Then
- Timer4Count = 0
- Try
- #Region "每 250ms 执行一次的代码"
- If ThemeNow = 12 Then ThemeRefresh()
- #End Region
- Catch ex As Exception
- Logger.Warn(ex, "中程主时钟执行异常")
- End Try
- End If
- Timer150Count += 1
- If Timer150Count = 150 Then
- Timer150Count = 0
- Try
- #Region "每 7.5s 执行一次的代码"
- If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDifficultiedDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
- '以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
- RunInUi(
- Sub()
- If Not FrmMain.Hidden Then
- If FrmMain.Top < -9000 Then FrmMain.Top = 100
- If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
- End If
- End Sub)
- #End Region
- Catch ex As Exception
- Logger.Error(ex, "长程主时钟执行异常", LogBehavior.AlertThenCrash)
- End Try
- End If
- End Sub
- Public Sub TimerMainStart()
- RunInNewThread(
- Sub()
- Try
- Do While True
- RunInUiWait(AddressOf TimerMain)
- Thread.Sleep(50 * 0.98)
- Loop
- Catch ex As Exception
- Logger.Error(ex, "程序主时钟出错")
- End Try
- End Sub, "Timer Main")
- If Not IsAprilEnabled Then Return
- RunInNewThread(
- Sub()
- Try
- Dim LastTime = My.Computer.Clock.TickCount
- Do While True
- If LastTime <> My.Computer.Clock.TickCount Then
- LastTime = My.Computer.Clock.TickCount
- RunInUiWait(AddressOf TimerFool)
- End If
- Thread.Sleep(1)
- Loop
- Catch ex As Exception
- Logger.Error(ex, "愚人节主时钟出错")
- End Try
- End Sub, "Timer Main Fool")
- End Sub
- End Module
|