InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.4.4

Browse Source
This commit is contained in:
龙腾猫跃
2022-12-12 02:34:19 +08:00
parent 5fb5a3b963
commit fd329037e7
39 changed files with 624 additions and 423 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Application.xaml
+23 -20
View File
@@ -23,7 +23,9 @@
<SolidColorBrush x:Key="ColorBrush6">#d5e6fd</SolidColorBrush> <SolidColorBrush x:Key="ColorBrush6">#d5e6fd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush7">#e0eafd</SolidColorBrush> <SolidColorBrush x:Key="ColorBrush7">#e0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush8">#eaf2fe</SolidColorBrush> <SolidColorBrush x:Key="ColorBrush8">#eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush9">#80e0eafd</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushBg0">#96c0f9</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBg1">#bee0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBg2">#50e0eafd</SolidColorBrush>
<Color x:Key="ColorObject1">#343d4a</Color> <Color x:Key="ColorObject1">#343d4a</Color>
<Color x:Key="ColorObject2">#0b5bcb</Color> <Color x:Key="ColorObject2">#0b5bcb</Color>
<Color x:Key="ColorObject3">#1370f3</Color> <Color x:Key="ColorObject3">#1370f3</Color>
@@ -32,7 +34,9 @@
<Color x:Key="ColorObject6">#d5e6fd</Color> <Color x:Key="ColorObject6">#d5e6fd</Color>
<Color x:Key="ColorObject7">#e0eafd</Color> <Color x:Key="ColorObject7">#e0eafd</Color>
<Color x:Key="ColorObject8">#eaf2fe</Color> <Color x:Key="ColorObject8">#eaf2fe</Color>
<Color x:Key="ColorObject9">#40eaf2fe</Color> <Color x:Key="ColorObjectBg0">#96c0f9</Color>
<Color x:Key="ColorObjectBg1">#bee0eafd</Color>
<Color x:Key="ColorObjectBg2">#50e0eafd</Color>
<SolidColorBrush x:Key="ColorBrushGray1">#404040</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushGray1">#404040</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray2">#737373</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushGray2">#737373</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray3">#8c8c8c</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushGray3">#8c8c8c</SolidColorBrush>
@@ -53,6 +57,8 @@
<SolidColorBrush x:Key="ColorBrushRedLight">#ff4c4c</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushRedLight">#ff4c4c</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushRedDark">#ce2111</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushRedDark">#ce2111</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushHalfWhite" Color="#44ffffff" /> <SolidColorBrush x:Key="ColorBrushHalfWhite" Color="#44ffffff" />
<SolidColorBrush x:Key="ColorBrushSemiWhite" Color="#bbffffff" />
<SolidColorBrush x:Key="ColorBrushWhite" Color="#ffffff" />
<SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" /> <SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
<SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush> <SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" /> <SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
@@ -258,7 +264,7 @@
<!-- TextBox --> <!-- TextBox -->
<Style TargetType="local:MyTextBox"> <Style TargetType="local:MyTextBox">
<Setter Property="BorderThickness" Value="1" /> <Setter Property="BorderThickness" Value="1" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" /> <Setter Property="Background" Value="{StaticResource ColorBrushBg2}" />
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" /> <Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" /> <Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
@@ -274,7 +280,7 @@
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/> <Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="UndoLimit" Value="15" /> <Setter Property="UndoLimit" Value="15" />
<Setter Property="MaxLength" Value="10000" /> <Setter Property="MaxLength" Value="10000" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" /> <Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="TextBox"> <ControlTemplate TargetType="TextBox">
@@ -283,14 +289,14 @@
<RowDefinition MinHeight="28" /> <RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" VerticalAlignment="Center" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{StaticResource ColorBrushGray3}" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="3"> <Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="3">
<ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0" <ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0"
Margin="5,0,0,0" Cursor="IBeam" /> Margin="5,0,0,0" Cursor="IBeam" />
<!-- 由于未知原因，TextView 会有 2,0 的 Margin --> <!-- 由于未知原因，TextView 会有 2,0 的 Margin -->
</Border> </Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" VerticalAlignment="Center" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.3" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" /> <TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid> </Grid>
</ControlTemplate> </ControlTemplate>
@@ -302,8 +308,8 @@
<Setter Property="VerticalContentAlignment" Value="Top" /> <Setter Property="VerticalContentAlignment" Value="Top" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" /> <Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" /> <Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" /> <Setter Property="Background" Value="{StaticResource ColorBrushBg2}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" /> <Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="KeyboardNavigation.TabNavigation" Value="None"/> <Setter Property="KeyboardNavigation.TabNavigation" Value="None"/>
<Setter Property="HorizontalContentAlignment" Value="Left"/> <Setter Property="HorizontalContentAlignment" Value="Left"/>
<Setter Property="FocusVisualStyle" Value="{x:Null}"/> <Setter Property="FocusVisualStyle" Value="{x:Null}"/>
@@ -317,19 +323,20 @@
<ControlTemplate.Triggers> <ControlTemplate.Triggers>
<Trigger Property="IsEnabled" Value="False"> <Trigger Property="IsEnabled" Value="False">
<Trigger.Setters> <Trigger.Setters>
<Setter Property="Foreground" Value="{StaticResource ColorBrushGray4}" /> <Setter Property="BorderBrush" Value="{StaticResource ColorBrushGray5}" />
<Setter Property="BorderBrush" Value="{StaticResource ColorBrushGray4}" /> <Setter Property="Background" Value="{StaticResource ColorBrushGray6}" />
</Trigger.Setters> </Trigger.Setters>
</Trigger> </Trigger>
<Trigger Property="IsMouseOver" Value="True"> <Trigger Property="IsMouseOver" Value="True">
<Trigger.Setters> <Trigger.Setters>
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush3}" /> <Setter Property="BorderBrush" Value="{DynamicResource ColorBrush4}" />
<Setter Property="Background" Value="{DynamicResource ColorBrush7}" />
</Trigger.Setters> </Trigger.Setters>
</Trigger> </Trigger>
<Trigger Property="IsFocused" Value="True"> <Trigger Property="IsFocused" Value="True">
<Trigger.Setters> <Trigger.Setters>
<Setter Property="Background" Value="{DynamicResource ColorBrush9}" /> <Setter Property="BorderBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush4}" /> <Setter Property="Background" Value="{DynamicResource ColorBrushSemiWhite}" />
</Trigger.Setters> </Trigger.Setters>
</Trigger> </Trigger>
</ControlTemplate.Triggers> </ControlTemplate.Triggers>
@@ -348,16 +355,12 @@
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
</DataTemplate> </DataTemplate>
<!--<DataTemplate x:Key="ComboBoxItemTemplateNormal">
<local:MyListItem Title="{Binding}" FontSize="13" PaddingRight="40" Height="26" Margin="-1,0,0,0" />
</DataTemplate>-->
<Style TargetType="local:MyComboBox"> <Style TargetType="local:MyComboBox">
<Setter Property="OverridesDefaultStyle" Value="True" /> <Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="SnapsToDevicePixels" Value="True" /> <Setter Property="SnapsToDevicePixels" Value="True" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" /> <Setter Property="Foreground" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" /> <Setter Property="Background" Value="{DynamicResource ColorBrushBg2}" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" /> <Setter Property="FocusVisualStyle" Value="{x:Null}" />
<!--<Setter Property="ItemTemplate" Value="{StaticResource ComboBoxItemTemplateNormal}"/>-->
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="160" /> <Setter Property="MaxDropDownHeight" Value="160" />
<Setter Property="Template"> <Setter Property="Template">
Plain Craft Launcher 2/Application.xaml.vb
+5 -5
View File
@@ -49,7 +49,7 @@ Public Class Application
Directory.CreateDirectory(PathTemp) Directory.CreateDirectory(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限") If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception Catch ex As Exception
MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetString(ex, False), "缓存文件夹不可用") MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetExceptionDetail(ex), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "") Setup.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\" PathTemp = IO.Path.GetTempPath() & "PCL\"
End Try End Try
@@ -104,7 +104,7 @@ Public Class Application
#End If #End If
AniControlEnabled += 1 AniControlEnabled += 1
Catch ex As Exception Catch ex As Exception
MsgBox(GetString(ex, False, True), MsgBoxStyle.Critical, "PCL2 初始化错误") MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL2 初始化错误")
FormMain.EndProgramForce(Result.Exception) FormMain.EndProgramForce(Result.Exception)
End Try End Try
End Sub End Sub
@@ -126,13 +126,13 @@ Public Class Application
Exit Sub Exit Sub
End If End If
IsCritErrored = True IsCritErrored = True
Dim ExceptionString As String = GetString(e.Exception, False, True) Dim ExceptionString As String = GetExceptionDetail(e.Exception, True)
If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
ExceptionString.Contains(".Net Framework") OrElse ' “自动错误判断” 的结果分析 ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then ExceptionString.Contains("未能加载文件或程序集") Then
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer") OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
MsgBox("你的 .Net Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误") MsgBox("你的 .NET Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel) FormMain.EndProgramForce(Result.Cancel)
Else Else
FeedbackInfo() FeedbackInfo()
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
+1 -1
View File
@@ -177,7 +177,7 @@
}, "MyButton Scale " & Uuid) }, "MyButton Scale " & Uuid)
End Sub End Sub
Private Sub Button_MouseEnter() Handles Me.MouseEnter Private Sub Button_MouseEnter() Handles Me.MouseEnter
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush9"), AnimationColorIn), "MyButton Background " & Uuid) AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrushBg1"), AnimationColorIn), "MyButton Background " & Uuid)
End Sub End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub If Not IsMouseDown Then Exit Sub
Plain Craft Launcher 2/Controls/MyCard.vb
+3 -1
View File
@@ -130,7 +130,9 @@
Case 6 Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True)) Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7 Case 7
Stack.Children.Add(McDownloadListItem(Data, AddressOf FrmDownloadInstall.MinecraftSelected, False)) Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) '不能使用 AddressOf，这导致了 #535，原因完全不明，疑似是编译器 Bug
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
Case 8 Case 8
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click)) Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click))
Case 9 Case 9
Plain Craft Launcher 2/Controls/MyCheckBox.xaml
+1 -1
View File
@@ -5,7 +5,7 @@
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8"> MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8">
<TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" /> <TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" /> <Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushBg2}" />
<Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z"> <Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z">
<Path.RenderTransform> <Path.RenderTransform>
<ScaleTransform CenterX="6" CenterY="6" ScaleX="0" ScaleY="0" /> <ScaleTransform CenterX="6" CenterY="6" ScaleX="0" ScaleY="0" />
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
+3 -3
View File
@@ -124,13 +124,13 @@
Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text) Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text)
MouseDowned = False MouseDowned = False
SetChecked(Not Checked, True, True) SetChecked(Not Checked, True, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg2", 100), "MyCheckBox Background " & Uuid)
End Sub End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
If Not AllowMouseDown Then Exit Sub If Not AllowMouseDown Then Exit Sub
MouseDowned = True MouseDowned = True
Focus() Focus()
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrush9", 100), "MyCheckBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
If Checked Then If Checked Then
AniStart({ AniStart({
AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),
@@ -143,7 +143,7 @@
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub If Not MouseDowned Then Exit Sub
MouseDowned = False MouseDowned = False
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg2", 100), "MyCheckBox Background " & Uuid)
If Checked Then If Checked Then
AniStart({ AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),
Plain Craft Launcher 2/Controls/MyComboBox.vb
+18 -22
View File
@@ -62,44 +62,40 @@
'指向动画 '指向动画
Public Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp, Me.GotKeyboardFocus Public Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp, Me.GotKeyboardFocus
'判断当前颜色 '判断当前颜色
Dim ColorName As String Dim ForeColorName As String
Dim BackName As String Dim BackColorName As String
Dim Time As Integer Dim Time As Integer
If IsEnabled Then If IsEnabled Then
If IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused Then If IsMouseDown OrElse IsDropDownOpen OrElse (IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused) Then
ColorName = "ColorBrush4" ForeColorName = "ColorBrush3"
BackName = "ColorBrush9" BackColorName = "ColorBrushSemiWhite"
Time = 60 Time = 10
ElseIf IsMouseDown OrElse IsDropDownOpen Then
ColorName = "ColorBrush3"
BackName = "ColorBrush9"
Time = 60
ElseIf IsMouseOver Then ElseIf IsMouseOver Then
ColorName = "ColorBrush3" ForeColorName = "ColorBrush4"
BackName = "ColorBrushHalfWhite" BackColorName = "ColorBrush7"
Time = 100 Time = 50
Else Else
ColorName = "ColorBrush1" ForeColorName = "ColorBrushBg0"
BackName = "ColorBrushHalfWhite" BackColorName = "ColorBrushBg2"
Time = 200 Time = 50
End If End If
Else Else
ColorName = "ColorBrushGray4" ForeColorName = "ColorBrushGray5"
BackName = "ColorBrushHalfWhite" BackColorName = "ColorBrushGray6"
Time = 200 Time = 200
End If End If
'触发颜色动画 '触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画 '有动画
AniStart({ AniStart({
AaColor(Me, ForegroundProperty, ColorName, Time), AaColor(Me, ForegroundProperty, ForeColorName, Time),
AaColor(Me, BackgroundProperty, BackName, Time) AaColor(Me, BackgroundProperty, BackColorName, Time)
}, "MyComboBox Color " & Uuid) }, "MyComboBox Color " & Uuid)
Else Else
'无动画 '无动画
AniStop("MyComboBox Color " & Uuid) AniStop("MyComboBox Color " & Uuid)
SetResourceReference(ForegroundProperty, ColorName) SetResourceReference(ForegroundProperty, ForeColorName)
SetResourceReference(BackgroundProperty, BackName) SetResourceReference(BackgroundProperty, BackColorName)
End If End If
End Sub End Sub
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+21 -22
View File
@@ -507,27 +507,26 @@
'触发点击事件 '触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then If Not IsMouseDown Then Exit Sub
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub If e.Handled Then Exit Sub
'触发自定义事件 '触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData) ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True e.Handled = True
End If
If e.Handled Then Exit Sub
'实际的单击处理
Select Case Type
Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title)
Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title)
If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
SetChecked(Not Checked, True, True)
End Select
End If End If
If e.Handled Then Exit Sub
'实际的单击处理
Select Case Type
Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title)
Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title)
If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
SetChecked(Not Checked, True, True)
End Select
'AniStart({ 'AniStart({
' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent), ' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent),
' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent) ' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent)
@@ -603,7 +602,7 @@
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3)) If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.AddRange({ Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time), AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
}) })
If IsScaleAnimationEnabled Then If IsScaleAnimationEnabled Then
@@ -630,7 +629,7 @@
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1 If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1
'由于鼠标已经移入，所以直接实例化 RectBack '由于鼠标已经移入，所以直接实例化 RectBack
RectBack.Background = Color9 RectBack.Background = ColorBg1
RectBack.Opacity = 1 RectBack.Opacity = 1
RectBack.RenderTransform = New ScaleTransform(1, 1) RectBack.RenderTransform = New ScaleTransform(1, 1)
Me.RenderTransform = New ScaleTransform(1, 1) Me.RenderTransform = New ScaleTransform(1, 1)
Plain Craft Launcher 2/Controls/MyRadioBox.xaml
+3 -3
View File
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True"> MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/> <TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" /> <Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushBg2}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" /> <Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid> </Grid>
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
+3 -3
View File
@@ -170,12 +170,12 @@
MouseDowned = False MouseDowned = False
Log("[Control] 按下单选框：" & Text) Log("[Control] 按下单选框：" & Text)
SetChecked(True, True, True) SetChecked(True, True, True)
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg2", 100), "MyRadioBox Background " & Uuid)
End Sub End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
MouseDowned = True MouseDowned = True
Focus() Focus()
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrush9", 100), "MyRadioBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg1", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then If Not Checked Then
AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid) AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If End If
@@ -183,7 +183,7 @@
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub If Not MouseDowned Then Exit Sub
MouseDowned = False MouseDowned = False
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg2", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then If Not Checked Then
AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid) AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If End If
Plain Craft Launcher 2/Controls/MySlider.xaml
+6 -4
View File
@@ -6,11 +6,13 @@
mc:Ignorable="d" mc:Ignorable="d"
d:DesignHeight="16" d:DesignWidth="162" d:DesignHeight="16" d:DesignWidth="162"
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush1}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True"> MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush4}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<Grid x:Name="PanMain" MinHeight="16" MaxHeight="16" IsHitTestVisible="False"> <Grid x:Name="PanMain" MinHeight="16" MaxHeight="16" IsHitTestVisible="False">
<Line Height="4" Name="LineBack" Stroke="{StaticResource ColorBrushGray5}" StrokeThickness="1.1" X2="10000" Y1="2" Y2="2" HorizontalAlignment="Right" Width="0" SnapsToDevicePixels="True" Margin="0,0,1,0" /> <Line Height="4" Name="LineBack" Stroke="{DynamicResource ColorBrushBg0}" Opacity="0.3" StrokeThickness="1.6" X2="10000" Y1="2" Y2="2" HorizontalAlignment="Right" Width="0" SnapsToDevicePixels="True" Margin="0,0,1,0" />
<Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1.1" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" /> <Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1.6" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" />
<Ellipse HorizontalAlignment="Left" Width="16" Stroke="{Binding BorderBrush, ElementName=PanBack}" StrokeThickness="1.1" Fill="{StaticResource ColorBrushHalfWhite}" Name="ShapeDot" Height="16" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5"> <Ellipse HorizontalAlignment="Left" Width="10" Height="10"
Stroke="{Binding BorderBrush, ElementName=PanBack}" StrokeThickness="1.2"
Fill="{DynamicResource ColorBrush4}" Name="ShapeDot" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5">
<Ellipse.RenderTransform> <Ellipse.RenderTransform>
<ScaleTransform /> <ScaleTransform />
</Ellipse.RenderTransform> </Ellipse.RenderTransform>
Plain Craft Launcher 2/Controls/MySlider.xaml.vb
+29 -17
View File
@@ -45,13 +45,13 @@
End If End If
If IsLoaded AndAlso AniControlEnabled = 0 Then If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualWidth < 16 Then Exit Property If ActualWidth < ShapeDot.Width Then Exit Property
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16) Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - 16) - _Value / MaxValue) Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0) Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
AniStart({ AniStart({
AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaWidth(LineBack, Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), AaWidth(LineBack, Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)) AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
}, "MySlider Progress " & Uuid) }, "MySlider Progress " & Uuid)
Else Else
@@ -67,9 +67,9 @@
Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width
AniStop("MySlider Progress " & Uuid) AniStop("MySlider Progress " & Uuid)
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16) Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
LineBack.Width = Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5)) LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
SetLeft(ShapeDot, NewWidth) SetLeft(ShapeDot, NewWidth)
End Sub End Sub
@@ -79,9 +79,10 @@
Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
e.Handled = True '防止 ScrollViewer 失焦问题 e.Handled = True '防止 ScrollViewer 失焦问题
DragControl = Me DragControl = Me
RefreshColor()
FrmMain.DragDoing() FrmMain.DragDoing()
AniStart({ AniStart({
AaScaleTransform(ShapeDot, 0.8 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 75,, New AniEaseOutFluent) AaScaleTransform(ShapeDot, 1.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 40,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid) }, "MySlider Scale " & Uuid)
'更新 Popup '更新 Popup
If GetHintText IsNot Nothing Then If GetHintText IsNot Nothing Then
@@ -91,7 +92,7 @@
End If End If
End Sub End Sub
Public Sub DragDoing() Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - 8) / (ActualWidth - 16), 0, 1) Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim NewValue As Integer = Percent * MaxValue Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then If Not NewValue = Value Then
Value = NewValue Value = NewValue
@@ -113,28 +114,39 @@
Try Try
'判断当前颜色 '判断当前颜色
Dim ColorName As String Dim ForegroundName As String, DotFillName As String
Dim AnimationTime As Integer Dim AnimationTime As Integer
If IsEnabled Then If IsEnabled Then
If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then If Not IsNothing(DragControl) AndAlso DragControl.Equals(Me) Then
ColorName = "ColorBrush3" ForegroundName = "ColorBrush3"
AnimationTime = 100 DotFillName = "ColorBrush3"
AnimationTime = 40
ElseIf IsMouseOver Then
ForegroundName = "ColorBrush3"
DotFillName = "ColorBrush3"
AnimationTime = 40
Else Else
ColorName = "ColorBrush1" ForegroundName = "ColorBrush4"
AnimationTime = 200 DotFillName = "ColorBrush4"
AnimationTime = 100
End If End If
Else Else
ColorName = "ColorBrushGray4" ForegroundName = "ColorBrushGray5"
DotFillName = "ColorBrushGray5"
AnimationTime = 200 AnimationTime = 200
End If End If
'触发颜色动画 '触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画 '有动画
AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid) AniStart({
AaColor(Me, BorderBrushProperty, ForegroundName, AnimationTime),
AaColor(ShapeDot, Ellipse.FillProperty, DotFillName, AnimationTime)
}, "MySlider Color " & Uuid)
Else Else
'无动画 '无动画
AniStop("MySlider Color " & Uuid) AniStop("MySlider Color " & Uuid)
SetResourceReference(BorderBrushProperty, ColorName) SetResourceReference(BorderBrushProperty, ForegroundName)
ShapeDot.SetResourceReference(Ellipse.FillProperty, DotFillName)
End If End If
Catch ex As Exception Catch ex As Exception
Plain Craft Launcher 2/Controls/MyTextBox.vb
+12 -21
View File
@@ -212,35 +212,26 @@
If IsEnabled Then If IsEnabled Then
If ValidateResult = "" OrElse Not IsTextChanged Then If ValidateResult = "" OrElse Not IsTextChanged Then
If IsFocused Then If IsFocused Then
ForeColorName = "ColorBrush4"
BackColorName = "ColorBrush9"
AnimationTime = 60
ElseIf IsMouseOver Then
ForeColorName = "ColorBrush3" ForeColorName = "ColorBrush3"
BackColorName = "ColorBrushHalfWhite" BackColorName = "ColorBrushSemiWhite"
AnimationTime = 100 AnimationTime = 10
Else ElseIf IsMouseOver Then
ForeColorName = "ColorBrush1" ForeColorName = "ColorBrush4"
BackColorName = "ColorBrushHalfWhite" BackColorName = "ColorBrush7"
AnimationTime = 200 AnimationTime = 50
Else '未选中
ForeColorName = "ColorBrushBg0"
BackColorName = "ColorBrushBg2"
AnimationTime = 50
End If End If
Else Else
ForeColorName = "ColorBrushRedLight" ForeColorName = "ColorBrushRedLight"
BackColorName = "ColorBrushRedBack" BackColorName = "ColorBrushRedBack"
AnimationTime = 200 AnimationTime = 200
'If IsFocused OrElse IsMouseOver Then
' ForeColorName = "ColorBrushRedLight"
' BackColorName = "ColorBrushRedBack"
' AnimationTime = 100
'Else
' ForeColorName = "ColorBrushRedDark"
' BackColorName = "ColorBrushHalfWhite"
' AnimationTime = 200
'End If
End If End If
Else Else
ForeColorName = "ColorBrushGray4" ForeColorName = "ColorBrushGray5"
BackColorName = "ColorBrushHalfWhite" BackColorName = "ColorBrushGray6"
AnimationTime = 200 AnimationTime = 200
End If End If
'触发颜色动画 '触发颜色动画
Plain Craft Launcher 2/FormMain.xaml
+1 -1
View File
@@ -160,7 +160,7 @@
</Border> </Border>
</Border> </Border>
</Grid> </Grid>
<StackPanel x:Name="PanHint" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" IsHitTestVisible="False" Grid.RowSpan="2" /> <StackPanel x:Name="PanHint" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15"> <StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed" <local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" /> Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />
Plain Craft Launcher 2/FormMain.xaml.vb
+15 -4
View File
@@ -10,11 +10,14 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 270 Then 'Release 2.4.3 If LastVersion < 272 Then 'Release 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色，让整体边框变得更淡"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug")) If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6 FeatureCount += 13
BugCount += 15 BugCount += 23
End If End If
If LastVersion < 268 Then 'Release 2.4.2 If LastVersion < 268 Then 'Release 2.4.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能")) FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
@@ -106,6 +109,14 @@ Public Class FormMain
'3：BUG+ IMP* FEAT- '3：BUG+ IMP* FEAT-
'2：BUG* IMP- '2：BUG* IMP-
'1：BUG- '1：BUG-
If LastVersion < 273 Then 'Snapshot 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色，让整体边框变得更淡"))
If LastVersion = 271 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法同时开启多个 Minecraft 客户端的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
FeatureCount += 7
BugCount += 8
End If
If LastVersion < 271 Then 'Snapshot 2.4.3 If LastVersion < 271 Then 'Snapshot 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug")) If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
@@ -1062,7 +1073,7 @@ Install:
''' <summary> ''' <summary>
''' 上层页面的编号堆栈，用于返回。 ''' 上层页面的编号堆栈，用于返回。
''' </summary> ''' </summary>
Private ReadOnly PageStack As New List(Of PageStackData) Public PageStack As New List(Of PageStackData)
Public Class PageStackData Public Class PageStackData
Public Page As PageType Public Page As PageType
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+97 -57
View File
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.3" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.4.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.3." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.4.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 270 'Release Public Const VersionCode As Integer = 272 'Release
#Else #Else
Public Const VersionCode As Integer = 271 'Snapshot Public Const VersionCode As Integer = 273 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -789,7 +789,7 @@ Public Module ModBase
''' 读取文件，如果失败则返回空字符串。 ''' 读取文件，如果失败则返回空字符串。
''' </summary> ''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String) As String Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Try Try
'还原文件路径 '还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -799,7 +799,7 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1) ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length) ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using End Using
ReadFile = DecodeBytes(FileBytes) ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
Else Else
Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath) Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath)
Return "" Return ""
@@ -1223,7 +1223,7 @@ Re:
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Log(ex, "检查文件出错") Log(ex, "检查文件出错")
Return GetString(ex) Return GetExceptionSummary(ex)
End Try End Try
End Function End Function
End Class End Class
@@ -1325,59 +1325,99 @@ Re:
Public vbRQ As Char = Convert.ToChar(8221) Public vbRQ As Char = Convert.ToChar(8221)
''' <summary> ''' <summary>
''' 提取 Exception 摘要。 ''' 提取 Exception 的具体描述与堆栈。
''' </summary> ''' </summary>
''' <param name="IsLine">输出是否强制为单行，单行模型下不会输出调用堆栈。</param> ''' <param name="ShowAllTrace">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
Public Function GetString(Ex As Exception, Optional IsLine As Boolean = True, Optional ShowAllTrace As Boolean = False) As String Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllTrace As Boolean = False) As String
If Ex Is Nothing Then Return "无可用错误信息！" If Ex Is Nothing Then Return "无可用错误信息！"
Dim Desc As New List(Of String)
'自动错误判断 '获取最底层的异常
Dim RealEx = Ex Dim InnerEx As Exception = Ex
Do Until RealEx.InnerException Is Nothing Do Until InnerEx.InnerException Is Nothing
RealEx = RealEx.InnerException InnerEx = InnerEx.InnerException
Loop Loop
If TypeOf RealEx Is TypeLoadException OrElse TypeOf RealEx Is MissingMethodException OrElse TypeOf RealEx Is NotImplementedException OrElse TypeOf RealEx Is TypeInitializationException Then
Desc.Add("系统环境存在问题，请尝试重装 .Net Framework 4.6.2 后再试") '获取各级错误的描述与堆栈信息
ElseIf TypeOf RealEx Is UnauthorizedAccessException Then Dim DescList As New List(Of String)
Desc.Add("PCL2 权限不足，请尝试右键 PCL2，选择以管理员身份运行") Dim StackList As New List(Of String)
ElseIf TypeOf RealEx Is OutOfMemoryException Then Do Until Ex Is Nothing
Desc.Add("电脑运行内存不足，PCL2 无法继续运行") DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
If Ex.StackTrace IsNot Nothing Then
For Each St As String In Ex.StackTrace.Split(vbCrLf)
If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then StackList.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
Next
End If
Ex = Ex.InnerException
Loop
DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
'常见错误
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2，选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足，导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳，导致难以连接到服务器。请重试，或尝试使用 VPN。"
End If End If
If IsLine Then '获取错误类型
'无内部错误的快速处理 Dim TypeDesc As String = If(InnerEx.GetType.FullName = "System.Exception", "", vbCrLf & "错误类型：" & InnerEx.GetType.FullName)
If Ex.InnerException Is Nothing Then
If Desc.Count = 0 Then '构造输出信息
Return Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " ") If CommonReason Is Nothing Then
Else Return Desc & Stack & TypeDesc
Return Desc.First
End If
End If
'构造输出信息
Do Until Ex Is Nothing
Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
Ex = Ex.InnerException
Loop
Desc.Reverse() '让最深层错误在最左边
GetString = Join(Desc, " → ")
Else Else
Dim Stack As New List(Of String) Return DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf &
'逐级追加描述与堆栈 "详细错误信息：" & vbCrLf & "→ " & Join(DescList.GetRange(1, DescList.Count - 1), vbCrLf & "→ ") & Stack & TypeDesc
Do Until Ex Is Nothing
Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
If Ex.StackTrace IsNot Nothing Then
For Each St As String In Ex.StackTrace.Split(vbCrLf)
If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then Stack.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
Next
End If
Ex = Ex.InnerException
Loop
'构造输出信息
Dim TypeName As String = RealEx.GetType.FullName
GetString = Join(Desc, vbCrLf & "Caused By: ") & If(Stack.Count > 0, vbCrLf & Join(Stack, vbCrLf), "") & If(TypeName = "System.Exception", "", vbCrLf & "错误类型：" & TypeName)
End If End If
End Function End Function
''' <summary>
''' 提取 Exception 描述，汇总到一行。
''' </summary>
Public Function GetExceptionSummary(Ex As Exception) As String
If Ex Is Nothing Then Return "无可用错误信息！"
'获取最底层的异常
Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Loop
'获取各级错误的描述
Dim DescList As New List(Of String)
Do Until Ex Is Nothing
DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
Ex = Ex.InnerException
Loop
DescList = DescList.Distinct.ToList
'常见错误
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2，选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足，导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳，导致难以连接到服务器。请重试，或尝试使用 VPN。"
End If
'构造输出信息
If CommonReason IsNot Nothing Then
Return DescList.First & "：" & CommonReason
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
End If
End Function
''' <summary> ''' <summary>
''' 返回一个枚举对应的字符串。 ''' 返回一个枚举对应的字符串。
''' </summary> ''' </summary>
@@ -2432,10 +2472,10 @@ Retry:
IsErrorTriggered = True IsErrorTriggered = True
'获取错误信息 '获取错误信息
Dim ExFull As String = Desc & "：" & GetString(Ex, False) Dim ExFull As String = Desc & "：" & GetExceptionDetail(Ex)
'输出日志 '输出日志
Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetString(Ex, False, True) & vbCrLf '减轻同步锁占用 Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetExceptionDetail(Ex, True) & vbCrLf '减轻同步锁占用
If ModeDebug Then If ModeDebug Then
SyncLock LogListLock SyncLock LogListLock
LogList.Append(AppendText) LogList.Append(AppendText)
@@ -2453,19 +2493,19 @@ Retry:
Case LogLevel.Normal Case LogLevel.Normal
#If DEBUG Then #If DEBUG Then
Case LogLevel.Developer Case LogLevel.Developer
Dim ExLine As String = Desc & "：" & GetString(Ex, True) Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint("[开发者模式] " & ExLine, HintType.Info, False) Hint("[开发者模式] " & ExLine, HintType.Info, False)
Case LogLevel.Debug Case LogLevel.Debug
Dim ExLine As String = Desc & "：" & GetString(Ex, True) Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint("[调试模式] " & ExLine, HintType.Info, False) Hint("[调试模式] " & ExLine, HintType.Info, False)
#Else #Else
Case LogLevel.Developer Case LogLevel.Developer
Case LogLevel.Debug Case LogLevel.Debug
Dim ExLine As String = Desc & "：" & GetString(Ex, True) Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False) If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
#End If #End If
Case LogLevel.Hint Case LogLevel.Hint
Dim ExLine As String = Desc & "：" & GetString(Ex, True) Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint(ExLine, HintType.Critical, False) Hint(ExLine, HintType.Critical, False)
Case LogLevel.Msgbox Case LogLevel.Msgbox
MyMsgBox(ExFull, Title) MyMsgBox(ExFull, Title)
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+10 -6
View File
@@ -412,7 +412,7 @@ RequestFinished:
Throw Throw
Catch ex As WebException Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then If ex.Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex) Throw New WebException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex)
Else Else
'获取请求失败的返回 '获取请求失败的返回
Dim Res As String = "" Dim Res As String = ""
@@ -1183,10 +1183,10 @@ SourceBreak:
Next Next
End SyncLock End SyncLock
End SyncLock End SyncLock
Dim IsTimeoutString As String = GetString(ex, False).ToLower.Replace(" ", "") Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout") IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout")
Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#：超时（" & (Timeout * 0.001) & "s）", "#：出错，" & GetString(ex, False))) Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#：超时（" & (Timeout * 0.001) & "s）", "#：出错，" & GetExceptionDetail(ex)))
Info.State = NetState.Error Info.State = NetState.Error
''使用该下载源的线程是否没有速度 ''使用该下载源的线程是否没有速度
''下载超时也会导致没有速度，容易误判下载失败，所以已弃用此方法 ''下载超时也会导致没有速度，容易误判下载失败，所以已弃用此方法
@@ -1697,12 +1697,16 @@ Retry:
SyncLock LockState SyncLock LockState
If State > LoadState.Loading Then Exit Sub If State > LoadState.Loading Then Exit Sub
If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误！")} If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
[Error] = ExList(0) '寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
'获取实际失败的文件 '获取实际失败的文件
SyncLock FilesLock SyncLock FilesLock
For Each File In Files For Each File In Files
If File.State = NetState.Error Then If File.State = NetState.Error Then
[Error] = New Exception("文件下载失败：" & File.LocalPath & "（第一下载源：" & File.Sources(0).Url & "）", ExList(0)) [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join(
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")).ToList(),
vbCrLf), [Error])
Exit For Exit For
End If End If
Next Next
@@ -1719,7 +1723,7 @@ Retry:
'在退出同步锁后再进行日志输出 '在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String) Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList For Each Ex As Exception In ExList
ErrOutput.Add(GetString(Ex, False)) ErrOutput.Add(GetExceptionDetail(Ex))
Next Next
Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf)) Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf))
End Sub End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+3 -3
View File
@@ -88,7 +88,7 @@
If FilePath.Contains("crash-") Then If FilePath.Contains("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
Else Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, File.ReadAllLines(FilePath, Encoding.UTF8))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath, Encoding.UTF8).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）") Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
@@ -135,7 +135,7 @@
If TargetFile.Name.StartsWith("crash-") Then If TargetFile.Name.StartsWith("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
Else Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, File.ReadAllLines(TargetFile.FullName, Encoding.UTF8))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
@@ -771,7 +771,7 @@ Redo:
Case CrashReason.内存不足 Case CrashReason.内存不足
ResultString = "Minecraft 内存不足，导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足，或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存，删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效，请在开始游戏前尽量关闭其他软件，或者……换台电脑？\h" ResultString = "Minecraft 内存不足，导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足，或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存，删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效，请在开始游戏前尽量关闭其他软件，或者……换台电脑？\h"
Case CrashReason.使用OpenJ9 Case CrashReason.使用OpenJ9
ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java 8，然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。" ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java，然后再启动游戏。"
Case CrashReason.使用JDK Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK，或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。" ResultString = "游戏似乎因为使用 JDK，或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高 Case CrashReason.Java版本过高
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+8 -2
View File
@@ -610,7 +610,7 @@
Try Try
Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html") Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
Catch ex As Exception Catch ex As Exception
If GetString(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本") Throw New Exception("没有可用版本")
Else Else
Throw Throw
@@ -1254,6 +1254,12 @@
''' CurseForge 工程列表获取事件。 ''' CurseForge 工程列表获取事件。
''' </summary> ''' </summary>
Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)) Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult))
'拒绝 1.13- Quilt（这个版本根本没有 Quilt）
If Not Task.Input.IsModPack AndAlso
If(Task.Input.ModLoader, 0) = 5 AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
End If
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim
Task.Input.SearchFilter = RawFilter Task.Input.SearchFilter = RawFilter
RawFilter = RawFilter.ToLower RawFilter = RawFilter.ToLower
@@ -1487,7 +1493,7 @@
Dim Versions As New List(Of String) Dim Versions As New List(Of String)
For Each Version In Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower) For Each Version In Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower)
If Version.StartsWith("1.") OrElse Version.Contains("w") Then If Version.StartsWith("1.") OrElse Version.Contains("w") Then
Versions.Add(Version) Versions.Add(Version.Replace("-snapshot", " 快照"))
ElseIf Version = "forge" OrElse Version = "fabric" OrElse Version = "quilt" OrElse Version = "rift" Then ElseIf Version = "forge" OrElse Version = "fabric" OrElse Version = "quilt" OrElse Version = "rift" Then
ModLoaders.Add(Version.First.ToString.ToUpper & Version.Substring(1)) ModLoaders.Add(Version.First.ToString.ToUpper & Version.Substring(1))
End If End If
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+117 -41
View File
@@ -4,22 +4,73 @@ Public Module ModLaunch
#Region "开始" #Region "开始"
Public Class McLaunchOptions
''' <summary>
''' 强制指定在启动后进入的服务器 IP。
''' 默认值：Nothing。使用版本设置的值。
''' </summary>
Public ServerIp As String = Nothing
''' <summary>
''' 将启动脚本保存到该地址，然后取消启动。这同时会改变启动时的提示等。
''' 默认值：Nothing。不保存。
''' </summary>
Public SaveBatch As String = Nothing
''' <summary>
''' 强行指定启动的 MC 版本。
''' 默认值：Nothing。使用 McVersionCurrent。
''' </summary>
Public Version As McVersion = Nothing
End Class
''' <summary>
''' 尝试启动 Minecraft。必须在 UI 线程调用。
''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。
''' </summary>
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
Options = If(Options, New McLaunchOptions)
'预检查
If Not RunInUi() Then
Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
End If
If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中！", HintType.Critical)
Return False
End If
'强制切换需要启动的版本
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
'检查版本
Options.Version.Load()
If Options.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & Options.Version.Info, HintType.Critical)
Return False
End If
'切换版本
McVersionCurrent = Options.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.RefreshButtonsUI()
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面（否则就可以在启动中切换 McVersionCurrent 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
'实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True
End Function
''' <summary> ''' <summary>
''' 记录启动日志。 ''' 记录启动日志。
''' </summary> ''' </summary>
Public Sub McLaunchLog(Text As String) Public Sub McLaunchLog(Text As String)
RunInUi(Sub() RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text
End Sub)
Log("[Launch] " & Text) Log("[Launch] " & Text)
End Sub End Sub
'启动状态切换 '启动状态切换
Public McLaunchLoader As New LoaderTask(Of String, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState} Public McLaunchLoader As New LoaderTask(Of McLaunchOptions, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
Public McLaunchLoaderReal As LoaderCombo(Of Object) Public McLaunchLoaderReal As LoaderCombo(Of Object)
Public McLaunchProcess As Process Public McLaunchProcess As Process
Public McLaunchWatcher As Watcher Public McLaunchWatcher As Watcher
Private Sub McLaunchState(Loader As LoaderTask(Of String, Object)) Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
Select Case McLaunchLoader.State Select Case McLaunchLoader.State
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Aborted Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Aborted
FrmLaunchLeft.PageChangeToLogin() FrmLaunchLeft.PageChangeToLogin()
@@ -28,7 +79,13 @@ Public Module ModLaunch
FrmLaunchRight.LabLog.Text = "" FrmLaunchRight.LabLog.Text = ""
End Select End Select
End Sub End Sub
Private Sub McLaunchStart(Loader As LoaderTask(Of String, Object)) ''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary>
Private AbortHint As String = Nothing
'实际的启动方法
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
'开始动画 '开始动画
RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching) RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching)
'预检测（预检测的错误将直接抛出） '预检测（预检测的错误将直接抛出）
@@ -48,7 +105,6 @@ Public Module ModLaunch
}) With {.ProgressWeight = 2, .Show = False, .Block = False}, }) With {.ProgressWeight = 2, .Show = False, .Block = False},
McLoginLoader, McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True}, New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
New LoaderTask(Of Integer, String)("提供参数中的服务器 IP", Sub(InnerLoader As LoaderTask(Of Integer, String)) InnerLoader.Output = Loader.Input) With {.ProgressWeight = 0.01, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2}, New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -59,6 +115,7 @@ Public Module ModLaunch
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器 If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
'等待加载器执行并更新 UI '等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader McLaunchLoaderReal = LaunchLoader
AbortHint = Nothing
LaunchLoader.Start() LaunchLoader.Start()
'任务栏进度条 '任务栏进度条
LoaderTaskbarAdd(LaunchLoader) LoaderTaskbarAdd(LaunchLoader)
@@ -72,7 +129,11 @@ Public Module ModLaunch
Case LoadState.Finished Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish) Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
Case LoadState.Aborted Case LoadState.Aborted
Hint("已取消启动！", HintType.Info) If AbortHint Is Nothing Then
Hint("已取消启动！", HintType.Info)
Else
Hint(AbortHint, HintType.Finish)
End If
Case LoadState.Failed Case LoadState.Failed
Throw LaunchLoader.Error Throw LaunchLoader.Error
Case Else Case Else
@@ -92,7 +153,7 @@ NextInner:
GoTo NextInner GoTo NextInner
Else Else
'没有特殊处理过的错误信息 '没有特殊处理过的错误信息
McLaunchLog("错误：" & GetString(ex, False)) McLaunchLog("错误：" & GetExceptionDetail(ex))
Log(ex, "Minecraft 启动失败", LogLevel.Msgbox, "启动失败") Log(ex, "Minecraft 启动失败", LogLevel.Msgbox, "启动失败")
Throw Throw
End If End If
@@ -492,7 +553,7 @@ SkipLogin:
McLoginRequestValidate(Data) McLoginRequestValidate(Data)
GoTo LoginFinish GoTo LoginFinish
Catch ex As Exception Catch ex As Exception
Dim AllMessage = GetString(ex) Dim AllMessage = GetExceptionSummary(ex)
McLaunchLog("验证登录失败：" & AllMessage) McLaunchLog("验证登录失败：" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败") McLaunchLog("已触发超时登录失败")
@@ -507,7 +568,7 @@ Refresh:
McLoginRequestRefresh(Data, NeedRefresh) McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish GoTo LoginFinish
Catch ex As Exception Catch ex As Exception
McLaunchLog("刷新登录失败：" & GetString(ex)) McLaunchLog("刷新登录失败：" & GetExceptionSummary(ex))
End Try End Try
Data.Progress = If(NeedRefresh, 0.85, 0.45) Data.Progress = If(NeedRefresh, 0.85, 0.45)
End If End If
@@ -516,7 +577,7 @@ Refresh:
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
NeedRefresh = McLoginRequestLogin(Data) NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception Catch ex As Exception
McLaunchLog("登录失败：" & GetString(ex)) McLaunchLog("登录失败：" & GetExceptionSummary(ex))
Throw Throw
End Try End Try
If NeedRefresh Then If NeedRefresh Then
@@ -599,7 +660,7 @@ LoginFinish:
Names.Insert(0, Input.UserName) Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨")) Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
Catch ex As Exception Catch ex As Exception
Dim AllMessage As String = GetString(ex) Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal) Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Dim ThrowEx As Exception = ex Dim ThrowEx As Exception = ex
If AllMessage.Contains("403") Then If AllMessage.Contains("403") Then
@@ -607,7 +668,7 @@ LoginFinish:
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
ThrowEx = New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好，或选择其他登录方式！") ThrowEx = New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好，或选择其他登录方式！")
End If End If
McLaunchLog("登录失败：" & GetString(ThrowEx)) McLaunchLog("登录失败：" & GetExceptionSummary(ThrowEx))
Throw ThrowEx Throw ThrowEx
End Try End Try
End Sub End Sub
@@ -737,7 +798,7 @@ LoginFinish:
McLaunchLog("登录成功（Login, " & Data.Input.Token & "）") McLaunchLog("登录成功（Login, " & Data.Input.Token & "）")
Return NeedRefresh Return NeedRefresh
Catch ex As Exception Catch ex As Exception
Dim AllMessage As String = GetString(ex) Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal) Log(ex, "登录失败原始错误信息", LogLevel.Normal)
If AllMessage.Contains("410") AndAlso AllMessage.Contains("Migrated") Then If AllMessage.Contains("410") AndAlso AllMessage.Contains("Migrated") Then
Throw New Exception("$登录失败：该 Mojang 账号已迁移至微软账号，请在上方的登录方式中选择 微软 并再次尝试登录！") Throw New Exception("$登录失败：该 Mojang 账号已迁移至微软账号，请在上方的登录方式中选择 微软 并再次尝试登录！")
@@ -944,7 +1005,7 @@ SystemBrowser:
Try Try
Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2) Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Catch ex As Net.WebException Catch ex As Net.WebException
Dim Message As String = GetString(ex) Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then If Message.Contains("(429)") Then
Log(ex, "微软登录第 5 步汇报 429") Log(ex, "微软登录第 5 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！") Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -968,13 +1029,22 @@ SystemBrowser:
Try Try
Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException Catch ex As Net.WebException
Dim Message As String = GetString(ex) Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then If Message.Contains("(429)") Then
Log(ex, "微软登录第 6 步汇报 429") Log(ex, "微软登录第 6 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！") Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
ElseIf Message.Contains("(404)") Then ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 6 步汇报 404") Log(ex, "微软登录第 6 步汇报 404")
Throw New Exception("$你可能没有在购买后去 Minecraft 官网创建游戏档案，或者没有购买 Minecraft。") RunInNewThread(Sub()
Select Case MyMsgBox("你可能没有在 Minecraft 官网创建档案，或者没有购买 Minecraft。" & vbCrLf &
"如果你已经购买了游戏，请在官网上创建档案后再试。", "登录失败", "创建档案", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
OpenWebsite("https://www.minecraft.net/zh-hans/store/minecraft-java-bedrock-edition-pc")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
Else Else
Throw Throw
End If End If
@@ -1165,10 +1235,8 @@ SystemBrowser:
''' </summary> ''' </summary>
Public Function ExtractJavaWrapper() As String Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar" Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length <> 16818 Then WriteFile(WrapperPath, GetResources("JavaWrapper"))
WriteFile(WrapperPath, GetResources("JavaWrapper")) Log("[Java] 已释放 Java Wrapper：" & WrapperPath)
Log("[Java] 已自动释放 Java Wrapper：" & WrapperPath)
End If
Return WrapperPath Return WrapperPath
End Function End Function
''' <summary> ''' <summary>
@@ -1228,7 +1296,7 @@ SystemBrowser:
'全屏 '全屏
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen" If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
'进服 '进服
Dim Server As String = If(String.IsNullOrEmpty(Loader.Input), Setup.Get("VersionServerEnter", McVersionCurrent), Loader.Input) Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
If Server.Length > 0 Then If Server.Length > 0 Then
If Server.Contains(":") Then If Server.Contains(":") Then
'包含端口号 '包含端口号
@@ -1579,7 +1647,7 @@ NextVersion:
File.Delete(FilePath) File.Delete(FilePath)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath) McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath)
McLaunchLog("实际的错误信息：" & GetString(ex)) McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
Exit For Exit For
End Try End Try
End If End If
@@ -1599,7 +1667,7 @@ NextVersion:
File.Delete(FileName) File.Delete(FileName)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤") McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤")
McLaunchLog("实际的错误信息：" & GetString(ex)) McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
Exit Sub Exit Sub
End Try End Try
Next Next
@@ -1832,6 +1900,30 @@ IgnoreCustomSkin:
End Sub End Sub
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process)) Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
'输出 bat
Try
Dim CmdString As String =
"@echo off" & vbCrLf &
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！"
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
Loader.Parent.Abort()
Exit Sub '导出脚本完成
End If
Catch ex As Exception
Log(ex, "输出启动脚本失败")
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
End Try
'启动信息 '启动信息
Dim GameProcess = New Process() Dim GameProcess = New Process()
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw) Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
@@ -1861,22 +1953,6 @@ IgnoreCustomSkin:
Loader.Output = GameProcess Loader.Output = GameProcess
McLaunchProcess = GameProcess McLaunchProcess = GameProcess
'输出 bat
Try
Dim CmdString As String =
"@echo off" & vbCrLf &
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
Catch ex As Exception
Log(ex, "输出启动脚本失败")
End Try
'进程优先级处理 '进程优先级处理
Try Try
If GameProcess.HasExited Then Exit Try '可能在启动游戏进程的同时刚好取消了启动 If GameProcess.HasExited Then Exit Try '可能在启动游戏进程的同时刚好取消了启动
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+19 -10
View File
@@ -1271,7 +1271,7 @@ Recheck:
'检查文件夹 '检查文件夹
If Not Directory.Exists(Path) Then If Not Directory.Exists(Path) Then
State = McVersionState.Error State = McVersionState.Error
Info = "该文件夹不存在" Info = "未找到版本 " & Name
Return False Return False
End If End If
'检查权限 '检查权限
@@ -1307,7 +1307,7 @@ Recheck:
Catch ex As Exception Catch ex As Exception
Log(ex, "依赖版本检查出错（" & Name & "）") Log(ex, "依赖版本检查出错（" & Name & "）")
State = McVersionState.Error State = McVersionState.Error
Info = "未知错误：" & GetString(ex) Info = "未知错误：" & GetExceptionSummary(ex)
Return False Return False
End Try End Try
@@ -1319,7 +1319,6 @@ Recheck:
''' </summary> ''' </summary>
Public Function Load() As McVersion Public Function Load() As McVersion
Try Try
Directory.CreateDirectory(Path & "PCL")
'检查版本，若出错则跳过数据确定阶段 '检查版本，若出错则跳过数据确定阶段
If Not Check() Then GoTo ExitDataLoad If Not Check() Then GoTo ExitDataLoad
#Region "确定版本分类" #Region "确定版本分类"
@@ -1424,9 +1423,11 @@ ExitDataLoad:
'确定版本显示种类 '确定版本显示种类
DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
'写入缓存 '写入缓存
WriteIni(Path & "PCL\Setup.ini", "State", State) If Directory.Exists(Path) Then
WriteIni(Path & "PCL\Setup.ini", "Info", Info) WriteIni(Path & "PCL\Setup.ini", "State", State)
WriteIni(Path & "PCL\Setup.ini", "Logo", Logo) WriteIni(Path & "PCL\Setup.ini", "Info", Info)
WriteIni(Path & "PCL\Setup.ini", "Logo", Logo)
End If
If State <> McVersionState.Error Then If State <> McVersionState.Error Then
WriteIni(Path & "PCL\Setup.ini", "ReleaseTime", ReleaseTime.ToString("yyyy-MM-dd HH:mm:ss")) WriteIni(Path & "PCL\Setup.ini", "ReleaseTime", ReleaseTime.ToString("yyyy-MM-dd HH:mm:ss"))
WriteIni(Path & "PCL\Setup.ini", "VersionFabric", Version.FabricVersion) WriteIni(Path & "PCL\Setup.ini", "VersionFabric", Version.FabricVersion)
@@ -1439,7 +1440,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub) WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub)
End If End If
Catch ex As Exception Catch ex As Exception
Info = "未知错误：" & GetString(ex) Info = "未知错误：" & GetExceptionSummary(ex)
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png" Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
State = McVersionState.Error State = McVersionState.Error
Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback) Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback)
@@ -1454,6 +1455,14 @@ ExitDataLoad:
Dim version = TryCast(obj, McVersion) Dim version = TryCast(obj, McVersion)
Return version IsNot Nothing AndAlso Path = version.Path Return version IsNot Nothing AndAlso Path = version.Path
End Function End Function
Public Shared Operator =(a As McVersion, b As McVersion) As Boolean
If a Is Nothing AndAlso b Is Nothing Then Return True
If a Is Nothing OrElse b Is Nothing Then Return False
Return a.Path = b.Path
End Operator
Public Shared Operator <>(a As McVersion, b As McVersion) As Boolean
Return Not (a = b)
End Operator
End Class End Class
Public Enum McVersionState Public Enum McVersionState
@@ -3661,7 +3670,7 @@ VersionFindFail:
End If End If
Next Next
Catch ex As Exception Catch ex As Exception
Result.Add("检查 Mod 时出错：" & GetString(ex) & vbCrLf & " - " & ModEntity.FileName) Result.Add("检查 Mod 时出错：" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
Log(ex, "检查 Mod 时出错") Log(ex, "检查 Mod 时出错")
End Try End Try
Next Next
@@ -3737,8 +3746,8 @@ VersionFindFail:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0 If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1 If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If End If
Dim Lefts = RegexSearch(Left.ToLower, "[a-z]+|[0-9]+") Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.ToLower, "[a-z]+|[0-9]+") Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
'两边均缺失，感觉是一个东西 '两边均缺失，感觉是一个东西
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+17 -8
View File
@@ -12,7 +12,7 @@
''' <summary> ''' <summary>
''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。 ''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。
''' </summary> ''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True) As Boolean Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
Log("[ModPack] 整合包安装请求：" & If(File, "null")) Log("[ModPack] 整合包安装请求：" & If(File, "null"))
Dim Archive As Compression.ZipArchive = Nothing Dim Archive As Compression.ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
@@ -54,7 +54,7 @@
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包 If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next Next
Catch ex As Exception Catch ex As Exception
If GetString(ex, False, True).Contains("Error.WinIOError") Then If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return False
ElseIf File.ToLower.EndsWith(".rar") Then ElseIf File.ToLower.EndsWith(".rar") Then
@@ -69,7 +69,7 @@
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类：CurseForge") Log("[ModPack] 整合包种类：CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName) InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类：HMCL") Log("[ModPack] 整合包种类：HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder) InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -156,7 +156,7 @@ Retry:
''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。 ''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。
''' 加载器以安装目标版本文件夹为输入。 ''' 加载器以安装目标版本文件夹为输入。
''' </summary> ''' </summary>
Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String) As LoaderCombo(Of String) Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
@@ -280,9 +280,18 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime}) Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime}) Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("清理安装文件", Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip" '设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[Download] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
Dim Target As String = VersionFolder & "原始整合包.zip"
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[Download] 根据设置要求删除原始整合包文件：" & Target) Log("[Download] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target) File.Delete(Target)
@@ -304,7 +313,7 @@ Retry:
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Return Loader Return Loader
End Function End Function
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing) Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing Dim ShowRibble As Boolean = VersionName Is Nothing
@@ -326,7 +335,7 @@ Retry:
End If End If
'启动加载器 '启动加载器
Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName) Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName, Logo)
If Loader Is Nothing Then Exit Sub If Loader Is Nothing Then Exit Sub
Loader.Start(PathMcFolder & "versions\" & VersionName & "\") Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
Plain Craft Launcher 2/Modules/ModEvent.vb
+6 -25
View File
@@ -31,10 +31,10 @@
'执行 '执行
If Type = "打开文件" Then If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With { Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""), .Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location, .FileName = Location,
.WorkingDirectory = WorkingDir .WorkingDirectory = WorkingDir
} }
Process.Start(Info) Process.Start(Info)
Else '打开帮助 Else '打开帮助
PageOtherHelp.EnterHelpPage(Location) PageOtherHelp.EnterHelpPage(Location)
@@ -45,28 +45,9 @@
End Try End Try
End Sub) End Sub)
Case "启动游戏" Case "启动游戏"
If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
'初始化与前置条件检测 Hint("正在启动 " & Data(0) & "……")
If Not (FrmLaunchLeft.BtnLaunch.IsEnabled AndAlso FrmLaunchLeft.BtnLaunch.Visibility = Visibility.Visible AndAlso FrmLaunchLeft.BtnLaunch.IsHitTestVisible) Then
Hint("已有游戏正在启动中！", HintType.Critical) : Exit Sub
End If End If
If Not Directory.Exists(PathMcFolder & "versions\" & Data(0)) Then
Hint("未在当前 Minecraft 文件夹找到版本 " & Data(0) & "！", HintType.Critical) : Exit Sub
End If
Dim ButtonVersion As New McVersion(Data(0))
ButtonVersion.Load()
If ButtonVersion.State = McVersionState.Error Then
Hint("无法启动 " & Data(0) & "：" & ButtonVersion.Info, HintType.Critical) : Exit Sub
End If
'实际启动
McVersionCurrent = ButtonVersion
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.PageLaunchLeft_Loaded()
FrmLaunchLeft.RefreshButtonsUI()
FrmMain.AprilGiveup()
FrmLaunchLeft.LaunchButtonClick(If(Data.Length >= 2, Data(1), ""))
FrmMain.PageChange(FormMain.PageType.Launch)
Case "复制文本" Case "复制文本"
ClipboardSet(Join(Data, "|")) ClipboardSet(Join(Data, "|"))
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.3.0")> <Assembly: AssemblyVersion("2.4.4.0")>
<Assembly: AssemblyFileVersion("2.4.3.0")> <Assembly: AssemblyFileVersion("2.4.4.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+2 -2
View File
@@ -1822,7 +1822,7 @@ Public Module ModDownloadLib
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存（合并安装会先生成文件夹，这会在刷新时误判为可以使用缓存） WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存（合并安装会先生成文件夹，这会在刷新时误判为可以使用缓存）
Hint(Loader.Name & "成功！", HintType.Finish) Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical) Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info) Hint(Loader.Name & "已取消！", HintType.Info)
Case LoadState.Loading Case LoadState.Loading
@@ -1839,7 +1839,7 @@ Public Module ModDownloadLib
Case LoadState.Finished Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish) Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical) Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info) Hint(Loader.Name & "已取消！", HintType.Info)
Case LoadState.Loading Case LoadState.Loading
Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb
+1 -2
View File
@@ -3,7 +3,6 @@
#Region "Logo" #Region "Logo"
'Public CacheLogo As Boolean = True '是否缓存 Logo：通过下载量确定是否为默认页
Private _Logo As String = "" Private _Logo As String = ""
Public Property Logo As String Public Property Logo As String
Get Get
@@ -157,7 +156,7 @@ RetryStart:
Dim Ani As New List(Of AniData) Dim Ani As New List(Of AniData)
If IsMouseOver Then If IsMouseOver Then
Ani.AddRange({ Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time), AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
}) })
If IsMouseDown Then If IsMouseDown Then
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb
+8 -5
View File
@@ -96,7 +96,7 @@
PanMain.Children.Add(NewCard) PanMain.Children.Add(NewCard)
'确定卡片是否展开 '确定卡片是否展开
If Pair.Key = TopVersion Then If Pair.Key = TopVersion Then
MyCard.StackInstall(NewStack, 8, Pair.Key) MyCard.StackInstall(NewStack, If(Project.IsModPack, 9, 8), Pair.Key)
Else Else
NewCard.IsSwaped = True NewCard.IsSwaped = True
End If End If
@@ -164,17 +164,20 @@
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip" Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
Dim LogoFileAddress As String = PathTemp & "CFLogo\" & GetHash(CfItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() Sub()
If Not ModpackInstall(Target, VersionName) Then Throw New Exception("整合包安装出现异常！") If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常！")
End If
End Sub) With {.ProgressWeight = 0.1}) End Sub) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader) Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
Select Case MyLoader.State Select Case MyLoader.State
Case LoadState.Failed Case LoadState.Failed
Hint(MyLoader.Name & "失败：" & GetString(MyLoader.Error), HintType.Critical) Hint(MyLoader.Name & "失败：" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted Case LoadState.Aborted
Hint(MyLoader.Name & "已取消！", HintType.Info) Hint(MyLoader.Name & "已取消！", HintType.Info)
Case LoadState.Loading Case LoadState.Loading
@@ -228,7 +231,7 @@
If Not Version.IsLoaded Then Version.Load() If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False If Not Version.Modable Then Return False
If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain) Then Return False Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True If AllowFabric AndAlso Version.Version.HasFabric Then Return True
@@ -255,7 +258,7 @@
If SuitableVersions.Count = 0 Then If SuitableVersions.Count = 0 Then
DefaultFolder = PathMcFolder DefaultFolder = PathMcFolder
If NeedLoad Then If NeedLoad Then
Hint("当前 MC 文件夹中未找到适合这个 Mod 的游戏版本") Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本！")
Else Else
Log("[Download] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置") Log("[Download] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If End If
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+1 -1
View File
@@ -131,7 +131,7 @@
End Sub End Sub
'页面切换触发 '页面切换触发
Public Sub MinecraftSelected(sender As MyListItem, e As Object) Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs)
SelectedMinecraftId = sender.Title SelectedMinecraftId = sender.Title
SelectedMinecraftJsonUrl = sender.Tag("url").ToString SelectedMinecraftJsonUrl = sender.Tag("url").ToString
SelectedMinecraftIcon = sender.Logo SelectedMinecraftIcon = sender.Logo
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+26 -29
View File
@@ -352,10 +352,10 @@ UnknownType:
If ex.GetType.Name = "ThreadInterruptedException" Then If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = "" Data.Output = ""
Exit Sub Exit Sub
ElseIf GetString(ex).Contains("429") Then ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else Else
@@ -400,10 +400,10 @@ Finish:
If ex.GetType.Name = "ThreadInterruptedException" Then If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = "" Data.Output = ""
Exit Sub Exit Sub
ElseIf GetString(ex).Contains("429") Then ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else Else
@@ -470,7 +470,7 @@ UseDefault:
If ex.GetType.Name = "ThreadInterruptedException" Then If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = "" Data.Output = ""
Exit Sub Exit Sub
ElseIf GetString(ex).Contains("429") Then ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！") Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！")
Else Else
@@ -522,10 +522,10 @@ UseDefault:
If ex.GetType.Name = "ThreadInterruptedException" Then If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = "" Data.Output = ""
Exit Sub Exit Sub
ElseIf GetString(ex).Contains("429") Then ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else Else
@@ -570,10 +570,10 @@ Finish:
If ex.GetType.Name = "ThreadInterruptedException" Then If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = "" Data.Output = ""
Exit Sub Exit Sub
ElseIf GetString(ex).Contains("429") Then ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else Else
@@ -601,26 +601,23 @@ Finish:
FrmMain.PageChange(FormMain.PageType.VersionSelect) FrmMain.PageChange(FormMain.PageType.VersionSelect)
End Sub End Sub
'启动按钮 '启动按钮
Private Sub BtnLaunch_Click() Handles BtnLaunch.Click Public Sub LaunchButtonClick() Handles BtnLaunch.Click
LaunchButtonClick() If Not BtnLaunch.IsEnabled Then Exit Sub
End Sub '愚人节处理
Public Sub LaunchButtonClick(Optional ServerIp As String = "") If IsAprilEnabled AndAlso Not IsAprilGiveup Then
If BtnLaunch.IsEnabled AndAlso BtnLaunch.Visibility = Visibility.Visible AndAlso BtnLaunch.IsHitTestVisible Then ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁！")
If BtnLaunch.Text = "启动游戏" Then IsAprilGiveup = True
McLaunchLoader.Start(ServerIp, IsForceRestart:=True) FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
ElseIf BtnLaunch.Text = "下载游戏" Then FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) FrmLaunchLeft.AprilPosTrans.X = 0
End If FrmLaunchLeft.AprilPosTrans.Y = 0
'愚人节处理 FrmMain.BtnExtraApril.ShowRefresh()
If IsAprilEnabled AndAlso Not IsAprilGiveup Then End If
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁！") '实际的启动
IsAprilGiveup = True If BtnLaunch.Text = "启动游戏" Then
FrmLaunchLeft.AprilScaleTrans.ScaleX = 1 McLaunchStart()
FrmLaunchLeft.AprilScaleTrans.ScaleY = 1 ElseIf BtnLaunch.Text = "下载游戏" Then
FrmLaunchLeft.AprilPosTrans.X = 0 FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
FrmLaunchLeft.AprilPosTrans.Y = 0
FrmMain.BtnExtraApril.ShowRefresh()
End If
End If End If
End Sub End Sub
Private BtnLaunchState As Integer = 0 Private BtnLaunchState As Integer = 0
Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb
+3 -3
View File
@@ -145,9 +145,9 @@ Reopen:
Try Try
CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "") CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "")
Catch ex As Exception Catch ex As Exception
If GetString(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New CertOutdatedException '索引码无效或已过期 Throw New CertOutdatedException '索引码无效或已过期
ElseIf GetString(ex).Contains("too many requests") Then ElseIf GetExceptionSummary(ex).Contains("too many requests") Then
Throw New Exception("你的尝试太频繁了，请暂时啥都别点，等两分钟后再试……") Throw New Exception("你的尝试太频繁了，请暂时啥都别点，等两分钟后再试……")
Else Else
Throw Throw
@@ -799,7 +799,7 @@ WrongCode:
LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf & LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf &
"点击镐子重试，或者点击灰色的 × 取消。" "点击镐子重试，或者点击灰色的 × 取消。"
Else Else
LabLoadDesc.Text = LoadStep & "失败：" & GetString(RealException) & vbCrLf & LabLoadDesc.Text = LoadStep & "失败：" & GetExceptionSummary(RealException) & vbCrLf &
"点击镐子重试，或者点击灰色的 × 取消。" "点击镐子重试，或者点击灰色的 × 取消。"
End If End If
Log(Loader.Error, "HiPer 联机尝试失败") Log(Loader.Error, "HiPer 联机尝试失败")
Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb
+7 -3
View File
@@ -125,9 +125,13 @@
'打开网页 '打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If Not CanFeedback(True) Then Exit Sub If Not CanFeedback(True) Then Exit Sub
If MyMsgBox("是否要打开反馈列表网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。", Select Case MyMsgBox("是否要打开反馈列表网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub "反馈提示", "提交新反馈", "查看反馈列表", "取消")
Feedback(True, False) Case 1
Feedback(True, False)
Case 2
OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
End Select
End Sub End Sub
Public Shared Sub TryVote() Handles ItemVote.Click Public Shared Sub TryVote() Handles ItemVote.Click
If MyMsgBox("是否要打开新功能投票网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。", If MyMsgBox("是否要打开新功能投票网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。",
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml
+2 -2
View File
@@ -16,10 +16,10 @@
<Setter Property="Background"> <Setter Property="Background">
<Setter.Value> <Setter.Value>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5"> <LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop Color="{DynamicResource ColorObject9}" Offset="0"/> <GradientStop Color="{DynamicResource ColorObjectBg1}" Offset="0"/>
<GradientStop Color="{DynamicResource ColorObject3}" Offset="0.02"/> <GradientStop Color="{DynamicResource ColorObject3}" Offset="0.02"/>
<GradientStop Color="{DynamicResource ColorObject3}" Offset="0.98"/> <GradientStop Color="{DynamicResource ColorObject3}" Offset="0.98"/>
<GradientStop Color="{DynamicResource ColorObject9}" Offset="1"/> <GradientStop Color="{DynamicResource ColorObjectBg1}" Offset="1"/>
</LinearGradientBrush> </LinearGradientBrush>
</Setter.Value> </Setter.Value>
</Setter> </Setter>
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
+1 -1
View File
@@ -91,7 +91,7 @@
Card.Children.Clear() Card.Children.Clear()
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>")) Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTipService.ShowDuration=""2333333"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />") Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTipService.ShowDuration=""2333333"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = GetString(Loader.Error, False) Tb.Text = GetExceptionDetail(Loader.Error)
AddHandler Tb.MouseDown, Sub(sender As TextBlock, e As EventArgs) AddHandler Tb.MouseDown, Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False) ClipboardSet(sender.Text, False)
Hint("已复制错误详情！", HintType.Finish) Hint("已复制错误详情！", HintType.Finish)
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
+4 -4
View File
@@ -7,11 +7,11 @@
Public Sub RefreshModDisabled() Handles Me.Loaded Public Sub RefreshModDisabled() Handles Me.Loaded
If Version IsNot Nothing AndAlso Version.Modable Then If Version IsNot Nothing AndAlso Version.Modable Then
ItemMod.Visibility = Visibility.Visible ItemMod.Height = 36
ItemModDisabled.Visibility = Visibility.Collapsed ItemModDisabled.Height = 0
Else Else
ItemMod.Visibility = Visibility.Collapsed ItemMod.Height = 0
ItemModDisabled.Visibility = Visibility.Visible ItemModDisabled.Height = 36
End If End If
End Sub End Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+1 -1
View File
@@ -267,7 +267,7 @@
Case McMod.McModState.Disabled Case McMod.McModState.Disabled
NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count) NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count)
Case McMod.McModState.Unavaliable Case McMod.McModState.Unavaliable
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetString(ModEntity.FileUnavailableReason, False), "Mod 读取失败") MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntity.FileUnavailableReason), "Mod 读取失败")
Exit Sub Exit Sub
End Select End Select
'重命名 '重命名
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml
+27 -12
View File
@@ -7,10 +7,12 @@
d:DesignWidth="800" d:DesignHeight="800" Grid.IsSharedSizeScope="True"> d:DesignWidth="800" d:DesignHeight="800" Grid.IsSharedSizeScope="True">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10"> <StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard Margin="0,15" Title="个性化" x:Name="PanDisplay"> <local:MyCard Margin="0,15" Title="">
<Grid Margin="10,7" Name="PanDisplayItem" />
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="个性化" x:Name="PanDisplay">
<StackPanel Margin="25,40,25,15"> <StackPanel Margin="25,40,25,15">
<Grid Margin="-7,-3,0,12" Name="PanDisplayItem" /> <Grid x:Name="PanDisplayIcon" HorizontalAlignment="Stretch">
<Grid x:Name="PanDisplayIcon" Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition /> <ColumnDefinition />
@@ -20,7 +22,7 @@
<RowDefinition Height="9" /> <RowDefinition Height="9" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本图标" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="图标" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo"> <local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo">
<local:MyComboBoxItem Content="自动" IsSelected="True" Tag="" /> <local:MyComboBoxItem Content="自动" IsSelected="True" Tag="" />
<local:MyComboBoxItem Content="自定义..." x:Name="ItemDisplayLogoCustom" /> <local:MyComboBoxItem Content="自定义..." x:Name="ItemDisplayLogoCustom" />
@@ -36,7 +38,7 @@
<local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" /> <local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" />
<local:MyComboBoxItem Content="布料（Fabric）" Tag="pack://application:,,,/images/Blocks/Fabric.png" /> <local:MyComboBoxItem Content="布料（Fabric）" Tag="pack://application:,,,/images/Blocks/Fabric.png" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本分类" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType"> <local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType">
<local:MyComboBoxItem Content="自动" IsSelected="True" /> <local:MyComboBoxItem Content="自动" IsSelected="True" />
<local:MyComboBoxItem Content="从版本列表中隐藏" ToolTip="该版本默认将不会在版本列表中显示。&#xA;在版本列表页面按下 F11，即可查看所有隐藏的版本。" ToolTipService.ShowDuration="2333333" /> <local:MyComboBoxItem Content="从版本列表中隐藏" ToolTip="该版本默认将不会在版本列表中显示。&#xA;在版本列表页面按下 F11，即可查看所有隐藏的版本。" ToolTipService.ShowDuration="2333333" />
@@ -46,19 +48,19 @@
<local:MyComboBoxItem Content="愚人节版本" /> <local:MyComboBoxItem Content="愚人节版本" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
<Grid Margin="0,0,0,7" Height="35"> <Grid Margin="0,15,0,7" Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDisplayRename" Text="重命名版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton x:Name="BtnDisplayRename" Text="修改版本名" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnDisplayDesc" Text="更改描述" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" /> <local:MyButton x:Name="BtnDisplayDesc" Text="修改版本描述" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnDisplayStar" Text="加入收藏夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" /> <local:MyButton x:Name="BtnDisplayDelete" Text="删除版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" ColorType="Red" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="管理" x:Name="PanManage"> <local:MyCard Margin="0,0,0,15" Title="快捷方式" x:Name="PanFolder">
<StackPanel Margin="25,40,25,15"> <StackPanel Margin="25,40,25,15">
<Grid Margin="0,2,0,7" Height="35"> <Grid Margin="0,2,0,7" Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -66,9 +68,22 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageFolder" Text="打开版本文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton x:Name="BtnFolderVersion" Text="版本文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnFolderSaves" Text="存档文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnFolderMods" Text="Mod 文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="高级管理" x:Name="PanManage">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,2,0,7" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageScript" Text="导出启动脚本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnManageCheck" Text="补全文件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" ToolTip="校验版本依赖文件是否完整，并重新下载 Assets 索引与缺失、校验失败的文件。&#xa;若游戏缺失音效，请尝试此项。" ToolTipService.ShowDuration="2333333" /> <local:MyButton x:Name="BtnManageCheck" Text="补全文件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" ToolTip="校验版本依赖文件是否完整，并重新下载 Assets 索引与缺失、校验失败的文件。&#xa;若游戏缺失音效，请尝试此项。" ToolTipService.ShowDuration="2333333" />
<local:MyButton x:Name="BtnManageDelete" Text="删除版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" ColorType="Red" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
+117 -76
View File
@@ -26,7 +26,7 @@
'刷新设置项目 '刷新设置项目
ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
BtnDisplayStar.Text = If(PageVersionLeft.Version.IsStar, "从收藏夹中移除", "加入收藏夹") BtnFolderMods.Visibility = If(PageVersionLeft.Version.Modable, Visibility.Visible, Visibility.Collapsed)
'刷新版本显示 '刷新版本显示
PanDisplayItem.Children.Clear() PanDisplayItem.Children.Clear()
ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version) ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version)
@@ -49,7 +49,7 @@
AniControlEnabled -= 1 AniControlEnabled -= 1
End Sub End Sub
#Region "设置临时接口" #Region "卡片：个性化"
'版本分类 '版本分类
Private Sub ComboDisplayType_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayType.SelectionChanged Private Sub ComboDisplayType_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayType.SelectionChanged
@@ -67,6 +67,7 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "修改版本分类失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback) Log(ex, "修改版本分类失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback)
End Try End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else Else
'改为隐藏 '改为隐藏
Try Try
@@ -85,6 +86,7 @@
End Try End Try
End If End If
End Sub End Sub
'更改描述 '更改描述
Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click
Try Try
@@ -98,6 +100,7 @@
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox) Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
'重命名版本 '重命名版本
Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click
Try Try
@@ -171,80 +174,7 @@
Log(ex, "重命名版本失败", LogLevel.Msgbox) Log(ex, "重命名版本失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
'收藏夹
Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click
Try
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "IsStar", Not PageVersionLeft.Version.IsStar)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
Reload()
McVersionListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 收藏状态更改失败", LogLevel.Msgbox)
End Try
End Sub
'补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中，请稍候！", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
'删除版本
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
'修改此代码时，同时修改 PageSelectRight 中的代码
Try
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish)
Case 2
' DeleteDirectory(PageVersionLeft.Version.Path)
' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish)
'Case 3
Exit Sub
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
'打开版本文件夹
Private Sub BtnManageFolder_Click() Handles BtnManageFolder.Click
OpenVersionFolder(PageVersionLeft.Version)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer("""" & Version.Path & """")
End Sub
'版本图标 '版本图标
Private Sub ComboDisplayLogo_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayLogo.SelectionChanged Private Sub ComboDisplayLogo_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayLogo.SelectionChanged
If Not (IsLoad AndAlso AniControlEnabled = 0) Then Exit Sub If Not (IsLoad AndAlso AniControlEnabled = 0) Then Exit Sub
@@ -280,6 +210,117 @@
End Try End Try
End Sub End Sub
'删除版本
Private Sub BtnDisplayDelete_Click(sender As Object, e As EventArgs) Handles BtnDisplayDelete.Click
'修改此代码时，同时修改 PageSelectRight 中的代码
Try
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish)
Case 2
' DeleteDirectory(PageVersionLeft.Version.Path)
' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish)
'Case 3
Exit Sub
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
#End Region
#Region "卡片：快捷方式"
'版本文件夹
Private Sub BtnFolderVersion_Click() Handles BtnFolderVersion.Click
OpenVersionFolder(PageVersionLeft.Version)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer("""" & Version.Path & """")
End Sub
'存档文件夹
Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "saves\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
End Sub
'Mod 文件夹
Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "mods\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
End Sub
#End Region
#Region "卡片：管理"
'导出启动脚本
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try
'弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectAs("选择脚本保存位置", "启动 " & PageVersionLeft.Version.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Exit Sub
'检查中断（等玩家选完弹窗指不定任务就结束了呢……）
If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试！", HintType.Critical)
Exit Sub
End If
'生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Version = PageVersionLeft.Version}) Then
If Setup.Get("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……")
Else
Hint("正在导出启动脚本……（注意，使用脚本启动可能会导致登录失效！）")
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
'补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中，请稍候！", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
#End Region #End Region
End Class End Class
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+1
View File
@@ -119,6 +119,7 @@
<PlatformTarget>AnyCPU</PlatformTarget> <PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisRuleSet>BasicDesignGuidelineRules.ruleset</CodeAnalysisRuleSet> <CodeAnalysisRuleSet>BasicDesignGuidelineRules.ruleset</CodeAnalysisRuleSet>
<DefineConstants>BETA</DefineConstants> <DefineConstants>BETA</DefineConstants>
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup> </PropertyGroup>
<PropertyGroup> <PropertyGroup>
<SignAssembly>false</SignAssembly> <SignAssembly>false</SignAssembly>
Plain Craft Launcher 2/Resources/java-wrapper.jar
BIN
View File
Binary file not shown.