Public Class formSetup
'''
''' 是否可以写入设置。
'''
'''
Private CanWrite As Boolean = False
#Region "窗体初始化"
'''
''' 是否已经初始化过了。
'''
'''
Private IsFirstLoaded As Boolean = False
'初始化
Private Sub FormSystemSetup_ContentRendered(ByVal sender As Object, ByVal e As System.EventArgs) Handles panMain.Loaded
Try
RefreshHidden()
If IsFirstLoaded Then Exit Sub
'初始化
Log("[Setup] 读取设置开始")
UseControlAnimation = False
CanWrite = False
panMain.UpdateLayout()
panBack.Margin = New Thickness(0)
selecter.ShowList = {"启动设置", "界面设置", "下载设置", "主页设置", "系统设置", "关于"}
selecter.SelectIndex = 0
selecterHide.HintList = {"仅显示少量最常用的设置。", "显示所有普通设置。", "显示所有普通设置与高级设置。高级设置均以 * 标注,且只建议服主、整合作者和熟悉游戏的玩家打开。"}
selecterHide.ShowList = {"简洁模式", "普通模式", "高级模式"}
selecterHide.SelectIndex = ReadReg("SysLevel", "0")
'读取设置:系统设置
chSysTest.Checked = ReadReg("SysTest", "False")
chSysFeed.Checked = ReadReg("SysFeed", "True")
chSysOffline.Checked = ReadIni("setup", "SysOffline", "False")
chSysUpdate.Checked = ReadIni("setup", "SysUpdate", "True")
raSysUpdateHint.Checked = ReadIni("setup", "SysUpdateHint", "True")
raSysUpdateSetup.Checked = Not raSysUpdateHint.Checked
CType(FindName("raSystemWarn" & ReadReg("SystemWarn", "100")), Radiobox).Checked = True
chSysUpdateTest.Checked = ReadIni("setup", "SysUpdateTest", "False")
'读取设置:界面设置
chLaunchMending.Checked = ReadIni("setup", "LaunchMending", "True")
chUiShowLogo.Checked = ReadIni("setup", "UiShowLogo", "True")
textUiLauncherOpacity.Text = ReadIni("setup", "UiLauncherOpacity", "100")
CType(FindName("raUiTheme" & ReadIni("setup", "UiTheme", "0")), Radiobox).Checked = True
chUiBackground.Checked = File.Exists(PATH & "PCL\back.png")
btnUiBarReset.Visibility = If(File.Exists(PATH & "PCL\top.png"), Visibility.Visible, Visibility.Collapsed)
Dim IsBgm As Boolean = File.Exists(PATH & "PCL\bgm.mp3") Or File.Exists(PATH & "PCL\bgm.wav")
btnUiBgmReset.Visibility = If(IsBgm, Visibility.Visible, Visibility.Collapsed)
chUiBgm.Checked = IsBgm
chUiBgmAuto.Checked = ReadIni("setup", "UiBgmAuto", "True")
CType(FindName("raUiBackgroundShow" & ReadIni("setup", "UiBackgroundShow", "0")), Radiobox).Checked = True
textUiBackgroundOpacity.Text = ReadIni("setup", "UiBackgroundOpacity", "50")
textUiBackgroundURL.Text = ReadIni("setup", "UiBackgroundURL", "")
textUiBarURL.Text = ReadIni("setup", "UiBarURL", "")
chUiHiddenDownload.Checked = ReadIni("setup", "UiHiddenDownload", "False")
chUiHiddenForge.Checked = ReadIni("setup", "UiHiddenForge", "False")
chUiHiddenMinecraft.Checked = ReadIni("setup", "UiHiddenMinecraft", "False")
chUiHiddenOptiFine.Checked = ReadIni("setup", "UiHiddenOptiFine", "False")
chUiHiddenSetup.Checked = ReadIni("setup", "UiHiddenSetup", "False")
'读取设置:启动设置
chLaunchTopmost.Checked = ReadReg("LaunchTopmost", "False")
chLaunchNatives.Checked = ReadIni("setup", "LaunchNatives", "True")
CType(FindName("raLaunchVisibility" & ReadIni("setup", "LaunchVisibility", "3")), Radiobox).Checked = True
CType(FindName("raLaunchLevel" & ReadReg("LaunchLevel", "1")), Radiobox).Checked = True
chLaunchLog.Checked = ReadIni("setup", "LaunchLog", "False")
chLaunchLogWarn.Checked = ReadIni("setup", "LaunchLogWarn", "False")
CType(FindName("raLaunchSkin" & ReadReg("LaunchSkin", "3")), Radiobox).Checked = True
textLaunchSkinName.Text = ReadReg("LaunchSkinName", "")
textLaunchServer.Text = ReadIni("setup", "LaunchServer", "")
CType(FindName("raLaunchSplit" & ReadIni("setup", "LaunchSplit", "0")), Radiobox).Checked = True
CType(FindName("raLaunchMode" & ReadIni("setup", "LaunchMode", "0")), Radiobox).Checked = True
textLaunchModeWindowHeight.Text = ReadIni("setup", "LaunchModeWindowHeight", "480")
textLaunchModeWindowWidth.Text = ReadIni("setup", "LaunchModeWindowWidth", "854")
textLaunchJava.Text = ReadReg("SetupJavaPath", "")
textLaunchMaxRam.Text = ReadReg("LaunchMaxRam", "1024")
textLaunchShow.Text = ReadIni("setup", "LaunchShow", APPLICATION_FULL_NAME)
textLaunchTitle.Text = ReadIni("setup", "LaunchTitle", "")
textLaunchTitle.ToolTip = "Minecraft 游戏窗口的标题。留空为不更改。" & vbCrLf & "你可以使用以下通配符:" & vbCrLf & " \\v 对应版本的版本号(如 1.9.4)" & vbCrLf & " \\r 从 PCL 文件夹中的 RandomTitle.txt 中随机读取一行"
textLaunchJVM.Text = ReadIni("setup", "LaunchJVM", "-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True")
LoadMinecraftFolderList()
'读取设置:下载设置
chDownProcess.Checked = ReadIni("setup", "DownProcess", "True")
CType(FindName("raDownVersion" & ReadIni("setup", "DownVersion", "0")), Radiobox).Checked = True
CType(FindName("raDownAssets" & ReadIni("setup", "DownAssets", "0")), Radiobox).Checked = True
CType(FindName("raDownMinecraft" & ReadIni("setup", "DownMinecraft", "1")), Radiobox).Checked = True
CType(FindName("raDownOptiFine" & ReadIni("setup", "DownOptiFine", "1")), Radiobox).Checked = True
CType(FindName("raDownForge" & ReadIni("setup", "DownForge", "1")), Radiobox).Checked = True
CType(FindName("raDownForgeAction" & ReadIni("setup", "DownForgeAction", "1")), Radiobox).Checked = True
chDownMinecraftAssetsHint.Checked = ReadIni("setup", "DownMinecraftAssetsHint", "True")
chDownMinecraftAssetsAuto.Checked = ReadIni("setup", "DownMinecraftAssetsAuto", "True")
chDownOptiFineOpen.Checked = ReadIni("setup", "DownOptiFineOpen", "False")
chDownOptiFineFolder.Checked = ReadIni("setup", "DownOptiFineFolder", "True")
textDownFolder.Text = ReadIni("setup", "DownFolder", "")
textDownMaxinum.Text = ReadIni("setup", "DownMaxinum", "20")
'读取设置:主页设置
chHomeUpdate.Checked = ReadIni("setup", "HomeUpdate", "True")
chHomeUpdateRelease.Checked = ReadIni("setup", "HomeUpdateRelease", "False")
chHomeSave.Checked = ReadReg("HomeSave", "True")
chHomeEnabled.Checked = ReadIni("setup", "HomeEnabled", "True")
chHomeAutologin.Checked = ReadIni("setup", "HomeAutologin", "True")
chHomeAutoplay.Checked = ReadIni("setup", "HomeAutoplay", "True")
chHomeHide.Checked = ReadIni("setup", "HomeHide", "True")
chHomeFull.Checked = ReadIni("setup", "HomeFull", "True")
CType(FindName("raHomeAutoplaySpeed" & ReadIni("setup", "raHomeAutoplaySpeed", "1")), Radiobox).Checked = True
chHomePCLPush.Checked = ReadIni("setup", "HomePCLPush", "True")
chHomeMCBBSPush.Checked = ReadIni("setup", "HomeMCBBSPush", "True")
chHomeTbPush.Checked = ReadIni("setup", "HomeTbPush", "True")
chHomeForumPush.Checked = ReadIni("setup", "HomeForumPush", "False")
chHomeMojangPush.Checked = ReadIni("setup", "HomeMojangPush", "True")
For i As Integer = 0 To 100
Dim SourceString As String = ReadIni("setup", "HomeSource" & i)
If SourceString = "" Then Exit For
'分解字符串
Dim URL As String = SourceString.Split("|")(0)
Dim IsUsing As String = SourceString.Split("|")(1)
Dim Source As String = SourceString.Split("|")(2)
Dim Desc As String = SourceString.Split("|")(3)
Dim item = New ListItem With {.CanCheck = False, .Width = 500, .ButtonLogo = New BitmapImage(New Uri("/Images/appbar.settings.png", UriKind.Relative)), .UseLayoutRounding = True, .Name = "itemLaunchMain" & Rnd.NextDouble.ToString.Replace(".", ""), .MainText = Source, .SubText = If(Desc = "", URL, Desc), .Logo = New BitmapImage(New Uri("/Images/Block-" & IsUsing & ".png", UriKind.Relative))}
item.Version.LoadedByFile = IsUsing
'AddHandler item.ButtonClick, AddressOf SourceClick
'AddHandler item.IconClick, AddressOf IconClick
panHomeSourceList.Children.Insert(panHomeSourceList.Children.Count - 1, item)
Next i
chHomeVersionSwap.Checked = ReadIni("setup", "HomeVersionSwap", "True")
chHomeVersionOld.Checked = ReadIni("setup", "HomeVersionOld", "True")
Log("[Setup] 读取设置成功")
Catch ex As Exception
ExShow(ex, "读取设置失败", ErrorLevel.MsgboxAndFeedback)
Finally
'初始化结束
CanWrite = True
IsFirstLoaded = True
UseControlAnimation = True
End Try
End Sub
'绑定滚动条
Private Sub panSetupHost_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles panSetupHost.Loaded
If scroll.SetControl(panBack, False) Then AddHandler panMain.MouseWheel, AddressOf scroll.RunMouseWheel
End Sub
'刷新隐藏主题
Private Sub RefreshHidden()
If ReadReg("ThemeHunluan", "False") = "True" Then
raUiTheme100.IsEnabled = True
raUiTheme100.Context = "混乱黄"
End If
If ReadReg("ThemeDeathBlue", "False") = "True" Then
raUiTheme101.IsEnabled = True
raUiTheme101.Context = "死机蓝"
End If
End Sub
#End Region
#Region "通用设置更改"
Private Sub CheckBox_Change(ByVal sender As Checkbox, ByVal raiseByMouse As Boolean) Handles chSysTest.Change, chSysOffline.Change, chSysUpdate.Change, chSysUpdateTest.Change, chUiShowLogo.Change, chUiHiddenDownload.Change, chUiHiddenForge.Change, chUiHiddenMinecraft.Change, chUiHiddenOptiFine.Change, chUiHiddenSetup.Change, chHomeEnabled.Change, chLaunchNatives.Change, chDownMinecraftAssetsAuto.Change, chDownMinecraftAssetsHint.Change, chDownOptiFineFolder.Change, chDownOptiFineOpen.Change, chDownProcess.Change, chHomeAutologin.Change, chHomeAutoplay.Change, chHomePCLPush.Change, chHomeSave.Change, chHomeUpdate.Change, chHomeUpdateRelease.Change, chHomeVersionOld.Change, chHomeVersionSwap.Change, chLaunchLog.Change, chLaunchMending.Change, chLaunchLogWarn.Change, chLaunchTopmost.Change, chHomeMCBBSPush.Change, chHomeMojangPush.Change, chHomeTbPush.Change, chHomeForumPush.Change, chHomeHide.Change, chHomeFull.Change, chUiBgmAuto.Change, chSysFeed.Change
If Not CanWrite Then Exit Sub
'读取数据
Dim Target As String = sender.Tag
Dim IsReg As Boolean = False
If Target.StartsWith("*") Then
IsReg = True
Target = Mid(Target, 2)
End If
'写入设置
Try
If IsReg Then
WriteReg(Target, sender.Checked, True)
Else
WriteIni("setup", Target, sender.Checked)
End If
Catch ex As Exception
ExShow(ex, "写入设置失败:" & Target, ErrorLevel.AllUsers)
End Try
'引发各自事件
Select Case sender.Name
Case "chSysOffline"
If CanWrite Then RefreshOffline()
Case "chUiHiddenDownload", "chUiHiddenMinecraft", "chUiHiddenOptiFine", "chUiHiddenForge"
If CanWrite Then SetupRefreshHidden()
Case "chUiHiddenSetup"
If CanWrite Then
SetupRefreshHidden()
If ReadIni("setup", "UiHiddenSetup", "False") = "True" Then ShowHint("双击版本号可以进入被隐藏的设置页")
End If
Case "chLaunchMending"
File.Delete(PATH_MC & "PCL.ini") '强制重载版本列表
Pool.Add(New Thread(AddressOf PoolVersionList))
Case "chHomeVersionSwap", "chHomeVersionOld"
Pool.Add(New Thread(AddressOf PoolVersionList))
Case "chDownProcess"
WebTaskbarShow = sender.Checked
Case "chHomePCLPush"
If CanWrite Then
If Not sender.Checked Then
If MyMsgbox("PCL 推荐包含关于启动器的重要内容,并且不会含有任何商业广告,仅仅作为启动器通知和传播优秀作品的平台(如果你有任何优秀作品,都可以免费在 PCL 推荐上推广),确认要关闭吗?", "关闭确认", "算了不关闭了", "我还是要关闭") = 1 Then
sender.Checked = True
Exit Sub
End If
End If
ShowHint(New HintConverter("该设置将在重启后生效", HintState.Finish))
End If
Case "chHomeMCBBSPush", "chHomeTbPush", "chHomeMojangPush", "chHomeAdPush", "chHomeForumPush", "chHomeHide", "chSysUpdateTest", "chHomeEnabled"
If CanWrite Then ShowHint(New HintConverter("该设置将在重启后生效", HintState.Finish))
Case "chHomeAutoplay"
If CanWrite Then frmHomeLeft.ChangeSetup()
Case "chHomeFull"
If CanWrite Then
frmHomeLeft.ChangeSetup()
ShowHint(New HintConverter("该设置将在重启后生效", HintState.Finish))
End If
Case "chSysFeed"
AllowFeedback = chSysFeed.Checked
End Select
End Sub
Private Sub RadioBox_Change(ByVal sender As Radiobox, ByVal raiseByMouse As Boolean) Handles raSysUpdateHint.Change, raSysUpdateSetup.Change, raUiTheme0.Change, raUiTheme1.Change, raUiTheme100.Change, raUiTheme101.Change, raUiTheme2.Change, raUiTheme3.Change, raUiTheme4.Change, raUiBackgroundShow0.Change, raUiBackgroundShow1.Change, raUiBackgroundShow2.Change, raUiBackgroundShow3.Change, raUiBackgroundShow4.Change, raUiBackgroundShow5.Change, raLaunchMode0.Change, raLaunchMode1.Change, raLaunchVisibility0.Change, raLaunchVisibility1.Change, raLaunchVisibility4.Change, raLaunchVisibility2.Change, raLaunchVisibility3.Change, raDownAssets0.Change, raDownAssets1.Change, raDownMinecraft0.Change, raDownMinecraft1.Change, raDownOptiFine0.Change, raDownOptiFine1.Change, raDownVersion0.Change, raDownVersion1.Change, raHomeAutoplaySpeed0.Change, raHomeAutoplaySpeed1.Change, raHomeAutoplaySpeed2.Change, raDownForge0.Change, raDownForge1.Change, raLaunchLevel0.Change, raLaunchLevel1.Change, raLaunchLevel2.Change, raSystemWarn0.Change, raSystemWarn100.Change, raSystemWarn300.Change, raLaunchSplit0.Change, raLaunchSplit1.Change, raLaunchSplit2.Change, raLaunchSkin0.Change, raLaunchSkin1.Change, raLaunchSkin2.Change, raLaunchSkin3.Change, raDownForgeAction0.Change, raDownForgeAction1.Change
If Not CanWrite Then Exit Sub
If Not sender.Checked Then Exit Sub
'引发各自前置事件
Select Case sender.Name
Case "raLaunchVisibility0"
If MyMsgbox("如果设置为打开游戏后关闭启动器,更改游戏窗口标题、游戏崩溃诊断、日志分析、低内存警告等功能额可能会失效。如果你担心 PCL 后台运行影响游戏性能,可以设置为隐藏启动器 2 分钟后自动关闭。" & vbCrLf & "确定要继续设置为直接关闭吗?", "设置确认", "确定", "取消", , True) = 2 Then
raLaunchVisibility3.Checked = True
raLaunchVisibility0.Checked = False
Exit Sub
End If
End Select
'读取数据
Dim Data As String = sender.Tag
Dim IsReg As Boolean = False
If Data.StartsWith("*") Then
IsReg = True
Data = Mid(Data, 2)
End If
Dim Target As String = Data.Split("/")(0)
Dim NewValue As String = Data.Replace(Target & "/", "")
'写入设置
Try
If IsReg Then
WriteReg(Target, NewValue, True)
Else
WriteIni("setup", Target, NewValue)
End If
Catch ex As Exception
ExShow(ex, "写入设置失败:" & Target, ErrorLevel.AllUsers)
End Try
'引发各自事件
Select Case Target
Case "UiTheme"
raUiThemes_Change(sender)
Case "UiBackgroundShow"
SetupRefreshBackground()
Case "LaunchVisibility"
If NewValue = 0 Then chLaunchLog.Checked = False
Case "LaunchFolderSelect"
Dim th As New Thread(Sub()
PoolMinecraftFolder()
frmMain.Dispatcher.Invoke(Sub() LoadMinecraftFolderList())
End Sub)
th.Start()
Case "LaunchSkin"
Dim UserName As String = frmHomeRight.textLegacyUsername.Text
Dim th As New Thread(Sub() frmHomeRight.RefreshLegacySkin(UserName))
th.Start()
Case "HomeAutoplaySpeed"
If CanWrite Then frmHomeLeft.ChangeSetup()
End Select
End Sub
Private Sub TextBox_Change(ByVal sender As TextBox, ByVal e As System.Windows.Controls.TextChangedEventArgs) Handles textUiBackgroundURL.TextChanged, textUiBackgroundOpacity.TextChanged, textUiBarURL.TextChanged, textUiLauncherOpacity.TextChanged, textLaunchJava.TextChanged, textLaunchJVM.TextChanged, textLaunchMaxRam.TextChanged, textLaunchMaxRam.TextChanged, textLaunchModeWindowHeight.TextChanged, textLaunchModeWindowWidth.TextChanged, textLaunchShow.TextChanged, textDownFolder.TextChanged, textDownMaxinum.TextChanged, textLaunchTitle.TextChanged, textLaunchSkinName.TextChanged, textLaunchServer.TextChanged
If Not CanWrite Then Exit Sub
'读取数据
Dim Data As String = sender.Tag
Dim IsReg As Boolean = False
Dim IsNotReturn As Boolean = False
If Data.StartsWith("*") Then
IsReg = True
Data = Mid(Data, 2)
End If
If Data.StartsWith("=") Then
IsNotReturn = True
Data = Mid(Data, 2)
End If
Dim Target As String = Data.Split("/")(0)
Dim CheckMethod As String = Data.Split("/")(1)
Dim CheckResult As String = If(IsNotReturn, "", sender.Name.Replace("text", "lab"))
Dim CheckData() As String = {}
If Len(Data) > Len(Target) + Len(CheckMethod) + 1 Then
CheckData = (Mid(Data, Len(Target) + Len(CheckMethod) + 3)).Split("/")
End If
'至此提取出的有用信息:
' IsReg:是否写入注册表,为 False 时写入 setup.ini
' Target:设置项的 Key
' CheckMethod:输入检查的方式
' CheckResult:输入检查返回的目标 Label 名称
' CheckData():输入检查的额外数据
'输入检查
Try
Select Case CheckMethod
Case "Integer"
'类型为整数
Dim UserInput As Integer = GetDoubleFromString(sender.Text)
If Not UserInput.ToString = sender.Text Then
SetCheckResult("必须为一个整数", CheckResult, sender)
Exit Sub
ElseIf UserInput < Int(Val(CheckData(0))) Then
SetCheckResult("最小为 " & Int(Val(CheckData(0))), CheckResult, sender)
Exit Sub
ElseIf UserInput > Int(Val(CheckData(1))) Then
SetCheckResult("最大为 " & Int(Val(CheckData(1))), CheckResult, sender)
Exit Sub
End If
Case "URL"
'类型为网址
If sender.Text = "" Then
'为空不检查
ElseIf sender.Text.StartsWith("://") Or Not sender.Text.Contains("://") Then
SetCheckResult("必须为一个网址", CheckResult, sender)
Exit Sub
End If
Case "UUID"
'类型为 UUID
Dim UserInput = sender.Text.Replace("-", "").Replace(" ", "").ToUpper
If UserInput = "" Then GoTo NoError
Dim reg = RegexSearch(UserInput, "[0-9A-F]{32}")
If Not Len(UserInput) = 32 Then
SetCheckResult("长度应为 32 位", CheckResult, sender)
Exit Sub
ElseIf Not reg.Count = 1 Then
SetCheckResult("格式不正确", CheckResult, sender)
Exit Sub
End If
NoError:
Case "Ram"
'类型为 Ram(MB)
Dim UserInput As Integer = GetDoubleFromString(sender.Text)
If Not UserInput.ToString = sender.Text Then
SetCheckResult("必须为一个整数", CheckResult, sender)
Exit Sub
ElseIf UserInput < Int(Val(CheckData(0))) Then
SetCheckResult("最小为 256 M", CheckResult, sender)
Exit Sub
ElseIf UserInput > 1024 And Not Environment.Is64BitOperatingSystem Then
SetCheckResult("32 位系统最大为 1024 M", CheckResult, sender)
Exit Sub
ElseIf UserInput > Int((New Devices.ComputerInfo).TotalPhysicalMemory / 1024 / 1024) - 512 Then
SetCheckResult("最大为 " & Int((New Devices.ComputerInfo).TotalPhysicalMemory / 1024 / 1024) - 512 & " M", CheckResult, sender)
Exit Sub
End If
Case "Java"
sender.Text = sender.Text.Replace("javaw.exe", "")
'类型为 Java 路径
If Not Directory.Exists(sender.Text) Then
SetCheckResult("文件夹不存在", CheckResult, sender)
Exit Sub
End If
If Not CheckDirectoryPermission(sender.Text) Then
SetCheckResult("文件夹无法访问", CheckResult, sender)
Exit Sub
ElseIf Not (File.Exists(sender.Text & "\javaw.exe") And (File.Exists(sender.Text & "\jli.dll") Or sender.Text.Contains("javapath"))) Then
SetCheckResult("未找到 Java", CheckResult, sender)
Exit Sub
End If
'去“\”
Dim NewText As String = (New RegularExpressions.Regex("[\\]{2,10000}")).Replace(sender.Text, "\")
If NewText.EndsWith("\") Then NewText = Mid(NewText, 1, Len(NewText) - 1)
If Not NewText = sender.Text Then
sender.Text = NewText
sender.SelectionStart = sender.Text.Length
End If
Case "Folder"
'类型为文件夹
If sender.Text = "" Then
'为空不检查
Else
'检查
If sender.Text = "\" Or Not Directory.Exists(sender.Text) Then '莫名其妙的问题:Directory.Exists("\") = True
SetCheckResult("文件夹不存在", CheckResult, sender)
Exit Sub
End If
If Not CheckDirectoryPermission(sender.Text) Then
SetCheckResult("文件夹无法访问", CheckResult, sender)
Exit Sub
End If
'去“\”
Dim NewText As String = (New RegularExpressions.Regex("[\\]{2,10000}")).Replace(sender.Text, "\")
If Not NewText = sender.Text Then
sender.Text = NewText
sender.SelectionStart = sender.Text.Length
End If
End If
Case "UserName"
'类型为用户名
Dim SafeCheck = RegexSearch(sender.Text, "[^0-9A-Za-z_]+")
If SafeCheck.Count > 0 Then
SetCheckResult("用户名不合法", CheckResult, sender)
Exit Sub
End If
Case "NoPush"
'禁用英文单引号
If sender.Text.Contains("""") Then
SetCheckResult("不能包含英文单引号", CheckResult, sender)
Exit Sub
End If
Case "Any"
'不管了
End Select
SetCheckResult("", CheckResult, sender)
Catch ex As Exception
ExShow(ex, "进行输入检查失败:" & sender.Text)
End Try
'写入设置
Try
If IsReg Then
WriteReg(Target, sender.Text, True)
Else
WriteIni("setup", Target, sender.Text)
End If
Catch ex As Exception
ExShow(ex, "写入设置失败:" & Target, ErrorLevel.AllUsers)
End Try
'引发各自事件
Select Case sender.Name
Case "textUiLauncherOpacity"
If CanWrite Then frmMain.Opacity = ReadIni("setup", "UiLauncherOpacity", "100") / 100
Case "textUiBackgroundOpacity"
If CanWrite Then frmMain.imgMainBg.Opacity = ReadIni("setup", "UiBackgroundOpacity", "100") / 100
Case "textLaunchShow"
If CanWrite Then
If textLaunchShow.Text = "Searge" Then
textLaunchShow.Text = "#itzlipofutzli"
textLaunchShow.SelectionStart = textLaunchShow.Text.Length
End If
End If
Case "textLaunchSkinName"
Dim UserName As String = frmHomeRight.textLegacyUsername.Text
Dim th As New Thread(Sub() frmHomeRight.RefreshLegacySkin(UserName))
th.Start()
Case "textLaunchJava"
Dim th As New Thread(Sub() PoolJavaFolder(False))
th.Start()
Case "textDownMaxinum"
WebDownloadCountMax = sender.Text
Case "textDownFolder"
If Not (ReadIni("setup", "DownFolder", "\").EndsWith("\") Or ReadIni("setup", "DownFolder", "\") = "") Then
WriteIni("setup", "DownFolder", ReadIni("setup", "DownFolder", "") & "\")
End If
PATH_DOWNLOAD = ReadIni("setup", "DownFolder", "")
If Not PATH_DOWNLOAD.Contains("\") Then
PATH_DOWNLOAD = PATH & "PCL\download\"
WriteIni("setup", "DownFolder", "")
End If
Log("[Setup] 新的下载文件夹目录:" & PATH_DOWNLOAD)
End Select
End Sub
Private Sub ShowHide_Change(ByVal sender As Object, ByVal raiseByMouse As Boolean) Handles chSysUpdate.Change, raUiTheme4.Change, chUiBackground.Change, raLaunchMode1.Change, chDownMinecraftAssetsHint.Change, chHomeUpdate.Change, chHomeSave.Change, chHomeAutoplay.Change, raLaunchVisibility0.Change, raLaunchSkin3.Change, chUiBgm.Change
'判定是否显示
Dim IsShow As Boolean = sender.Checked
If sender.Name = "raLaunchVisibility0" Or sender.Name = "raLaunchMode1" Then IsShow = Not IsShow
'获取控件
Dim ChangeGrid As Grid = FindName("pan" & Mid(sender.Name, 3))
'改变高度
If IsShow Then
If UseControlAnimation Then
AniStart({AaHeight(ChangeGrid, CType(ChangeGrid.Children(0), Object).Height - ChangeGrid.Height, 200, , New AniEaseJumpEnd(0.7)), AaOpacity(ChangeGrid, 1 - ChangeGrid.Opacity, 200)}, ChangeGrid.Name)
Else
ChangeGrid.Height = CType(ChangeGrid.Children(0), Object).Height
ChangeGrid.Opacity = 1
End If
Else
If UseControlAnimation Then
AniStart({AaHeight(ChangeGrid, -ChangeGrid.Height, 150, , New AniEaseEnd), AaOpacity(ChangeGrid, -ChangeGrid.Opacity, 150)}, ChangeGrid.Name)
Else
ChangeGrid.Height = 0
ChangeGrid.Opacity = 0
End If
End If
End Sub
Private Sub levelChange(ByVal Selection As String) Handles selecterHide.SelectionChange
log("[Setup] 更改设置隐藏等级:" & Selection)
If CanWrite Then WriteReg("SysLevel", selecterHide.SelectIndex)
'变色
Select Case Selection
Case "简洁模式"
AniStart({
AaForeGround(selecterHide, New MyColor(29, 141, 40) - selecterHide.Foreground)
}, "SelecterHideChangeColor")
Case "普通模式"
AniStart({
AaForeGround(selecterHide, New MyColor(182, 182, 20) - selecterHide.Foreground)
}, "SelecterHideChangeColor")
Case "高级模式"
AniStart({
AaForeGround(selecterHide, New MyColor(191, 86, 0) - selecterHide.Foreground)
}, "SelecterHideChangeColor")
End Select
'在 N 与 A 下显示的部分
If Selection = "普通模式" Or Selection = "高级模式" Then
chSysFeed.Visibility = Visibility.Visible
chSysUpdateTest.Visibility = Visibility.Visible
panSysUpdate2.Height = 56
If panSysUpdate.Height > 1 And panSysUpdate.Height < 55 Then panSysUpdate.Height = panSysUpdate.Height + 28
labSysLowMem.Visibility = Visibility.Visible
panSysLowMem.Visibility = Visibility.Visible
chUiShowLogo.Visibility = Visibility.Visible
labUiLauncherOpacity.Visibility = Visibility.Visible
textUiLauncherOpacity.Visibility = Visibility.Visible
labDownSource.Visibility = Visibility.Visible
panDownAssets.Visibility = Visibility.Visible
panDownForge.Visibility = Visibility.Visible
panDownMinecraft.Visibility = Visibility.Visible
panDownOptiFine.Visibility = Visibility.Visible
panDownVersion.Visibility = Visibility.Visible
labDownMinecraft.Visibility = Visibility.Visible
chDownMinecraftAssetsHint.Visibility = Visibility.Visible
panDownMinecraftAssetsHint.Visibility = Visibility.Visible
labDownMaxinum.Visibility = Visibility.Visible
panDownMaxinum.Visibility = Visibility.Visible
chHomeAutoplay.Visibility = Visibility.Visible
panHomeAutoplay.Visibility = Visibility.Visible
Else
chSysFeed.Visibility = Visibility.Collapsed
chSysUpdateTest.Visibility = Visibility.Collapsed
panSysUpdate2.Height = 28
If panSysUpdate.Height > 28 Then panSysUpdate.Height = panSysUpdate.Height - 28
labSysLowMem.Visibility = Visibility.Collapsed
panSysLowMem.Visibility = Visibility.Collapsed
chUiShowLogo.Visibility = Visibility.Collapsed
labUiLauncherOpacity.Visibility = Visibility.Collapsed
textUiLauncherOpacity.Visibility = Visibility.Collapsed
labDownSource.Visibility = Visibility.Collapsed
panDownAssets.Visibility = Visibility.Collapsed
panDownForge.Visibility = Visibility.Collapsed
panDownMinecraft.Visibility = Visibility.Collapsed
panDownOptiFine.Visibility = Visibility.Collapsed
panDownVersion.Visibility = Visibility.Collapsed
labDownMinecraft.Visibility = Visibility.Collapsed
chDownMinecraftAssetsHint.Visibility = Visibility.Collapsed
panDownMinecraftAssetsHint.Visibility = Visibility.Collapsed
labDownMaxinum.Visibility = Visibility.Collapsed
panDownMaxinum.Visibility = Visibility.Collapsed
chHomeAutoplay.Visibility = Visibility.Collapsed
panHomeAutoplay.Visibility = Visibility.Collapsed
End If
'只在 A 下显示的部分
If Selection = "高级模式" Then
chSysOffline.Visibility = Visibility.Visible
labUiBackgroundURL.Visibility = Visibility.Visible
textUiBackgroundURL.Visibility = Visibility.Visible
labUiBarURL.Visibility = Visibility.Visible
textUiBarURL.Visibility = Visibility.Visible
labUiHide.Visibility = Visibility.Visible
panUiHide1.Visibility = Visibility.Visible
panUiHide2.Visibility = Visibility.Visible
chLaunchNatives.Visibility = Visibility.Visible
labLaunchJVM.Visibility = Visibility.Visible
panLaunchJVM.Visibility = Visibility.Visible
chLaunchLogWarn.Visibility = Visibility.Visible
panLaunchVisibility02.Height = 56
labLaunchServer.Visibility = Visibility.Visible
textLaunchServer.Visibility = Visibility.Visible
If panLaunchVisibility0.Height > 1 And panLaunchVisibility0.Height < 55 Then panLaunchVisibility0.Height = panLaunchVisibility0.Height + 28
chLaunchMending.Visibility = Visibility.Visible
chDownProcess.Visibility = Visibility.Visible
labHomeVersion.Visibility = Visibility.Visible
chHomeVersionOld.Visibility = Visibility.Visible
chHomeVersionSwap.Visibility = Visibility.Visible
chHomeHide.Visibility = Visibility.Visible
chHomeFull.Visibility = Visibility.Visible
chSysTest.Visibility = Visibility.Visible
Else
chSysOffline.Visibility = Visibility.Collapsed
labUiBackgroundURL.Visibility = Visibility.Collapsed
textUiBackgroundURL.Visibility = Visibility.Collapsed
labUiBarURL.Visibility = Visibility.Collapsed
textUiBarURL.Visibility = Visibility.Collapsed
labUiHide.Visibility = Visibility.Collapsed
panUiHide1.Visibility = Visibility.Collapsed
panUiHide2.Visibility = Visibility.Collapsed
chLaunchNatives.Visibility = Visibility.Collapsed
labLaunchJVM.Visibility = Visibility.Collapsed
panLaunchJVM.Visibility = Visibility.Collapsed
panLaunchVisibility02.Height = 28
chLaunchLogWarn.Visibility = Visibility.Collapsed
labLaunchServer.Visibility = Visibility.Collapsed
textLaunchServer.Visibility = Visibility.Collapsed
If panLaunchVisibility0.Height > 28 Then panLaunchVisibility0.Height = panLaunchVisibility0.Height - 28
chLaunchMending.Visibility = Visibility.Collapsed
chDownProcess.Visibility = Visibility.Collapsed
labHomeVersion.Visibility = Visibility.Collapsed
chHomeVersionOld.Visibility = Visibility.Collapsed
chHomeVersionSwap.Visibility = Visibility.Collapsed
chHomeHide.Visibility = Visibility.Collapsed
chHomeFull.Visibility = Visibility.Collapsed
chSysTest.Visibility = Visibility.Collapsed
End If
End Sub
Private Sub Reset_Change(ByVal sender As TextBox, ByVal e As Controls.TextChangedEventArgs) Handles textLaunchJVM.TextChanged, textDownMaxinum.TextChanged
Dim ShouldReset As Boolean = sender.Text = FindName(sender.Name.Replace("text", "btn") & "Reset").Tag
AniStart({
AaWidth(sender, 455 + If(ShouldReset, 45, 0) - sender.Width, 150, , New AniEaseEnd)
}, sender.Name & "Reset")
End Sub
Private Sub Reset_Click(ByVal sender As Label, ByVal e As EventArgs) Handles btnLaunchJVMReset.MouseLeftButtonUp, btnDownMaxinumReset.MouseLeftButtonUp
FindName(sender.Name.Replace("btn", "text").Replace("Reset", "")).Text = sender.Tag
End Sub
'''
''' 设置输入检查结果。
'''
''' 错误原因。如果没有错误则设置为空。
''' 作为显示目标的 Label 的名称。
''' 作为显示目标的 TextBox。
'''
Private Sub SetCheckResult(ByVal Reason As String, ByVal TargetLabelName As String, ByVal TargetTextBox As TextBox)
Dim TargetLabel As Label = Nothing
If Not TargetLabelName = "" Then TargetLabel = FindName(TargetLabelName)
If Reason = "" Then
If Not IsNothing(TargetLabel) Then TargetLabel.Content = TargetLabel.Tag
AniStart({
AaBorderBrush(TargetTextBox, New MyColor(Application.Current.Resources("ColorE4")) - New MyColor(CType(TargetTextBox.BorderBrush, SolidColorBrush).Color), 150),
AaForeGround(TargetTextBox, New MyColor(0, 0, 0) - New MyColor(CType(TargetTextBox.Foreground, SolidColorBrush).Color), 150)
}, TargetTextBox.Name)
Else
If Not IsNothing(TargetLabel) Then TargetLabel.Content = TargetLabel.Tag & " - " & Reason
AniStart({
AaBorderBrush(TargetTextBox, New MyColor(255, 0, 0) - New MyColor(CType(TargetTextBox.BorderBrush, SolidColorBrush).Color), 150),
AaForeGround(TargetTextBox, New MyColor(255, 0, 0) - New MyColor(CType(TargetTextBox.Foreground, SolidColorBrush).Color), 150)
}, TargetTextBox.Name)
End If
End Sub
#End Region
#Region "左边栏"
Private Sub selecter_Click(ByVal Selection As String, ByVal Index As Integer) Handles Selecter.Click
AniStart({
AaValue(scroll, FindName("line" & Selection).TranslatePoint(New Point(0, 0), panSetupHost).Y - 33, 150, , New AniEaseEnd)
}, "SelecterChange" & GetUUID())
End Sub
Private Sub timerLeft_Tick() Handles timerLeft.Tick
Dim FindIndex As Byte = 0
For i = selecter.ShowList.Length - 1 To 0 Step -1
Dim lab As Rectangle = FindName("line" & selecter.ShowList(i))
If lab.TranslatePoint(New Point(0, 0), panSetupHost).Y <= 150 Then
FindIndex = i
Exit For
End If
Next
If Not FindIndex = selecter.SelectIndex Then selecter.SelectIndex = FindIndex
End Sub
#End Region
#Region "系统设置"
'调试模式
Private Sub chSysTest_Change() Handles chSysTest.Change
MODE_DEBUG = chSysTest.Checked Or MODE_DEVELOPER
frmMain.labTopVer.Content = VERSION_NAME & If(MODE_DEVELOPER, " | 开发者模式", If(MODE_DEBUG, " | 调试模式", "")) & If(MODE_OFFLINE, " | 离线模式", "")
End Sub
'清理缓存
Private Sub btnSysCache_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysCache.Click
On Error Resume Next
Dim TotalSize As FileSize = 0
Dim Files As ArrayList = GetFilesFromPath(PATH & "PCL\cache")
For Each File As String In Files
TotalSize = TotalSize + GetFileSize(File)
IO.File.Delete(File)
Next
If TotalSize = 0 Then
ShowHint(New HintConverter("没有可清除的缓存", HintState.Finish))
Else
ShowHint(New HintConverter("已清除 " & TotalSize.ToString & " 缓存", HintState.Finish))
End If
End Sub
'清理支持库
Private Sub btnSysLib_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysLib.Click
Try
Dim TotalSize As FileSize = 0
'删除libraries
Dim Files As ArrayList = GetFilesFromPath(PATH_MC & "libraries")
For Each File As String In Files
Try
If Not (File.ToLower.Contains("forge") Or File.ToLower.Contains("optifine")) Then
TotalSize = TotalSize + GetFileSize(File)
IO.File.Delete(File)
End If
Catch
End Try
Next
'返回
If TotalSize = 0 Then
ShowHint(New HintConverter("没有可清除的支持库", HintState.Finish))
Else
ShowHint(New HintConverter("已清除 " & TotalSize.ToString & " 支持库", HintState.Finish))
End If
Catch ex As Exception
ExShow(ex, "清除支持库失败", ErrorLevel.MsgboxAndFeedback)
End Try
End Sub
'清理版本信息
Private Sub btnSysVersion_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysVersion.Click
Try
'删除各版本信息
If Directory.Exists(PATH_MC & "versions\") Then
'versions文件夹存在
For Each Folder As DirectoryInfo In (New DirectoryInfo(PATH_MC & "versions")).GetDirectories
If Directory.Exists(Folder.FullName & "\PCL") Then Directory.Delete(Folder.FullName & "\PCL", True)
Next
File.Delete(PATH_MC & "PCL.ini")
End If
'返回
ShowHint(New HintConverter("已清除版本信息", HintState.Finish))
Pool.Add(New Thread(AddressOf PoolVersionList))
Catch ex As Exception
ExShow(ex, "清除版本信息失败", ErrorLevel.MsgboxAndFeedback)
End Try
End Sub
'打开日志
Private Sub btnSysLog_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysLog.Click
Shell("notepad", """" & PATH & "PCL\log.txt""")
End Sub
'打开文件夹
Private Sub btnSysFolder_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysFolder.Click
Process.Start(PATH & "PCL\")
End Sub
'意见反馈
Private Sub btnSysBack_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysBack.Click, btnAboutFolder.Click
Feedback()
End Sub
'重置启动器
Private Sub ReloadPCL(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSysAll.Click
If Not CanWrite Then Exit Sub
If MyMsgbox("重置将会删除 PCL 的所有文件(主程序与 Minecraft 的文件不受影响),你确定要重置吗?重置后 PCL 将会自动关闭。", "重置警告", "确定", "取消", IsWarn:=True) = 2 Then Exit Sub
StartReload:
On Error Resume Next
frmMain.Visibility = Visibility.Collapsed
frmMain.UpdateLayout()
'清除注册表信息
'My.Computer.Registry.CurrentUser.DeleteSubKey("Software\" & APPLICATION_SHORT_NAME, False)
'读取各版本信息
If Directory.Exists(PATH_MC & "versions\") Then
'versions文件夹存在
For Each Folder As DirectoryInfo In (New DirectoryInfo(PATH_MC & "versions")).GetDirectories
If Directory.Exists(Folder.FullName & "\PCL") Then Directory.Delete(Folder.FullName & "\PCL", True)
Next
File.Delete(PATH_MC & "PCL.ini")
End If
'删除PCL存档目录
Directory.Delete(PATH & "PCL", True)
File.Delete(PATH_MC & "PCL.ini")
'结束程序
EndForce()
End Sub
#End Region
#Region "界面设置"
'主题
Private Sub raUiThemes_Change(ByVal sender As Radiobox)
If CanWrite And sender.Checked Then RefreshTheme()
End Sub
'自定义
Private Sub ThemeCustomChange(ByVal sender As StackPanel, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles btnUiCustom1.MouseDown, btnUiCustom2.MouseDown, btnUiCustom3.MouseDown, btnUiCustom4.MouseDown, btnUiCustom5.MouseDown
If Not CanWrite Then Exit Sub
On Error Resume Next
Dim selector As New Forms.ColorDialog
selector.Color = System.Drawing.Color.FromArgb(ReadIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorR"), CType(FindResource("ColorE" & Right(sender.Name, 1)), Color).R), ReadIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorG"), CType(FindResource("ColorE" & Right(sender.Name, 1)), Color).G), ReadIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorB"), CType(FindResource("ColorE" & Right(sender.Name, 1)), Color).B))
selector.ShowDialog()
If Not selector.Color = CType(FindResource("ColorE" & Right(sender.Name, 1)), MyColor) Then
WriteIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorR"), selector.Color.R)
WriteIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorG"), selector.Color.G)
WriteIni("setup", sender.Name.Replace("btnUiCustom", "UiThemeColorB"), selector.Color.B)
RefreshTheme()
End If
selector.Dispose()
End Sub
'设置背景图片
Private Sub btnUiCustomBackground_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBackgroundSet.Click
If CanWrite Then
'试图启用
Dim fileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.jpeg)|*.png;*.jpg;*.gif;*.jpeg", "选择作为背景的图片(最适宜大小为 740×323)")
'选择文件结束
If fileName = "" Then Exit Sub
Try
'设置当前显示
frmMain.imgMainBg.Source = New MyBitmap(fileName)
'拷贝文件
File.Delete(PATH & "PCL\back.png")
File.Copy(fileName, PATH & "PCL\back.png")
Catch ex As Exception
ExShow(ex, "切换背景图片失败", ErrorLevel.MsgboxAndFeedback)
Finally
chUiBackground.Checked = File.Exists(PATH & "PCL\back.png")
End Try
End If
End Sub
'清除背景图片
Private Sub btnUiBackgroundReset_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBackgroundReset.Click
File.Delete(PATH & "PCL\back.png")
chUiBackground.Checked = File.Exists(PATH & "PCL\back.png")
RefreshTheme()
End Sub
'背景图片框显示
Private Sub chUiBackground_Change() Handles chUiBackground.Change
btnUiBackgroundReset.Visibility = If(chUiBackground.Checked, Visibility.Visible, Visibility.Collapsed)
End Sub
'设置顶栏图片
Private Sub btnUiBarSet_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBarSet.Click
If CanWrite Then
'试图启用
Dim fileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif;*.jpeg)|*.png;*.jpg;*.gif;*.jpeg", "选择作为顶栏的图片(最适宜大小为 740×92)")
'选择文件结束
If fileName = "" Then Exit Sub
Try
'拷贝文件
File.Delete(PATH & "PCL\top.png")
File.Copy(fileName, PATH & "PCL\top.png")
'设置当前显示
CType(CType(frmMain.panTop.Background, Object), ImageBrush).ImageSource = New MyBitmap(fileName)
CType(frmMain.panTop.Background, Object).Stretch = Stretch.None
CType(frmMain.panTop.Background, Object).TileMode = TileMode.Tile
CType(CType(frmMain.panTop.Background, Object), ImageBrush).Viewport = (New RectConverter()).ConvertFromString("0,0," & CType(CType(frmMain.panTop.Background, Object).ImageSource, ImageSource).Width & "," & CType(CType(frmMain.panTop.Background, Object).ImageSource, ImageSource).Height)
Catch ex As Exception
ExShow(ex, "切换顶栏图片失败", ErrorLevel.MsgboxAndFeedback)
Finally
btnUiBarReset.Visibility = If(File.Exists(PATH & "PCL\top.png"), Visibility.Visible, Visibility.Collapsed)
End Try
End If
End Sub
'清除顶栏图片
Private Sub btnUiBarReset_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBarReset.Click
File.Delete(PATH & "PCL\top.png")
btnUiBarReset.Visibility = If(File.Exists(PATH & "PCL\top.png"), Visibility.Visible, Visibility.Collapsed)
RefreshTheme()
End Sub
'设置BGM
Private Sub btnUiBgmSet_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBgmSet.Click
If CanWrite Then
'试图启用
Dim fileName As String = SelectFile("音乐(*.wav; .mp3)|*.wav;*.mp3", "选择背景音乐文件")
'选择文件结束
If fileName = "" Then Exit Sub
Try
btnUiBgmReset_Click(Nothing, Nothing)
'拷贝文件
Dim currentPath As String = PATH & "PCL\bgm" & If(fileName.EndsWith(".wav"), ".wav", ".mp3")
File.Copy(fileName, currentPath)
'设置当前音乐
PlayBgm(currentPath, False, True)
IsPlayingMusic = True
Catch ex As Exception
ExShow(ex, "设置背景音乐失败", ErrorLevel.AllUsers)
Finally
Dim IsRight As Boolean = File.Exists(PATH & "PCL\bgm.mp3") Or File.Exists(PATH & "PCL\bgm.wav")
chUiBgm.Checked = IsRight
btnUiBgmReset.Visibility = If(IsRight, Visibility.Visible, Visibility.Collapsed)
frmMain.imgTopMusic.Visibility = If(IsRight, Visibility.Visible, Visibility.Collapsed)
End Try
End If
End Sub
'清除背景音乐
Private Sub btnUiBgmReset_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnUiBgmReset.Click
If File.Exists(PATH & "PCL\bgm.wav") Then
PlayBgm(PATH & "PCL\bgm.wav", True)
File.Delete(PATH & "PCL\bgm.wav")
End If
If File.Exists(PATH & "PCL\bgm.mp3") Then
PlayBgm(PATH & "PCL\bgm.mp3", True)
File.Delete(PATH & "PCL\bgm.mp3")
End If
btnUiBgmReset.Visibility = Visibility.Collapsed
frmMain.imgTopMusic.Visibility = Windows.Visibility.Collapsed
chUiBgm.Checked = False
IsPlayingMusic = False
End Sub
#End Region
#Region "启动设置"
'重新加载 MC 文件夹列表显示
Private Sub LoadMinecraftFolderList()
Try
panLaunchFolderList.Children.Clear()
Dim SelectingFolder = ReadIni("setup", "LaunchFolderSelect", "")
Dim AllFoldersList As New ArrayList From {PATH & ".minecraft\"}
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
If CheckDirectoryPermission(MojangPath & "versions\") Then AllFoldersList.Add(MojangPath)
AllFoldersList.AddRange(ReadIni("setup", "LaunchFolders", "").Split("|"))
AllFoldersList = ArrayNoDouble(AllFoldersList.ToArray)
For Each Folder As String In AllFoldersList
If Not Folder.Replace(" ", "") = "" Then
Dim Disc As String
Select Case Folder
Case PATH & ".minecraft\"
Disc = "当前文件夹(" & Folder & ")"
Case MojangPath
Disc = "官方启动器文件夹(" & Folder & ")"
Case Else
Disc = Folder
End Select
Dim Radio As New Radiobox With {.Context = Disc, .Checked = Folder = SelectingFolder, .Tag = "LaunchFolderSelect/" & Folder, .Name = "LaunchFolderSelectUUID" & GetUUID()}
AddHandler Radio.Change, AddressOf RadioBox_Change
If Disc = Folder Then AddHandler Radio.MouseRightButtonUp, AddressOf LaunchFolderRemove
panLaunchFolderList.Children.Add(Radio)
End If
Next
Catch ex As Exception
ExShow(ex, "重载文件夹列表失败", ErrorLevel.MsgboxAndFeedback)
End Try
End Sub
'重置窗口尺寸可见性
Private Sub LaunchSizeResetVisible() Handles textLaunchModeWindowHeight.TextChanged, textLaunchModeWindowWidth.TextChanged
Dim ShouldReset As Boolean = Not (textLaunchModeWindowHeight.Text = "480" And textLaunchModeWindowWidth.Text = "854")
AniStart({
AaWidth(btnLaunchModeWindowReset, If(ShouldReset, 45, 0) - btnLaunchModeWindowReset.Width, 300, , New AniEaseEnd)
}, "btnLaunchModeWindowResetReset")
End Sub
'重置窗口尺寸
Private Sub btnLaunchModeWindowReset_MouseLeftButtonUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles btnLaunchModeWindowReset.MouseLeftButtonUp
textLaunchModeWindowHeight.Text = "480"
textLaunchModeWindowWidth.Text = "854"
End Sub
'添加 MC 文件夹
Private Sub btnLaunchFolderAdd_MouseLeftButtonUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles btnLaunchFolderAdd.MouseLeftButtonUp
Try
Dim NewFolder As String = SelectFolder("选择 Minecraft 文件夹。" & vbCrLf & "(这个文件夹可以不叫 .minecraft)")
If NewFolder = "" Then Exit Sub
'检测文件夹
If CheckDirectoryPermission(NewFolder) Then
NewFolder = NewFolder & "\" '加上斜杠……
'检测通过,判断是否重复
If NewFolder = PATH & ".minecraft\" Or NewFolder = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\" Then
ShowHint(New HintConverter("选择的文件夹有误", HintState.Warn))
Exit Sub
End If
'判断是否已经添加过
Dim AllFoldersList As New ArrayList
Dim ResentFolder As String = ReadIni("setup", "LaunchFolders", "")
If Not ResentFolder = "" Then AllFoldersList.AddRange(ResentFolder.Split("|"))
If AllFoldersList.Contains(NewFolder) Then
ShowHint(New HintConverter("列表中已经存在本文件夹", HintState.Warn))
Exit Sub
End If
'判断是否含有Versions文件夹
If Not Directory.Exists(NewFolder & "versions") Then
If MyMsgbox("该文件夹中不包含任何 Minecraft 版本,是否继续添加?", "添加确认", "确定", "取消") = 2 Then Exit Sub
End If
'添加到文件夹列表
AllFoldersList.Add(NewFolder)
WriteIni("setup", "LaunchFolders", Join(AllFoldersList.ToArray, "|"))
ShowHint("右键即可从列表中移除该文件夹")
LoadMinecraftFolderList()
Else
'没有检测通过
ShowHint(New HintConverter("选择的文件夹有误", HintState.Warn))
End If
Catch ex As Exception
ExShow(ex, "添加文件夹失败", ErrorLevel.MsgboxAndFeedback)
End Try
End Sub
'移除 MC 文件夹
Private Sub LaunchFolderRemove(ByVal sender As Radiobox, ByVal e As System.Windows.Input.MouseButtonEventArgs)
If MyMsgbox("是否要将该文件夹从 Minecraft 文件夹列表移除?" & vbCrLf & " " & sender.Context, "移除确认", , "取消") = 1 Then
Dim CurrentList As New ArrayList(ReadIni("setup", "LaunchFolders", "").Split("|"))
CurrentList.Remove(sender.Context)
WriteIni("setup", "LaunchFolders", Join(CurrentList.ToArray, "|"))
If ReadIni("setup", "LaunchFolderSelect", "") = sender.Context Then
WriteIni("setup", "LaunchFolderSelect", PATH & ".minecraft\")
PoolMinecraftFolder()
End If
LoadMinecraftFolderList()
End If
End Sub
'显示最大内存
Private Sub textLaunchMaxRam_MouseEnter(ByVal sender As Object, ByVal e As MouseEventArgs) Handles textLaunchMaxRam.MouseEnter
textLaunchMaxRam.ToolTip =
"当前内存剩余:" & Int((New Devices.ComputerInfo).AvailablePhysicalMemory / 1024 / 1024) & "M / " & Int((New Devices.ComputerInfo).TotalPhysicalMemory / 1024 / 1024) & "M" & vbCrLf &
"可设置范围:256M ~ " & Math.Min(If(Environment.Is64BitOperatingSystem, Double.PositiveInfinity, 1024), Int((New Devices.ComputerInfo).TotalPhysicalMemory / 1024 / 1024) - 512) & "M"
End Sub
'手动选择
Private Sub btnLaunchJavaHand_MouseUp(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Handles btnLaunchJavaHand.MouseLeftButtonDown
Using fileDialog As New Forms.OpenFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
fileDialog.CheckFileExists = True
fileDialog.Filter = "JavaW|javaw.exe"
fileDialog.Multiselect = False
fileDialog.Title = "选择 javaw.exe"
fileDialog.ShowDialog()
'选择文件结束
If Not fileDialog.FileName = "" Then
textLaunchJava.Text = Mid(fileDialog.FileName, 1, fileDialog.FileName.LastIndexOf("\"))
End If
End Using
End Sub
'自动查找
Private Sub btnLaunchJavaAuto_MouseUp(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Handles btnLaunchJavaAuto.MouseLeftButtonDown
PoolJavaFolder(True)
textLaunchJava.Text = PATH_JAVA
End Sub
#End Region
#Region "关于"
'Logo 彩蛋
Private AboutClickCount As Double = 0
Private Sub imgAboutLogo_MouseUp(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Handles imgAboutLogo.MouseLeftButtonDown
If imgAboutLogo.Opacity < 0.5 Then Exit Sub
Dim x As Double
Dim y As Double
Do
x = RandomInteger(-5, 5)
y = RandomInteger(-5, 5)
Loop Until Math.Abs(x) + Math.Abs(y) > 3
AniStart({
AaX(imgAboutLogo, x, 40, , New AniEaseEnd),
AaY(imgAboutLogo, y, 40, , New AniEaseEnd),
AaX(imgAboutLogo, -x, 40, 40, New AniEaseStart),
AaY(imgAboutLogo, -y, 40, 40, New AniEaseStart)
}, "EasterEgg" & GetUUID())
AboutClickCount = AboutClickCount + 1
Select Case AboutClickCount
Case 5
If ReadReg("ThemeHunluan", "False") = "True" Then
ShowHint("真的真的什么也没了,就一个隐藏主题而已啦,点啊点有意思么……")
AboutClickCount = 170
Else
ShowHint("点这个很好玩么……")
End If
Case 25
If MyMsgbox("你现在是不是超无聊的?", "确认一下", "是的", "并不是") = 2 Then
ShowHint("那你还点啥……真是搞不懂。")
End If
Case 50
ShowHint("嗯,加油吧,嗯……")
Case 75
MyMsgbox("隐藏主题 混乱黄 已解锁,请到设置页面查看!", "主题已解锁", "我知道了")
SendStat("彩蛋", "主题", "混乱黄")
WriteReg("ThemeHunluan", "True")
RefreshHidden()
Case 95
ShowHint("你咋还这么无聊啊?")
Case 130
ShowHint("后面什么都没有了哦!")
Case 155
Select Case MyMsgbox("你真的不累么?", "温馨提示", "累死了", "真的不累")
Case 1
ShowHint("那你就别点了喂……后面真的真的真的什么都没有了!")
Case 2
If MyMsgbox("你真的真的不累么?", "超温馨的温馨提示", "累死了", "真的真的不累") = 2 Then
If MyMsgbox("你真的真的真的不累么?", "超超超温馨的温馨提示", "累死了", "真的真的真的不累") = 2 Then
ShowHint("好吧……不过后面是真的啥也没了,不用点了真的。")
Else
ShowHint("那你就别点了喂……后面真的真的真的什么都没有了!")
End If
Else
ShowHint("那你就别点了喂……后面真的真的真的什么都没有了!")
End If
End Select
Case 200
ShowHint("还点,还点,我不让你点了……")
imgAboutLogo.IsHitTestVisible = False
End Select
End Sub
'加群
Private Sub btnSysQQ_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAboutQQ.Click
Process.Start("http://shang.qq.com/wpa/qunwpa?idkey=f003df7898678e4bdeb53061d8f9b04445c9ff206b0515fdab9bfbd5cb3eaec0")
End Sub
'捐助
Private Sub btnAboutDonate_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnAboutDonate.Click
Try
Process.Start("https://afdian.net/@LTCat")
Catch ex As Exception
ExShow(ex, "捐助失败", ErrorLevel.DebugOnly)
End Try
End Sub
#End Region
' Private Sub SourceClick(ByVal sender As ListItem, ByVal e As System.Windows.Input.MouseButtonEventArgs)
' Dim setup As New msgSource(sender)
' If Not IsNothing(setup.panMain.Parent) Then setup.panMain.Parent.SetValue(ContentPresenter.ContentProperty, Nothing)
' If MyMsgbox("推荐源设置", setup.panMain, , "保存", "删除") = 2 Or sender.MainText = "" Or sender.SubText = "" Then
' '删除
' panHomeSourceList.Children.Remove(sender)
' End If
' Dim sources As New ArrayList
' Dim urls As New ArrayList
' Dim uses As New ArrayList
' If panHomeSourceList.Children.Count > 1 Then
' For i = 0 To panHomeSourceList.Children.Count - 1
' If panHomeSourceList.Children(i).GetType.Name = "ListItem" Then
' Dim item As ListItem = panHomeSourceList.Children(i)
' sources.Add(item.MainText)
' urls.Add(item.SubText)
' uses.Add(item.Version.LoadedByFile)
' End If
' Next
' End If
' WriteIni("setup", "LaunchMainSource", Join(sources.ToArray, "|"))
' WriteIni("setup", "LaunchMainURL", Join(urls.ToArray, "|"))
' WriteIni("setup", "LaunchMainUse", Join(uses.ToArray, "|"))
' End Sub
' Private Sub IconClick(ByVal sender As ListItem, ByVal e As System.Windows.Input.MouseButtonEventArgs)
' sender.Version.LoadedByFile = Not sender.Version.LoadedByFile
' sender.Logo = New BitmapImage(New Uri("/Images/Block-" & sender.Version.LoadedByFile & ".png", UriKind.Relative))
' Dim uses As New ArrayList
' If panHomeSourceList.Children.Count > 1 Then
' For i = 0 To panHomeSourceList.Children.Count - 2
' If panHomeSourceList.Children(i).GetType.Name = "ListItem" Then
' Dim item As ListItem = panHomeSourceList.Children(i)
' uses.Add(item.Version.LoadedByFile)
' End If
' Next
' End If
' WriteIni("setup", "LaunchMainUse", Join(uses.ToArray, "|"))
' End Sub
' Private Sub labPageMainAdd_MouseUp(ByVal sender As Object, ByVal e As EventArgs) Handles itemHomeSourceAdd.MouseLeftButtonUp
' Dim item = New ListItem With {.MainText = "", .SubText = "", .CanCheck = False, .Width = 363, .ButtonLogo = New BitmapImage(New Uri("/Images/appbar.settings.png", UriKind.Relative)), .UseLayoutRounding = True, .Name = "itemLaunchMain" & Rnd.NextDouble.ToString.Replace(".", ""), .Logo = New BitmapImage(New Uri("/Images/Block-True.png", UriKind.Relative))}
' item.Version.LoadedByFile = True
' panHomeSourceList.Children.Insert(panHomeSourceList.Children.Count - 1, item)
' AddHandler item.ButtonClick, AddressOf SourceClick
' AddHandler item.IconClick, AddressOf IconClick
' SourceClick(item, e)
' End Sub
End Class