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

上传公开代码

Browse Source
This commit is contained in:
龙腾猫跃
2022-07-27 18:48:13 +08:00
parent 6a3f4d35d4
commit b0b02291cc
208 changed files with 38567 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.editorconfig
+4
View File
@@ -0,0 +1,4 @@
[*.{cs,vb}]
# IDE0028: 简化集合初始化
dotnet_style_collection_initializer = true:silent
Plain Craft Launcher 2.sln
+47
View File
@@ -0,0 +1,47 @@
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 16
VisualStudioVersion = 16.0.29728.190
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Releaser", "Releaser", "{0FB7B07C-83E1-477E-B05B-C298304748BC}"
ProjectSection(SolutionItems) = preProject
E:\工具\de4dot\de4dot.exe = E:\工具\de4dot\de4dot.exe
E:\软件\dnSpy\dnSpy.exe = E:\软件\dnSpy\dnSpy.exe
Releaser\Release.nrproj = Releaser\Release.nrproj
Releaser\Releaser.bat = Releaser\Releaser.bat
Releaser\Snapshot.nrproj = Releaser\Snapshot.nrproj
Releaser\Snapshot.vmp = Releaser\Snapshot.vmp
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Beta|Any CPU = Beta|Any CPU
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {838A572E-025C-4A2B-B682-68732EC0FE76}
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
EndGlobal
Plain Craft Launcher 2/App.config
+33
View File
@@ -0,0 +1,33 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<system.net>
<settings>
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup>
<runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<generatePublisherEvidence enabled="false"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>
Plain Craft Launcher 2/Application.xaml
+542
View File
@@ -0,0 +1,542 @@
<Application x:Class="Application"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:sys="clr-namespace:System;assembly=mscorlib"
StartupUri="FormMain.xaml"
ShutdownMode="OnExplicitShutdown">
<Application.Resources>
<ResourceDictionary>
<!-- 本地化 -->
<ResourceDictionary.MergedDictionaries>
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
</ResourceDictionary.MergedDictionaries>
<!-- 颜色表 -->
<SolidColorBrush x:Key="ColorBrush1">#343d4a</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush2">#0b5bcb</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush3">#1370f3</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush4">#4890f5</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush5">#96c0f9</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush6">#d5e6fd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush7">#e0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush8">#eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush9">#80e0eafd</SolidColorBrush>
<Color x:Key="ColorObject1">#343d4a</Color>
<Color x:Key="ColorObject2">#0b5bcb</Color>
<Color x:Key="ColorObject3">#1370f3</Color>
<Color x:Key="ColorObject4">#4890f5</Color>
<Color x:Key="ColorObject5">#96c0f9</Color>
<Color x:Key="ColorObject6">#d5e6fd</Color>
<Color x:Key="ColorObject7">#e0eafd</Color>
<Color x:Key="ColorObject8">#eaf2fe</Color>
<Color x:Key="ColorObject9">#40eaf2fe</Color>
<SolidColorBrush x:Key="ColorBrushGray1">#404040</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray2">#737373</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray3">#8c8c8c</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray4">#a6a6a6</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray5">#cccccc</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray6">#ebebeb</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray7">#f0f0f0</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray8">#f5f5f5</SolidColorBrush>
<Color x:Key="ColorObjectGray1">#404040</Color>
<Color x:Key="ColorObjectGray2">#737373</Color>
<Color x:Key="ColorObjectGray3">#8c8c8c</Color>
<Color x:Key="ColorObjectGray4">#a6a6a6</Color>
<Color x:Key="ColorObjectGray5">#cccccc</Color>
<Color x:Key="ColorObjectGray6">#ebebeb</Color>
<Color x:Key="ColorObjectGray7">#f0f0f0</Color>
<Color x:Key="ColorObjectGray8">#f5f5f5</Color>
<SolidColorBrush x:Key="ColorBrushRedBack">#80fbdddd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushRedLight">#ff4c4c</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushRedDark">#ce2111</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushHalfWhite" Color="#44ffffff" />
<SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
<SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
<!-- Window -->
<Style TargetType="{x:Type Window}" x:Key="MyWindow">
<Setter Property="OverridesDefaultStyle" Value="True"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="{x:Type Window}">
<ContentPresenter/>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- Label -->
<Style TargetType="Label">
<Setter Property="OverridesDefaultStyle" Value="True"/>
<Setter Property="Padding" Value="0"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="Label">
<Border Background="{TemplateBinding Background}">
<ContentPresenter
HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}"
Margin="{TemplateBinding Padding}"
RecognizesAccessKey="False"
SnapsToDevicePixels="{TemplateBinding SnapsToDevicePixels}"
VerticalAlignment="{TemplateBinding VerticalContentAlignment}"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:MyTextButton">
<Setter Property="OverridesDefaultStyle" Value="True"/>
<Setter Property="Padding" Value="0"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="Label">
<Border Background="{TemplateBinding Background}">
<TextBlock
HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}"
Margin="{TemplateBinding Padding}"
Foreground="{TemplateBinding Foreground}"
Text="{TemplateBinding Content}"
SnapsToDevicePixels="{TemplateBinding SnapsToDevicePixels}"
VerticalAlignment="{TemplateBinding VerticalContentAlignment}"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- TextBlock -->
<Style TargetType="TextBlock">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="FontSize" Value="13" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="TextTrimming" Value="CharacterEllipsis" />
<Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" />
</Style>
<Style TargetType="TextBlock" x:Key="BasedOnTextBlock">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="FontSize" Value="13" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="TextTrimming" Value="CharacterEllipsis" />
<Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" />
</Style>
<!-- ToolTip -->
<Style TargetType="ToolTip">
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="3" MaxWidth="500" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.4" BlurRadius="4" ShadowDepth="2" />
</Border.Effect>
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style x:Key="ExtendTextToolTip" TargetType="ToolTip">
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- ScrollViewer -->
<Style x:Key="MyThumb" TargetType="Thumb">
<Setter Property="Stylus.IsPressAndHoldEnabled" Value="false"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="Thumb">
<Border Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Border Background="{TemplateBinding Foreground}" CornerRadius="3" Margin="2" />
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:MyScrollBar">
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Stylus.IsPressAndHoldEnabled" Value="False"/>
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="SnapsToDevicePixels" Value="True" />
<Setter Property="UseLayoutRounding" Value="True" />
<Setter Property="MinWidth" Value="8"/>
<Setter Property="Width" Value="8"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ScrollBar">
<Border CornerRadius="2">
<Track x:Name="PART_Track" IsDirectionReversed="true" IsEnabled="{TemplateBinding IsMouseOver}">
<Track.Resources>
<sys:Double x:Key="{x:Static SystemParameters.VerticalScrollBarButtonHeightKey}">
100
</sys:Double>
</Track.Resources>
<Track.DecreaseRepeatButton>
<RepeatButton Command="{x:Static ScrollBar.PageUpCommand}" Opacity="0" />
</Track.DecreaseRepeatButton>
<Track.IncreaseRepeatButton>
<RepeatButton Command="{x:Static ScrollBar.PageDownCommand}" Opacity="0" />
</Track.IncreaseRepeatButton> <!-- 不能删，删了点击 Thumb 以外的部分就不能翻页了 -->
<Track.Thumb>
<Thumb Style="{StaticResource MyThumb}" Foreground="{TemplateBinding Foreground}" />
</Track.Thumb>
</Track>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:MyScrollViewer">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
<Setter Property="PanningMode" Value="VerticalOnly" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ScrollViewer">
<Grid>
<ScrollContentPresenter x:Name="PART_ScrollContentPresenter" CanContentScroll="{TemplateBinding CanContentScroll}" CanHorizontallyScroll="False" CanVerticallyScroll="False" ContentTemplate="{TemplateBinding ContentTemplate}" Content="{TemplateBinding Content}" Grid.Column="0" Margin="{TemplateBinding Padding}" Grid.Row="0"/>
<local:MyScrollBar x:Name="PART_VerticalScrollBar" AutomationProperties.AutomationId="VerticalScrollBar" Grid.Column="1" Maximum="{TemplateBinding ScrollableHeight}" Minimum="0" Grid.Row="0" Visibility="{TemplateBinding ComputedVerticalScrollBarVisibility}" Value="{Binding VerticalOffset, Mode=OneWay, RelativeSource={RelativeSource TemplatedParent}}" ViewportSize="{TemplateBinding ViewportHeight}" Foreground="{TemplateBinding Foreground}" Background="{TemplateBinding Background}" HorizontalAlignment="Right" />
</Grid>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
<Setter Property="PanningMode" Value="VerticalOnly" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ScrollViewer">
<Grid SnapsToDevicePixels="{TemplateBinding SnapsToDevicePixels}" Margin="{TemplateBinding Padding}">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="*"/>
<ColumnDefinition Width="Auto"/>
</Grid.ColumnDefinitions>
<ScrollContentPresenter x:Name="PART_ScrollContentPresenter" CanContentScroll="{TemplateBinding CanContentScroll}" CanHorizontallyScroll="False" CanVerticallyScroll="False" ContentTemplate="{TemplateBinding ContentTemplate}" Content="{TemplateBinding Content}"/>
<local:MyScrollBar Margin="2,1,1,1" x:Name="PART_VerticalScrollBar" AutomationProperties.AutomationId="VerticalScrollBar" Grid.Column="1" Maximum="{TemplateBinding ScrollableHeight}" Minimum="0" Grid.Row="0" Visibility="{TemplateBinding ComputedVerticalScrollBarVisibility}" Value="{Binding VerticalOffset, Mode=OneWay, RelativeSource={RelativeSource TemplatedParent}}" ViewportSize="{TemplateBinding ViewportHeight}" Foreground="{TemplateBinding Foreground}" Background="{TemplateBinding Background}" />
</Grid>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="ScrollViewer" x:Key="ScrollViewerNoMargin">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
<Setter Property="PanningMode" Value="VerticalOnly" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ScrollViewer">
<Grid SnapsToDevicePixels="{TemplateBinding SnapsToDevicePixels}" Margin="{TemplateBinding Padding}" Cursor="Arrow">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="*"/>
<ColumnDefinition Width="Auto"/>
</Grid.ColumnDefinitions>
<ScrollContentPresenter x:Name="PART_ScrollContentPresenter" CanContentScroll="{TemplateBinding CanContentScroll}" CanHorizontallyScroll="False" CanVerticallyScroll="False" ContentTemplate="{TemplateBinding ContentTemplate}" Content="{TemplateBinding Content}" Cursor="{TemplateBinding Cursor}" />
<local:MyScrollBar x:Name="PART_VerticalScrollBar" AutomationProperties.AutomationId="VerticalScrollBar" Grid.Column="1" Maximum="{TemplateBinding ScrollableHeight}" Minimum="0" Grid.Row="0" Visibility="{TemplateBinding ComputedVerticalScrollBarVisibility}" Value="{Binding VerticalOffset, Mode=OneWay, RelativeSource={RelativeSource TemplatedParent}}" ViewportSize="{TemplateBinding ViewportHeight}" Foreground="{TemplateBinding Foreground}" Background="{TemplateBinding Background}" />
</Grid>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- TextBox -->
<Style TargetType="local:MyTextBox">
<Setter Property="BorderThickness" Value="1" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="FontSize" Value="13" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" />
<Setter Property="VerticalContentAlignment" Value="Center" />
<Setter Property="SnapsToDevicePixels" Value="True" />
<Setter Property="IsUndoEnabled" Value="True" />
<Setter Property="KeyboardNavigation.TabNavigation" Value="None"/>
<Setter Property="HorizontalContentAlignment" Value="Left"/>
<Setter Property="FocusVisualStyle" Value="{x:Null}"/>
<Setter Property="AllowDrop" Value="True"/>
<Setter Property="ScrollViewer.PanningMode" Value="VerticalFirst"/>
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="UndoLimit" Value="15" />
<Setter Property="MaxLength" Value="10000" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="TextBox">
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
<Grid.RowDefinitions>
<RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" />
</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">
<ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0"
Margin="5,0,0,0" Cursor="IBeam" />
<!-- 由于未知原因，TextView 会有 2,0 的 Margin -->
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="PasswordBox">
<Setter Property="FontSize" Value="13" />
<Setter Property="VerticalContentAlignment" Value="Top" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" />
<Setter Property="KeyboardNavigation.TabNavigation" Value="None"/>
<Setter Property="HorizontalContentAlignment" Value="Left"/>
<Setter Property="FocusVisualStyle" Value="{x:Null}"/>
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="PasswordBox">
<Border x:Name="border" BorderThickness="1" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" Padding="0" SnapsToDevicePixels="True" CornerRadius="3">
<local:MyScrollViewer x:Name="PART_ContentHost" Margin="4.5,4.5,0,4.5" HorizontalScrollBarVisibility="Hidden" RenderOptions.ClearTypeHint="Enabled" SnapsToDevicePixels="True"/>
</Border>
<ControlTemplate.Triggers>
<Trigger Property="IsEnabled" Value="False">
<Trigger.Setters>
<Setter Property="Foreground" Value="{StaticResource ColorBrushGray4}" />
<Setter Property="BorderBrush" Value="{StaticResource ColorBrushGray4}" />
</Trigger.Setters>
</Trigger>
<Trigger Property="IsMouseOver" Value="True">
<Trigger.Setters>
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush3}" />
</Trigger.Setters>
</Trigger>
<Trigger Property="IsFocused" Value="True">
<Trigger.Setters>
<Setter Property="Background" Value="{DynamicResource ColorBrush9}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush4}" />
</Trigger.Setters>
</Trigger>
</ControlTemplate.Triggers>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- ComboBox -->
<DataTemplate x:Key="ComboBoxItemTemplateWithDelete">
<local:MyListItem Title="{Binding}" FontSize="13" PaddingRight="40" MaxHeight="26" IsScaleAnimationEnabled="False" Margin="-1,0,0,0">
<local:MyListItem.Buttons>
<x:Array Type="local:MyIconButton">
<local:MyIconButton Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Tag="{Binding}" Click="MyIconButton_Click" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</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">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="SnapsToDevicePixels" Value="True" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<!--<Setter Property="ItemTemplate" Value="{StaticResource ComboBoxItemTemplateNormal}"/>-->
<Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="160" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ComboBox">
<Grid>
<Border x:Name="border" Background="{TemplateBinding Background}" CornerRadius="3" BorderThickness="1" BorderBrush="{TemplateBinding Foreground}" />
<ToggleButton Margin="0,0,1.5,0" Foreground="{TemplateBinding Foreground}" IsTabStop="False" SnapsToDevicePixels="False" Focusable="False" IsChecked="{Binding IsDropDownOpen,Mode=TwoWay,RelativeSource={RelativeSource TemplatedParent}}" ClickMode="Press" />
<ContentPresenter Margin="8.5,0,21.5,0" IsHitTestVisible="False" Content="{TemplateBinding SelectionBoxItem}" ContentTemplate="{TemplateBinding SelectionBoxItemTemplate}" ContentTemplateSelector="{TemplateBinding ItemTemplateSelector}" VerticalAlignment="Center" />
<Popup x:Name="PART_Popup" SnapsToDevicePixels="True" VerticalOffset="-1.5" AllowsTransparency="True" IsOpen="{Binding IsDropDownOpen, Mode=TwoWay, RelativeSource={RelativeSource TemplatedParent}}" Placement="Bottom" PopupAnimation="Fade">
<Grid x:Name="PanPopup">
<Border Background="White" CornerRadius="3" />
<Border x:Name="dropDownBorder" CornerRadius="3" BorderBrush="{TemplateBinding Foreground}" BorderThickness="1" Width="{TemplateBinding Width}" MaxHeight="{TemplateBinding MaxDropDownHeight}">
<local:MyScrollViewer x:Name="DropDownScrollViewer" PanningMode="VerticalOnly" SnapsToDevicePixels="False" Style="{StaticResource ScrollViewerFullMargin}" ScrollViewer.CanContentScroll="False" VerticalScrollBarVisibility="Auto">
<ItemsPresenter x:Name="ItemsPresenter" KeyboardNavigation.DirectionalNavigation="Contained" />
</local:MyScrollViewer>
</Border>
</Grid>
</Popup>
</Grid>
<ControlTemplate.Triggers>
<Trigger Property="HasItems" Value="false">
<Setter Property="Height" TargetName="dropDownBorder" Value="26"/>
</Trigger>
</ControlTemplate.Triggers>
</ControlTemplate>
</Setter.Value>
</Setter>
<Style.Triggers>
<Trigger Property="IsEditable" Value="True">
<Setter Property="IsTabStop" Value="False"/>
<Setter Property="ItemTemplate" Value="{StaticResource ComboBoxItemTemplateWithDelete}"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ComboBox">
<Grid>
<Border x:Name="border" Background="{TemplateBinding Background}" CornerRadius="3" BorderThickness="1" BorderBrush="{TemplateBinding Foreground}" />
<ToggleButton Margin="0,0,1.5,0" Foreground="{TemplateBinding Foreground}" IsTabStop="False" SnapsToDevicePixels="False" Focusable="False" IsChecked="{Binding IsDropDownOpen,Mode=TwoWay,RelativeSource={RelativeSource TemplatedParent}}" ClickMode="Press" />
<local:MyTextBox x:Name="PART_EditableTextBox" BorderThickness="0" Margin="1.5,0,21.5,0" Padding="0" Background="{x:Null}" />
<Popup x:Name="PART_Popup" SnapsToDevicePixels="True" VerticalOffset="-1.5" AllowsTransparency="True" IsOpen="{Binding IsDropDownOpen, Mode=TwoWay, RelativeSource={RelativeSource TemplatedParent}}" Placement="Bottom" PopupAnimation="Fade">
<Grid x:Name="PanPopup">
<Border Background="White" CornerRadius="3" />
<Border x:Name="dropDownBorder" SnapsToDevicePixels="False" CornerRadius="3" BorderBrush="{TemplateBinding Foreground}" BorderThickness="1" Width="{TemplateBinding Width}" MaxHeight="{TemplateBinding MaxDropDownHeight}">
<local:MyScrollViewer x:Name="DropDownScrollViewer" Style="{StaticResource ScrollViewerFullMargin}" ScrollViewer.CanContentScroll="False" VerticalScrollBarVisibility="Auto">
<ItemsPresenter x:Name="ItemsPresenter" KeyboardNavigation.DirectionalNavigation="Contained" />
</local:MyScrollViewer>
</Border>
</Grid>
</Popup>
</Grid>
<ControlTemplate.Triggers>
<Trigger Property="HasItems" Value="false">
<Setter Property="Height" TargetName="dropDownBorder" Value="26"/>
</Trigger>
</ControlTemplate.Triggers>
</ControlTemplate>
</Setter.Value>
</Setter>
</Trigger>
</Style.Triggers>
</Style>
<Style TargetType="ToggleButton">
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ToggleButton">
<Border Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="path" Width="15" RenderTransformOrigin="0.3,0.5" HorizontalAlignment="Right" Data="M1,1L4.5,4.5L8,1" StrokeThickness="1.5" Stroke="{TemplateBinding Foreground}" VerticalAlignment="Center">
<Path.RenderTransform>
<RotateTransform />
</Path.RenderTransform>
</Path>
</Border>
<ControlTemplate.Triggers>
<Trigger Property="IsChecked" Value="True">
<Trigger.EnterActions>
<BeginStoryboard>
<Storyboard Storyboard.TargetName="path" Storyboard.TargetProperty="(UIElement.RenderTransform).(RotateTransform.Angle)">
<DoubleAnimation To="180" Duration="0:0:0.2">
<DoubleAnimation.EasingFunction>
<CircleEase EasingMode="EaseOut" />
</DoubleAnimation.EasingFunction>
</DoubleAnimation>
</Storyboard>
</BeginStoryboard>
</Trigger.EnterActions>
<Trigger.ExitActions>
<BeginStoryboard>
<Storyboard Storyboard.TargetName="path" Storyboard.TargetProperty="(UIElement.RenderTransform).(RotateTransform.Angle)">
<DoubleAnimation To="0" Duration="0:0:0.2">
<DoubleAnimation.EasingFunction>
<CircleEase EasingMode="EaseOut" />
</DoubleAnimation.EasingFunction>
</DoubleAnimation>
</Storyboard>
</BeginStoryboard>
</Trigger.ExitActions>
</Trigger>
</ControlTemplate.Triggers>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ComboBoxItem">
<Border x:Name="ItemBorder" Padding="6,4" SnapsToDevicePixels="True" Background="{TemplateBinding Background}">
<ContentPresenter />
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style TargetType="ComboBoxItem">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ComboBoxItem">
<Border x:Name="ItemBorder" SnapsToDevicePixels="True" Background="{TemplateBinding Background}">
<ContentPresenter />
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- ContextMenu -->
<Style TargetType="ContextMenu">
<Setter Property="SnapsToDevicePixels" Value="True"/>
<Setter Property="OverridesDefaultStyle" Value="True"/>
<Setter Property="Grid.IsSharedSizeScope" Value="True"/>
<Setter Property="Focusable" Value="False"/>
<Setter Property="HasDropShadow" Value="False"/>
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ContextMenu">
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.4" BlurRadius="4" ShadowDepth="2" />
</Border.Effect>
<StackPanel IsItemsHost="True" KeyboardNavigation.DirectionalNavigation="Cycle" Margin="0.5"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- MenuItem -->
<Style TargetType="local:MyMenuItem">
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="MenuItem">
<Border Name="PanBack" Padding="{TemplateBinding Padding}" Background="{TemplateBinding Background}" SnapsToDevicePixels="True" Height="26">
<Grid SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Icon"/>
<ColumnDefinition />
<!-- <ColumnDefinition Width="Auto" SharedSizeGroup="Shortcut"/>
<ColumnDefinition Width="13"/> -->
</Grid.ColumnDefinitions>
<Path Name="Icon" VerticalAlignment="Center" Stretch="Uniform" Margin="8,0" Fill="{TemplateBinding Foreground}" Height="12" Width="15" />
<TextBlock Name="HeaderHost" Grid.Column="1" Text="{TemplateBinding Header}" Foreground="{TemplateBinding Foreground}" Margin="0,0,40,0" VerticalAlignment="Center" Height="16" />
<!-- <TextBlock x:Name="InputGestureText" Grid.Column="2" Text="{TemplateBinding InputGestureText}" Margin="5,2,0,2" DockPanel.Dock="Right" /> -->
</Grid>
</Border>
<ControlTemplate.Triggers>
<Trigger Property="Icon" Value="{x:Null}">
<Setter TargetName="Icon" Property="Visibility" Value="Hidden"/>
</Trigger>
</ControlTemplate.Triggers>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
</ResourceDictionary>
</Application.Resources>
</Application>
Plain Craft Launcher 2/Application.xaml.vb
+238
View File
@@ -0,0 +1,238 @@
Imports System.Net
Imports System.Reflection
Imports System.Windows.Threading
Public Class Application
#If DEBUG Then
''' <summary>
''' 用于开始程序时的一些测试。
''' </summary>
Private Sub Test()
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", LogLevel.Feedback)
End Try
End Sub
#End If
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
ApplicationStartTick = GetTimeTick()
SecretOnApplicationStart()
Try
'检查参数调用
If e.Args.Length > 0 Then
If e.Args(0) = "--update" Then
'自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.[Exit](Result.Cancel)
Exit Sub
ElseIf e.Args(0) = "--link" Then
'稍作等待后切换到联机页面
Thread.Sleep(1000)
FormMain.IsLinkRestart = True
#If DEBUG Then
ElseIf e.Args(0) = "--make" Then
'制作更新包
UpdateMake(e.Args(1))
Environment.[Exit](Result.Cancel)
Exit Sub
#End If
End If
End If
'初始化文件结构
Directory.CreateDirectory(Path & "PCL\Pictures")
Directory.CreateDirectory(Path & "PCL\Musics")
Try
Directory.CreateDirectory(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception
MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetString(ex, False), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\"
End Try
Directory.CreateDirectory(PathTemp & "Cache")
Directory.CreateDirectory(PathTemp & "Download")
'检测单例
#If Not DEBUG Then
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2　")
If WindowHwnd <> IntPtr.Zero Then
'将已有的 PCL2 窗口拖出来
ShowWindowToTop(WindowHwnd)
'播放提示音并退出
Beep()
Environment.[Exit](Result.Cancel)
Exit Sub
End If
#End If
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
'动态 DLL 调用
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
'日志初始化
LogStart()
'添加日志
Log("[Start] 程序版本：" & VersionDisplayName & "（" & VersionCode & "）")
Log("[Start] 识别码：" & UniqueAddress & If(ThemeCheckOne(9), "，已解锁反馈主题", ""))
Log("[Start] 程序路径：" & PathWithName)
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL2 正在临时文件夹运行，设置、游戏存档等很可能无法保存，且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL2 从压缩文件中解压，或是更换文件夹后再继续使用！", "环境警告", "我知道了", IsWarn:=True)
End If
'设置初始化
Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
'网络配置初始化
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 1024
ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean
Return True
End Function)
'计时
Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick()
'执行测试
#If DEBUG Then
Test()
#End If
AniControlEnabled += 1
Catch ex As Exception
MsgBox(GetString(ex, False, True), MsgBoxStyle.Critical, "PCL2 初始化错误")
FormMain.EndProgramForce(Result.Exception)
End Try
End Sub
'结束
Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
FrmMain.EndProgram(False)
End Sub
'异常
Private IsCritErrored As Boolean = False
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
On Error Resume Next
e.Handled = True
If IsProgramEnded Then Exit Sub
If IsCritErrored Then
'在汇报错误后继续引发错误，知道这次压不住了
FormMain.EndProgramForce(Result.Exception)
Exit Sub
End If
IsCritErrored = True
Dim ExceptionString As String = GetString(e.Exception, False, True)
If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
ExceptionString.Contains(".Net Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then
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, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel)
Else
FeedbackInfo()
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
End If
End Sub
'动态 DLL 调用
Private Shared AssemblyStun As Assembly
Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly
Private Shared ReadOnly AssemblyStunLock As New Object
Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWith("NAudio") Then
SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL：NAudio")
AssemblyNAudio = Assembly.Load(GetResources("NAudio"))
End If
Return AssemblyNAudio
End SyncLock
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then
SyncLock AssemblyJsonLock
If AssemblyJson Is Nothing Then
Log("[Start] 加载 DLL：Json")
AssemblyJson = Assembly.Load(GetResources("Json"))
End If
Return AssemblyJson
End SyncLock
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then
SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL：Dialogs")
AssemblyDialog = Assembly.Load(GetResources("Dialogs"))
End If
Return AssemblyDialog
End SyncLock
ElseIf args.Name.StartsWith("STUN") Then
SyncLock AssemblyStunLock
If AssemblyStun Is Nothing Then
Log("[Start] 加载 DLL：STUN")
AssemblyStun = Assembly.Load(GetResources("STUN"))
End If
Return AssemblyStun
End SyncLock
Else
Return Nothing
End If
End Function
'切换窗口
'控件模板事件
Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
If Setup.Get("LoginType") = McLoginType.Legacy Then
'离线
Dim Names As New List(Of String)
Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨"))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
Else
'非离线
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
Dim Dict As New Dictionary(Of String, String)
Dim Names As New List(Of String)
Dim Passs As New List(Of String)
If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨"))
If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨"))
For i = 0 To Names.Count - 1
Dict.Add(Names(i), Passs(i))
Next
Dict.Remove(sender.Tag)
Setup.Set("Login" & Token & "Email", Join(Dict.Keys.ToArray, "¨"))
Setup.Set("Login" & Token & "Pass", Join(Dict.Values.ToArray, "¨"))
Select Case Token
Case "Mojang"
FrmLoginMojang.ComboName.ItemsSource = Dict.Keys
FrmLoginMojang.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginMojang.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
Case "Auth"
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
Case Else
DebugAssert(True)
Exit Sub
End Select
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/IMyRadio.vb
+4
View File
@@ -0,0 +1,4 @@
Public Interface IMyRadio
Event Check(sender As Object, e As RouteEventArgs)
Event Changed(sender As Object, e As RouteEventArgs)
End Interface
Plain Craft Launcher 2/Controls/MyButton.xaml
+16
View File
@@ -0,0 +1,16 @@
<Border x:Class="MyButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" x:Name="PanBack"
Focusable="True" UseLayoutRounding="False" SnapsToDevicePixels="False" Background="{StaticResource ColorBrushSemiTransparent}">
<Border CornerRadius="3" x:Name="PanFore" BorderThickness="1" BorderBrush="{DynamicResource ColorBrush1}" RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushHalfWhite}">
<Border.RenderTransform>
<ScaleTransform />
</Border.RenderTransform>
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" Text="Button" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock.RenderTransform>
<ScaleTransform />
</TextBlock.RenderTransform>
</TextBlock>
</Border>
</Border>
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
+196
View File
@@ -0,0 +1,196 @@
Public Class MyButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Public Property Text As String
Get
Return LabText.Text
End Get
Set(value As String)
LabText.Text = value
End Set
End Property '显示文本
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub)))
Public Property TextPadding As Thickness
Get
Return LabText.Padding
End Get
Set(value As Thickness)
LabText.Padding = value
End Set
End Property
Private _ColorType As ColorState = ColorState.Normal '配色方案
Public Property ColorType As ColorState
Get
Return _ColorType
End Get
Set(value As ColorState)
_ColorType = value
RefreshColor()
End Set
End Property
Public Enum ColorState
Normal = 0
Highlight = 1
Red = 2
End Enum
'属性穿透
Public Shared Shadows ReadOnly PaddingProperty As DependencyProperty = DependencyProperty.Register("Padding", GetType(Thickness), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As MyButton, e As DependencyPropertyChangedEventArgs) If sender IsNot Nothing Then sender.PanFore.Padding = e.NewValue)))
Public Overloads Property Padding As Thickness
Get
Return PanFore.Padding
End Get
Set(value As Thickness)
PanFore.Padding = value
End Set
End Property
Public Property RealRenderTransform As Transform
Get
Return PanFore.RenderTransform
End Get
Set(value As Transform)
PanFore.RenderTransform = value
End Set
End Property
'自定义事件
Private Const AnimationColorIn As Integer = 100
Private Const AnimationColorOut As Integer = 200
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If IsEnabled Then
Select Case ColorType
Case ColorState.Normal
If IsMouseOver Then
'指向（Main 3）
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush3", AnimationColorIn)}, "MyButton Color " & Uuid)
Else
'普通（Main 1）
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush1", AnimationColorOut)}, "MyButton Color " & Uuid)
End If
Case ColorState.Highlight
If IsMouseOver Then
'指向（Main 3）
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush3", AnimationColorIn)}, "MyButton Color " & Uuid)
Else
'高亮（Main 2）
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush2", AnimationColorOut)}, "MyButton Color " & Uuid)
End If
Case ColorState.Red
If IsMouseOver Then
'红色指向
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrushRedLight", AnimationColorIn)}, "MyButton Color " & Uuid)
Else
'红色
AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrushRedDark", AnimationColorOut)}, "MyButton Color " & Uuid)
End If
End Select
Else
'不可用（Gray 4）
AniStart({AaColor(PanFore, Border.BorderBrushProperty, ColorGray4 - PanFore.BorderBrush, AnimationColorOut)}, "MyButton Color " & Uuid)
End If
Else
AniStop("MyButton Color " & Uuid)
If IsEnabled Then
Select Case ColorType
Case ColorState.Normal
If IsMouseOver Then
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush3")
Else
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush1")
End If
Case ColorState.Highlight
If IsMouseOver Then
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush3")
Else
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush2")
End If
Case ColorState.Red
If IsMouseOver Then
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrushRedLight")
Else
PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrushRedDark")
End If
End Select
Else
PanFore.BorderBrush = ColorGray4
End If
End If
Catch ex As Exception
Log(ex, "刷新按钮颜色出错")
End Try
End Sub
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下按钮：" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
Hint("主页自定义按钮语法已更新，且不再兼容老版本语法，请查看新的自定义示例！")
End If
End If
ModEvent.TryStartEvent(EventType, EventData)
End If
End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing))
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
Focus()
AniStart({
AaScaleTransform(PanFore, 0.955 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 80,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaScaleTransform(PanFore, -0.01, 700,, New AniEaseOutFluent(AniEasePower.Middle))
}, "MyButton Scale " & Uuid)
End Sub
Private Sub Button_MouseEnter() Handles Me.MouseEnter
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush9"), AnimationColorIn), "MyButton Background " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
IsMouseDown = False
AniStart({
AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle))
}, "MyButton Scale " & Uuid)
End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave
AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid)
If Not IsMouseDown Then Exit Sub
IsMouseDown = False
AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid)
End Sub
End Class
Plain Craft Launcher 2/Controls/MyCard.vb
+300
View File
@@ -0,0 +1,300 @@
Public Class MyCard
'控件
Inherits Grid
Private ReadOnly MainGrid As Grid
Private ReadOnly MainChrome As SystemDropShadowChrome
Private ReadOnly MainBorder As Border
Public MainTextBlock As TextBlock
Public MainSwap As Shapes.Path
'属性
Public Uuid As Integer = GetUuid()
Public Property Title As String
Get
Return GetValue(TitleProperty)
End Get
Set(value As String)
SetValue(TitleProperty, value)
If MainTextBlock IsNot Nothing Then MainTextBlock.Text = value
End Set
End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata(""))
'UI 建立
Public Sub New()
MainChrome = New SystemDropShadowChrome With {.Margin = New Thickness(-9.5, -9, 0.5, -0.5), .Opacity = 0.1, .CornerRadius = New CornerRadius(6)}
MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1")
Children.Add(MainChrome)
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
Children.Add(MainBorder)
MainGrid = New Grid
Children.Add(MainGrid)
End Sub
Private IsLoad As Boolean = False
Private Sub MyCard_Loaded() Handles Me.Loaded
'卡片的进入时动画已被页面通用切换动画替代
'If LoadAnimation AndAlso IsLoad Then
' StartHeightAnimation(Math.Min(50, ActualHeight), ActualHeight - Math.Min(50, ActualHeight), True)
'End If
If IsLoad Then Exit Sub
'初次加载限定
If Not Title = "" AndAlso IsNothing(MainTextBlock) Then
MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
MainGrid.Children.Add(MainTextBlock)
End If
If CanSwap OrElse SwapControl IsNot Nothing Then
If SwapControl Is Nothing AndAlso Children.Count > 3 Then SwapControl = Children(3)
MainSwap = New Shapes.Path With {.HorizontalAlignment = HorizontalAlignment.Right, .Stretch = Stretch.Uniform, .Height = 6, .Width = 10, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(0, 17, 16, 0), .Data = New GeometryConverter().ConvertFromString("M2,4 l-2,2 10,10 10,-10 -2,-2 -8,8 -8,-8 z"), .RenderTransform = New RotateTransform(180), .RenderTransformOrigin = New Point(0.5, 0.5)}
MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1")
MainGrid.Children.Add(MainSwap)
End If
IsLoad = True
'改变默认的折叠
If IsSwaped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
'取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation
UseAnimation = False
Height = SwapedHeight
AniStop("MyCard Height " & Uuid)
IsHeightAnimating = False
RunInUi(Sub() UseAnimation = RawUseAnimation, True)
End If
End Sub
Public Sub StackInstall()
StackInstall(SwapControl, SwapType, Title)
TriggerForceResize()
End Sub
Public Shared Sub StackInstall(ByRef Stack As StackPanel, Type As Integer, Optional CardTitle As String = "")
'这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Exit Sub
'排序
Select Case Type
Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(Left As DlLiteLoaderListEntry, Right As DlLiteLoaderListEntry) As Boolean
Return VersionSortBoolean(Left.Inherit, Right.Inherit)
End Function)
Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean
Return VersionSortBoolean(Left.Version, Right.Version)
End Function)
Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlCfFile)), Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
End Function)
End Select
'控件转换
Select Case Type
Case 5
Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
LoadingPickaxe.State = Loader
Loader.Start(Stack.Tag)
AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
Stack.Children.Add(LoadingPickaxe)
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
DlCfFilesPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick)
End Select
'实现控件虚拟化
For Each Data As Object In Stack.Tag
Select Case Type
Case 0
Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
Case 1
Stack.Children.Add(PageOtherFeedback.FeedbackListItem(Data, CardTitle))
Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3
Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
Case 4
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
Case 5
Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7
Stack.Children.Add(McDownloadListItem(Data, AddressOf FrmDownloadInstall.MinecraftSelected, False))
Case 8
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click))
Case 9
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Install_Click, AddressOf FrmDownloadCfDetail.Save_Click))
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
Case Else
Log("未知的虚拟化种类：" & Type, LogLevel.Feedback)
End Select
Next
Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠
Stack.Tag = Nothing
End Sub
'事件
Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
'高度改变动画
Public Property UseAnimation As Boolean = True
Private IsHeightAnimating As Boolean = False
Private ActualUsedHeight As Double '回滚实际高度（例如 NaN）
Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not UseAnimation Then Exit Sub
Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
'卡片的进入时动画已被页面通用切换动画替代
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Exit Sub
StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
End Sub
Private Sub StartHeightAnimation(DeltaHeight As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片，高度减小时的弹跳会吞掉按钮下边框
'高度增加较大，使用弹起动画
Dim Delta As Double = MathRange(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
AnimList.AddRange({
AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
})
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathRange(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
End If
AnimList.Add(AaCode(Sub()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True
ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
Height = PreviousHeight
End Sub
''' <summary>
''' 通知 MyCard，控件内容已改变，需要中断动画并更新高度。
''' </summary>
Public Sub TriggerForceResize()
Height = If(IsSwaped, SwapedHeight, Double.NaN)
AniStop("MyCard Height " & Uuid)
IsHeightAnimating = False
End Sub
'折叠
'若设置了 CanSwap，或 SwapControl 不为空，则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object
Public Property CanSwap As Boolean = False
''' <summary>
''' 被折叠的种类，用于控件虚拟化。
''' </summary>
Public Property SwapType As Integer
''' <summary>
''' 是否已被折叠。
''' </summary>
Public Property IsSwaped As Boolean
Get
Return _IsSwaped
End Get
Set(ByVal value As Boolean)
If _IsSwaped = value Then Exit Property
_IsSwaped = value
If SwapControl Is Nothing Then Exit Property
'展开
If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
'若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
If Not IsLoaded Then Exit Property
'更新高度
SwapControl.Visibility = Visibility.Visible
TriggerForceResize()
'改变箭头
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "MyCard Swap " & Uuid, True)
End Set
End Property
Private _IsSwaped As Boolean = False
Public Property SwapLogoRight As Boolean = False
Private IsMouseDown As Boolean = False
Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
Public Event Swap(sender As Object, e As RouteEventArgs)
Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
IsMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
If ee.Handled Then
IsMouseDown = False
Exit Sub
End If
IsSwaped = Not IsSwaped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title))
RaiseEvent Swap(Me, ee)
End If
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsMouseDown = False
End Sub
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
End Sub
End Module
Plain Craft Launcher 2/Controls/MyCheckBox.xaml
+14
View File
@@ -0,0 +1,14 @@
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
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">
<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}" />
<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>
<ScaleTransform CenterX="6" CenterY="6" ScaleX="0" ScaleY="0" />
</Path.RenderTransform>
</Path>
</Grid>
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
+202
View File
@@ -0,0 +1,202 @@
Public Class MyCheckBox
'基础
Public Uuid As Integer = GetUuid()
''' <summary>
''' 复选框勾选状态改变。
''' </summary>
''' <param name="user">是否为用户手动改变的勾选状态。</param>
Public Event Change(sender As Object, user As Boolean)
Public Event PreviewChange(sender As Object, e As RouteEventArgs)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序引发本控件的 Change 事件
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
End Set
End Property
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try
If value = _Checked Then Exit Sub
'Preview 事件
If value AndAlso user Then
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewChange(Me, e)
If e.Handled Then
MouseDowned = True
Checkbox_MouseLeave()
MouseDowned = False
Exit Sub
End If
End If
_Checked = value
If IsLoaded Then RaiseEvent Change(Me, user)
'更改动画
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Sub
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckbox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckbox).LabText.Text = e.NewValue
End Sub)))
'点击事件
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text)
MouseDowned = False
SetChecked(Not Checked, True, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
If Not AllowMouseDown Then Exit Sub
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrush9", 100), "MyCheckBox Background " & Uuid)
If Checked Then
AniStart({
AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),
AaScaleTransform(ShapeCheck, 0.9 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, 1000, , New AniEaseOutFluent(AniEasePower.Strong))
}, "MyCheckBox Scale " & Uuid)
Else
AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyCheckBox Scale " & Uuid)
End If
End Sub
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
MouseDowned = False
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
If Checked Then
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, 500, , New AniEaseOutFluent(AniEasePower.Strong))
}, "MyCheckBox Scale " & Uuid)
Else
AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyCheckBox Scale " & Uuid)
End If
End Sub
'指向动画
Private Const AnimationTimeOfMouseIn As Integer = 100
Private Const AnimationTimeOfMouseOut As Integer = 200
Private Sub Checkbox_IsEnabledChanged() Handles Me.IsEnabledChanged
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
If IsEnabled Then
'可用
Checkbox_MouseLeaveAnimation()
Else
'不可用
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid)
End If
Else
'无动画
AniStop("MyCheckBox TextColor " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
End If
End Sub
Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter
AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyCheckBox TextColor " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyCheckBox BorderColor " & Uuid)
End Sub
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行，所以如果自定义事件修改了 IsEnabled，将导致显示错误
AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid)
End Sub
End Class
Plain Craft Launcher 2/Controls/MyComboBox.vb
+135
View File
@@ -0,0 +1,135 @@
Public Class MyComboBox
Inherits ComboBox
Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
'基础
Public Uuid As Integer = GetUuid()
Private TextBox As MyTextBox
Public Property HintText As String = ""
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If Not IsEditable Then Exit Sub
Try
TextBox = Template.FindName("PART_EditableTextBox", Me)
TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor))
TextBox.ChangedEventList.Add(New RoutedEventHandler(Sub(sender, e) RaiseEvent TextChanged(sender, e)))
TextBox.Tag = Tag '有时需要用文本框的 Tag 来写入设置
If Text = "" Then
TextBox.Text = _Text
Else
RaiseEvent TextChanged(Me, Nothing)
End If
If HintText.Length > 0 Then TextBox.HintText = HintText
Catch ex As Exception
Log(ex, "初始化可编辑文本框失败（" & If(Name, "") & "）", LogLevel.Feedback)
End Try
End Sub
Private _Text As String = SelectedItem
Public Shadows Property Text As String
Get
If IsEditable Then
If TextBox Is Nothing Then
Return If(_Text, "")
Else
Return If(TextBox.Text, "")
End If
Else
Return If(SelectedItem, "").ToString
End If
End Get
Set(value As String)
If IsEditable Then
If IsNothing(TextBox) Then
_Text = value
Else
TextBox.Text = value
End If
Else
Throw New NotSupportedException("该 ComboBox 不支持修改文本。")
End If
End Set
End Property
'鼠标按下接口
Private IsMouseDown As Boolean = False
Private Sub MyComboBox_PreviewMouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
IsMouseDown = True
End Sub
Private Sub MyComboBox_PreviewMouseLeftButtonUp(sender As Object, e As EventArgs) Handles Me.PreviewMouseLeftButtonUp, Me.MouseLeave
IsMouseDown = False
End Sub
'指向动画
Public Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp, Me.GotKeyboardFocus
'判断当前颜色
Dim ColorName As String
Dim BackName As String
Dim Time As Integer
If IsEnabled Then
If IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused Then
ColorName = "ColorBrush4"
BackName = "ColorBrush9"
Time = 60
ElseIf IsMouseDown OrElse IsDropDownOpen Then
ColorName = "ColorBrush3"
BackName = "ColorBrush9"
Time = 60
ElseIf IsMouseOver Then
ColorName = "ColorBrush3"
BackName = "ColorBrushHalfWhite"
Time = 100
Else
ColorName = "ColorBrush1"
BackName = "ColorBrushHalfWhite"
Time = 200
End If
Else
ColorName = "ColorBrushGray4"
BackName = "ColorBrushHalfWhite"
Time = 200
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, ForegroundProperty, ColorName, Time),
AaColor(Me, BackgroundProperty, BackName, Time)
}, "MyComboBox Color " & Uuid)
Else
'无动画
AniStop("MyComboBox Color " & Uuid)
SetResourceReference(ForegroundProperty, ColorName)
SetResourceReference(BackgroundProperty, BackName)
End If
End Sub
Private RealWidth As Double '由于下拉框 Popup 宽度与 Width 一致，故不能为 NaN（Auto）
Private Sub MyComboBox_DropDownOpened(sender As Object, e As EventArgs) Handles Me.DropDownOpened
RealWidth = Width
Width = ActualWidth
Try
CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity
Catch ex As Exception
Log(ex, "设置下拉框透明度失败", LogLevel.Feedback)
End Try
End Sub
Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
Width = RealWidth
End Sub
'修复 WPF Bug：下拉框文本修改后，依然误认为还选择着此前的选项，导致再次点击该选项时内容不变
Private IsTextChanging As Boolean = False
Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
If IsTextChanging OrElse Not IsEditable Then Exit Sub
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
IsTextChanging = True
SelectedItem = Nothing
Text = RawText
TextBox.SelectionStart = RawSelectionStart
IsTextChanging = False
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MyComboBoxItem.vb
+67
View File
@@ -0,0 +1,67 @@
Public Class MyComboBoxItem
Inherits ComboBoxItem
'基础
Public Uuid As Integer = GetUuid()
Public Sub New()
Style = FindResource("MyComboBoxItem")
End Sub
'指向动画
Private Const AnimationTimeIn As Integer = 100
Private Const AnimationTimeOut As Integer = 300
Private BackColorName As String, FontOpacity As Double
Private Sub RefreshColor() Handles Me.Unselected, Me.MouseMove, Me.MouseLeave, Me.Selected, Me.IsEnabledChanged
'判断当前颜色
Dim NewBackColorName As String, NewFontOpacity As Double
Dim Time As Integer
If IsSelected Then
NewBackColorName = "ColorBrush6"
NewFontOpacity = 1
Time = AnimationTimeIn
ElseIf IsMouseOver Then
NewBackColorName = "ColorBrush8"
NewFontOpacity = 1
Time = AnimationTimeIn
ElseIf IsEnabled Then
NewBackColorName = "ColorBrushTransparent"
NewFontOpacity = 1
Time = AnimationTimeOut
Else
NewBackColorName = "ColorBrushTransparent"
NewFontOpacity = 0.4
Time = AnimationTimeOut
End If
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub
BackColorName = NewBackColorName
FontOpacity = NewFontOpacity
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, BackgroundProperty, BackColorName, Time),
AaOpacity(Me, FontOpacity - Opacity, Time)
}, "ComboBoxItem Color " & Uuid)
Else
'无动画
AniStop("ComboBoxItem Color " & Uuid)
SetResourceReference(BackgroundProperty, BackColorName)
Opacity = FontOpacity
End If
End Sub
Public Overrides Function Tostring() As String
Return Content.ToString
End Function
Public Shared Widening Operator CType(Value As MyComboBoxItem) As String
Return Value.Content.ToString
End Operator
Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
Log("[Control] 选择下拉列表项：" & Tostring())
End Sub
End Class
Plain Craft Launcher 2/Controls/MyExtraButton.xaml
+25
View File
@@ -0,0 +1,25 @@
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraButton"
Width="40" RenderTransformOrigin="0.5,0.5" ToolTipService.ShowDuration="2333333" ToolTipService.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="0">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
<Border x:Name="PanClick" CornerRadius="1000" BorderThickness="0.001" Background="{StaticResource ColorBrushSemiTransparent}"/>
<Grid x:Name="PanScale" IsHitTestVisible="False" RenderTransformOrigin="0.5,0.5" Margin="0,10,0,0">
<Grid.RenderTransform>
<ScaleTransform />
</Grid.RenderTransform>
<Border x:Name="PanColor" CornerRadius="1000" BorderThickness="0.001" Background="{DynamicResource ColorBrush3}">
<Border.Effect>
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<Path x:Name="Path" Stretch="Uniform" Margin="12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<ScaleTransform />
</Path.RenderTransform>
</Path>
</Grid>
</Grid>
Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb
+191
View File
@@ -0,0 +1,191 @@
Public Class MyExtraButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
Public Event RightClick(sender As Object, e As MouseButtonEventArgs)
'自定义属性
Public Uuid As Integer = GetUuid()
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(Path) Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
Private _Show As Boolean = False
Public Property Show As Boolean
Get
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
_Show = value
RunInUi(Sub()
If value Then
'有了
Visibility = Visibility.Visible
AniStart({
AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)),
AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)),
AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyExtraButton MainScale " & Uuid)
Else
'没了
AniStart({
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)),
AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()),
AaCode(Sub() Visibility = Visibility.Collapsed,, True)
}, "MyExtraButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
End Set
End Property
Public Delegate Function ShowCheckDelegate() As Boolean
Public ShowCheck As ShowCheckDelegate = Nothing
Public Sub ShowRefresh()
If ShowCheck IsNot Nothing Then Show = ShowCheck()
End Sub
'触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then
Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
End If
End Sub
Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp
If IsRightMouseHeld Then
Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
RaiseEvent RightClick(sender, e)
e.Handled = True
Button_RightMouseUp()
End If
End Sub
Private _CanRightClick As Boolean = False
Public Property CanRightClick As Boolean
Get
Return _CanRightClick
End Get
Set(ByVal value As Boolean)
_CanRightClick = value
End Set
End Property
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
Private IsLeftMouseHeld As Boolean = False
Private IsRightMouseHeld As Boolean = False
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
End If
IsLeftMouseHeld = True
Focus()
End Sub
Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
If Not CanRightClick Then Exit Sub
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
End If
IsRightMouseHeld = True
Focus()
End Sub
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
If Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
End If
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not CanRightClick Then Exit Sub
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
End If
IsRightMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles PanClick.MouseLeave
IsLeftMouseHeld = False
IsRightMouseHeld = False
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If IsMouseOver Then
'指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid)
Else
'普通
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush3", AnimationColorOut), "MyExtraButton Color " & Uuid)
End If
Else
AniStop("MyExtraButton Color " & Uuid)
If IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush2")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
End If
Catch ex As Exception
Log(ex, "刷新图标按钮颜色出错")
End Try
End Sub
''' <summary>
''' 发出一圈波浪效果提示。
''' </summary>
Public Sub Ribble()
RunInUi(Sub()
Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
PanScale.Children.Insert(0, Shape)
AniStart({
AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)),
AaOpacity(Shape, -Shape.Opacity, 1000),
AaCode(Sub() PanScale.Children.Remove(Shape), After:=True)
}, "ExtraButton Ribble " & GetUuid())
End Sub)
End Sub
End Class
Plain Craft Launcher 2/Controls/MyHint.xaml
+24
View File
@@ -0,0 +1,24 @@
<Border x:Class="MyHint" x:Name="PanBack"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
FocusVisualStyle="{x:Null}"
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="1" BorderBrush="#99FF4444" CornerRadius="3">
<Border.Background>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop x:Name="Gradient1" Color="#88FFBBBB" Offset="0.3"/>
<GradientStop x:Name="Gradient2" Color="#88FF8888" Offset="0.9"/>
</LinearGradientBrush>
</Border.Background>
<Grid UseLayoutRounding="False" SnapsToDevicePixels="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" Text="提示文本" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid>
</Border>
Plain Craft Launcher 2/Controls/MyHint.xaml.vb
+82
View File
@@ -0,0 +1,82 @@
Public Class MyHint
Public Uuid As Integer = GetUuid()
Private _IsWarn As Boolean = True
Public Property IsWarn As Boolean
Get
Return _IsWarn
End Get
Set(value As Boolean)
If _IsWarn = value Then Exit Property
_IsWarn = value
If _IsWarn Then
BorderBrush = New MyColor("#99FF4444")
Gradient1.Color = New MyColor("#88FFBBBB")
Gradient2.Color = New MyColor("#88FF8888")
Path.Fill = New MyColor("#BF0000")
LabText.Foreground = New MyColor("#BF0000")
BtnClose.Foreground = New MyColor("#BF0000")
Path.Data = (New GeometryConverter).ConvertFromString("F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z ")
Else
BorderBrush = New MyColor("#994D76FF")
Gradient1.Color = New MyColor("#88B0D0FF")
Gradient2.Color = New MyColor("#889EBAFF")
Path.Fill = New MyColor("#0062BF")
LabText.Foreground = New MyColor("#0062BF")
BtnClose.Foreground = New MyColor("#0062BF")
Path.Data = (New GeometryConverter).ConvertFromString("F1M38,19C48.4934,19 57,27.5066 57,38 57,48.4934 48.4934,57 38,57 27.5066,57 19,48.4934 19,38 19,27.5066 27.5066,19 38,19z M33.25,33.25L33.25,36.4167 36.4166,36.4167 36.4166,47.5 33.25,47.5 33.25,50.6667 44.3333,50.6667 44.3333,47.5 41.1666,47.5 41.1666,36.4167 41.1666,33.25 33.25,33.25z M38.7917,25.3333C37.48,25.3333 36.4167,26.3967 36.4167,27.7083 36.4167,29.02 37.48,30.0833 38.7917,30.0833 40.1033,30.0833 41.1667,29.02 41.1667,27.7083 41.1667,26.3967 40.1033,25.3333 38.7917,25.3333z")
End If
End Set
End Property
Public Property Text As String
Get
Return LabText.Text
End Get
Set(ByVal value As String)
LabText.Text = value
End Set
End Property
Public Property CanClose As Boolean
Get
Return BtnClose.Visibility = Visibility.Visible
End Get
Set(ByVal value As Boolean)
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then
Visibility = Visibility.Collapsed
End If
End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True)
AniDispose(Me, False)
End Sub
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
End Sub
End Module
Plain Craft Launcher 2/Controls/MyIconButton.xaml
+15
View File
@@ -0,0 +1,15 @@
<Border x:Class="MyIconButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
CornerRadius="1000" Background="{StaticResource ColorBrushSemiTransparent}" BorderThickness="0.001">
<Border x:Name="PanBack" CornerRadius="1000" RenderTransformOrigin="0.5,0.5" BorderThickness="0.001" IsHitTestVisible="False">
<Path x:Name="Path" Stretch="Uniform" Margin="5" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<ScaleTransform />
</Path.RenderTransform>
</Path>
<Border.RenderTransform>
<ScaleTransform />
</Border.RenderTransform>
</Border>
</Border>
Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
+168
View File
@@ -0,0 +1,168 @@
Public Class MyIconButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Public Property Logo As String
Get
Return Path.Data.ToString
End Get
Set(value As String)
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(Path) Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
Public Enum Themes
Color
White
Black
Custom
End Enum
Public Property Theme As Themes = Themes.Color
Private _Foreground As New SolidColorBrush(Color.FromRgb(128, 128, 128))
Public Property Foreground As SolidColorBrush
Get
Return _Foreground
End Get
Set(value As SolidColorBrush)
_Foreground = value
AniControlEnabled += 1
RefreshAnim()
AniControlEnabled -= 1
End Set
End Property
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
End If
End Sub
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True
Focus()
'指向
AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If IsMouseDown Then
IsMouseDown = False
AniStart({
AaScaleTransform(PanBack, 1.05 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutBack(AniEasePower.Weak)),
AaScaleTransform(PanBack, -0.05, 250,, New AniEaseOutFluent(AniEasePower.Strong))
}, "MyIconButton Scale " & Uuid)
End If
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
AniStart({
AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent)
}, "MyIconButton Scale " & Uuid)
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn))
Case Themes.White
AnimList.Add(AaColor(PanBack, BackgroundProperty, New MyColor(50, 255, 255, 255) - PanBack.Background, AnimationColorIn))
Case Themes.Black
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(230, 0, 0, 0) - Path.Fill, AnimationColorIn))
Case Themes.Custom
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn))
End Select
AniStart(AnimList, "MyIconButton Color " & Uuid)
Else
'普通
Dim AnimList As New List(Of AniData)
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
Case Themes.White
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush8", AnimationColorOut))
AnimList.Add(AaColor(PanBack, BackgroundProperty, New MyColor(0, 255, 255, 255) - PanBack.Background, AnimationColorOut))
Case Themes.Black
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, 0, 0, 0) - Path.Fill, AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
Case Themes.Custom
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
End Select
AniStart(AnimList, "MyIconButton Color " & Uuid)
End If
Else
AniStop("MyIconButton Color " & Uuid)
Select Case Theme
Case Themes.Color
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
Case Themes.White
Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
PanBack.Background = New MyColor(0, 255, 255, 255)
End If
Catch ex As Exception
Log(ex, "刷新图标按钮动画状态出错")
End Try
End Sub
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyIconButton, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent),
AaCode(Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyIconButton Dispose " & Control.Uuid)
End Sub
End Module
Plain Craft Launcher 2/Controls/MyListItem.xaml
+27
View File
@@ -0,0 +1,27 @@
<Grid x:Class="MyListItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" Height="42">
<Grid.RenderTransform>
<ScaleTransform ScaleX="1" ScaleY="1" />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition x:Name="ColumnCheck" Width="2"/>
<ColumnDefinition x:Name="ColumnPaddingLeft" Width="0" />
<ColumnDefinition x:Name="ColumnLogo" Width="4" />
<ColumnDefinition Width="1*"/>
<ColumnDefinition x:Name="ColumnPaddingRight" Width="0" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!--<Border x:Name="RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True" IsHitTestVisible="False" Opacity="0" Grid.ColumnSpan="4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}" BorderThickness="1" />-->
<!--<StackPanel VerticalAlignment="Center">-->
<TextBlock Grid.Row="1" SnapsToDevicePixels="False" UseLayoutRounding="False" HorizontalAlignment="Left" x:Name="LabTitle" IsHitTestVisible="False" Grid.Column="3" Text="{Binding Title, ElementName=PanBack}" TextTrimming="CharacterEllipsis" FontSize="{Binding FontSize, ElementName=PanBack}" Foreground="{Binding Foreground, ElementName=PanBack}" Margin="4,0,0,0" />
<!--<TextBlock Grid.Row="2" SnapsToDevicePixels="False" UseLayoutRounding="False" HorizontalAlignment="Left" x:Name="LabInfo" IsHitTestVisible="False" Grid.Column="2" TextTrimming="CharacterEllipsis" Visibility="Collapsed" FontSize="12" Foreground="{StaticResource ColorBrushGray2}" Margin="4,0,0,0" />-->
<!--</StackPanel>-->
</Grid>
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+668
View File
@@ -0,0 +1,668 @@
Public Class MyListItem
Implements IMyRadio
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Public Event LogoClick(sender As Object, e As MouseButtonEventArgs)
Public Event Check(sender As Object, e As RouteEventArgs) Implements IMyRadio.Check
Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed
#Region "后加载控件"
'指向背景
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled, 6, 0)),
.RenderTransform = If(IsScaleAnimationEnabled, New ScaleTransform(0.8, 0.8), Nothing),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
'按钮
Public ButtonStack As FrameworkElement
'图标
Public PathLogo As FrameworkElement
'勾选条
Public RectCheck As Border
'副文本
Private _LabInfo As TextBlock = Nothing
Public ReadOnly Property LabInfo As TextBlock
Get
If _LabInfo Is Nothing Then
Dim Lab As New TextBlock With {
.Name = "LabInfo",
.SnapsToDevicePixels = False,
.UseLayoutRounding = False,
.HorizontalAlignment = HorizontalAlignment.Left,
.IsHitTestVisible = False,
.TextTrimming = TextTrimming.CharacterEllipsis,
.Visibility = Visibility.Collapsed,
.FontSize = 12,
.Margin = New Thickness(4, 0, 0, 0),
.Opacity = 0.6
}
SetColumn(Lab, 3)
SetRow(Lab, 2)
Children.Add(Lab)
_LabInfo = Lab
'<TextBlock Grid.Row="2" SnapsToDevicePixels="False" UseLayoutRounding="False" HorizontalAlignment="Left" x:Name = "LabInfo" IsHitTestVisible="False" Grid.Column="2"
'TextTrimming = "CharacterEllipsis" Visibility="Collapsed" FontSize="12" Foreground="{StaticResource ColorBrushGray2}" Margin="4,0,0,0" />
End If
Return _LabInfo
End Get
End Property
#End Region
#Region "自定义属性"
'Uuid
Public Uuid As Integer = GetUuid()
''' <summary>
''' 是否启用缩放动画。
''' </summary>
Public Property IsScaleAnimationEnabled As Boolean
Get
Return _IsScaleAnimationEnabled
End Get
Set
_IsScaleAnimationEnabled = Value
If _RectBack IsNot Nothing Then RectBack.CornerRadius = New CornerRadius(If(Value, 6, 0))
End Set
End Property
Private _IsScaleAnimationEnabled As Boolean = True
'边距
Public Property PaddingLeft As Integer
Get
Return ColumnPaddingLeft.Width.Value
End Get
Set(value As Integer)
ColumnPaddingLeft.Width = New GridLength(value)
End Set
End Property
Public Property PaddingRight As Integer
Get
Return ColumnPaddingRight.Width.Value
End Get
Set(value As Integer)
ColumnPaddingRight.Width = New GridLength(value)
End Set
End Property
'按钮
Private _Buttons As IEnumerable
Public Property Buttons As IEnumerable
Get
Return _Buttons
End Get
Set(value As IEnumerable)
_Buttons = value
'没有特殊按钮，移除原 Stack
If Not IsNothing(ButtonStack) Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
'获取按钮数量
Dim Count As Integer = 0
For Each Counter In value
Count += 1
Next
'添加新 Stack
Select Case Count
Case 0
'没有按钮，不添加新的
Case 1
'只有一个按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
With Btn
.Opacity = 0
.Margin = New Thickness(0, 0, 5, 0)
.SnapsToDevicePixels = False
.HorizontalAlignment = HorizontalAlignment.Right
.VerticalAlignment = VerticalAlignment.Center
.SnapsToDevicePixels = False
.UseLayoutRounding = False
End With
SetColumn(Btn, 4)
SetColumnSpan(Btn, 4)
SetRowSpan(Btn, 4)
Children.Add(Btn)
ButtonStack = Btn
Next
Case Else
'有复数按钮，使用 StackPanel
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumn(ButtonStack, 4)
SetColumnSpan(ButtonStack, 4)
SetRowSpan(ButtonStack, 4)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
End Select
End Set
End Property
'标题
Public Property Title As String
Get
Return GetValue(TitleProperty)
End Get
Set(value As String)
SetValue(TitleProperty, value)
End Set
End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
'字号
Public Property FontSize As Double
Get
Return GetValue(FontSizeProperty)
End Get
Set(value As Double)
SetValue(FontSizeProperty, value)
End Set
End Property
Public Shared ReadOnly FontSizeProperty As DependencyProperty = DependencyProperty.Register("FontSize", GetType(Double), GetType(MyListItem), New PropertyMetadata(CType(14, Double)))
'信息
Private _Info As String = ""
Public Property Info As String
Get
Return _Info
End Get
Set(value As String)
If _Info = value Then Exit Property
value = value.Replace(vbCr, "").Replace(vbLf, "")
_Info = value
LabInfo.Text = value
LabInfo.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'图片
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If _Logo = value Then Exit Property
_Logo = value
'删除旧 Logo
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
'添加新 Logo
If Not _Logo = "" Then
If _Logo.ToLower.StartsWith("http") Then
'网络图片
PathLogo = New Image With {
.IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.ToLower.EndsWith(".png") Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
.IsHitTestVisible = LogoClickable,
.Background = Bitmap,
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then
' '使用最适合 16x16 物品图片显示的大小
' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor)
' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center
' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width
'Else
PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality)
'End If
Else
'矢量图
PathLogo = New Shapes.Path With {
.IsHitTestVisible = LogoClickable, .HorizontalAlignment = HorizontalAlignment.Center, .VerticalAlignment = VerticalAlignment.Center, .Stretch = Stretch.Uniform,
.Data = (New GeometryConverter).ConvertFromString(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = False, .UseLayoutRounding = False}
PathLogo.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = Me})
End If
SetColumn(PathLogo, 2)
SetRowSpan(PathLogo, 4)
OnSizeChanged() '设置边距
Children.Add(PathLogo)
'图标的点击事件
If LogoClickable Then
AddHandler PathLogo.MouseLeave, Sub(sender, e) IsLogoDown = False
AddHandler PathLogo.MouseLeftButtonDown, Sub(sender, e) IsLogoDown = True
AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender, e)
End If
End If
'改变行距
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(PathLogo) Then PathLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
'图标的点击
Public Property LogoClickable As Boolean = False
Private IsLogoDown As Boolean = False
'勾选选项
Public Enum CheckType
None
Clickable
RadioBox
CheckBox
End Enum
Private _Type As CheckType = CheckType.None
Public Property Type As CheckType
Get
Return _Type
End Get
Set(value As CheckType)
If _Type = value Then Exit Property
_Type = value
'切换左栏大小
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
'切换竖条控件
If _Type = CheckType.None OrElse _Type = CheckType.Clickable Then
'移除竖条控件
If Not IsNothing(RectCheck) Then
Children.Remove(RectCheck)
RectCheck = Nothing
End If
SetChecked(False, False, False)
Else
'添加竖条控件
If IsNothing(RectCheck) Then
RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center), .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))}
RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(RectCheck, 4)
Children.Add(RectCheck)
End If
End If
End Set
End Property
'适应尺寸
Private Sub OnSizeChanged() Handles Me.SizeChanged
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWith(".png") Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
End If
End If
LabTitle.Margin = New Thickness(4, 0, 0, If(Height < 40, 0, 2))
End Sub
'勾选状态
Private _Checked As Boolean = False
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
End Set
End Property
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try
'自定义属性基础
Dim ChangedEventArgs As New RouteEventArgs(user)
Dim RawValue = _Checked
If Type = CheckType.RadioBox Then
If IsInitialized AndAlso Not value = _Checked Then
_Checked = value
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
End If
End If
_Checked = value
Else
If value = _Checked Then Exit Sub
_Checked = value
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
End If
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(user)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Sub
End If
'保证只有一个单选 ListItem 选中
If Type = CheckType.RadioBox Then
If IsNothing(Parent) Then Exit Sub
Dim RadioboxList As New List(Of MyListItem)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children
If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
End If
Next
'判断选中情况
Select Case CheckedCount
Case 0
'没有任何单选框被选中，选择第一个
RadioboxList(0).Checked = True
Case Is > 1
'选中项目多于 1 个
If Me.Checked Then
'如果本控件选中，则取消其他所有控件的选中
For Each Control As MyListItem In RadioboxList
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
Next
Else
'如果本控件未选中，则只保留第一个选中的控件
Dim FirstChecked = False
For Each Control As MyListItem In RadioboxList
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
End If
Next
End If
End Select
End If
'更改动画
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
Dim Anim As New List(Of AniData)
If Checked Then
'由无变有
If Not IsNothing(RectCheck) Then
Dim Delta = ActualHeight - RectCheck.ActualHeight - 12
Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak)))
Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-1, 0, 0, 0)
End If
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush3", 200))
Else
'由有变无
If Not IsNothing(RectCheck) Then
'Anim.Add(AaWidth(RectCheck, -RectCheck.Width, 120,, New AniEaseInFluent))
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
End If
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush1", 120))
End If
AniStart(Anim, "MyListItem Checked " & Uuid)
Else
'不使用动画
If Checked Then
'If Not IsNothing(RectCheck) Then RectCheck.Width = 4
If Not IsNothing(RectCheck) Then
RectCheck.Height = Double.NaN
RectCheck.Margin = New Thickness(-1, 6, 0, 6)
RectCheck.Opacity = 1
RectCheck.VerticalAlignment = VerticalAlignment.Stretch
End If
SetResourceReference(ForegroundProperty, "ColorBrush3")
Else
'If Not IsNothing(RectCheck) Then RectCheck.Width = 0
If Not IsNothing(RectCheck) Then
RectCheck.Height = 0
RectCheck.Margin = New Thickness(-1, 0, 0, 0)
RectCheck.Opacity = 0
RectCheck.VerticalAlignment = VerticalAlignment.Center
End If
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Sub
'前景色绑定
Public Property Foreground As Brush
Get
Return GetValue(ForegroundProperty)
End Get
Set(value As Brush)
SetValue(ForegroundProperty, value)
End Set
End Property
Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(Brush), GetType(MyListItem), New PropertyMetadata(CType(Color1, SolidColorBrush)))
'菜单与按钮绑定
Public ContentHandler As Action(Of MyListItem, EventArgs)
#End Region
#Region "点击"
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData)
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
'AniStart({
' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent),
' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseDirectlyOver AndAlso Not Type = CheckType.None Then
IsMouseDown = True
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = False
End If
'AniStart({
' AaScaleTransform(Me, 0.985 - CType(RenderTransform, ScaleTransform).ScaleX, 50,, New AniEaseOutFluent)
' }, "MyListItem Scale " & Uuid)
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = True
End Sub
'实现自定义事件
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing))
#End Region
Private StateLast As String
Public IsMouseOverAnimationEnabled As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'菜单虚拟化检测
If ContentHandler IsNot Nothing Then
ContentHandler(sender, e)
ContentHandler = Nothing
End If
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseDown AndAlso Not (Type = CheckType.RadioBox AndAlso Checked) Then
StateNew = "MouseDown"
Time = 120
Else
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
StateNew = "MouseOver"
Time = 120
Else
StateNew = "Idle"
Time = 180
End If
End If
If StateLast = StateNew Then Exit Sub
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
Dim Ani As New List(Of AniData)
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsScaleAnimationEnabled Then
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.6,, New AniEaseOutFluent))
If IsMouseDown Then
Ani.Add(AaScaleTransform(Me, 0.98 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 0.9,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
End If
Else
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.5))
Ani.Add(AaOpacity(RectBack, -RectBack.Opacity, Time))
If IsScaleAnimationEnabled Then Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.246, 1,,, True)
})
End If
AniStart(Ani, "ListItem Color " & Uuid)
Else
'无动画
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1
'由于鼠标已经移入，所以直接实例化 RectBack
RectBack.Background = Color9
RectBack.Opacity = 1
RectBack.RenderTransform = New ScaleTransform(1, 1)
Me.RenderTransform = New ScaleTransform(1, 1)
Else
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 0
Me.RenderTransform = New ScaleTransform(1, 1)
If _RectBack IsNot Nothing Then
If IsScaleAnimationEnabled Then RectBack.Background = Color7
RectBack.Opacity = 0
RectBack.RenderTransform = New ScaleTransform(0.75, 0.75)
End If
End If
AniStop("ListItem Color " & Uuid)
End If
End Sub
Private Sub MyListItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If Checked Then
SetResourceReference(ForegroundProperty, "ColorBrush3")
Else
SetResourceReference(ForegroundProperty, "ColorBrush1")
End If
If EventType = "打开帮助" Then
Try
Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
End Try
End If
End Sub
Public Overrides Function ToString() As String
Return Title
End Function
End Class
Plain Craft Launcher 2/Controls/MyLoading.xaml
+37
View File
@@ -0,0 +1,37 @@
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyLoading"
MinWidth="50" MinHeight="50" Background="{StaticResource ColorBrushSemiTransparent}">
<Grid.RowDefinitions>
<RowDefinition Height="1*"/>
<RowDefinition Height="Auto"/>
<RowDefinition Height="Auto"/>
<RowDefinition Height="1*"/>
</Grid.RowDefinitions>
<Grid UseLayoutRounding="False" SnapsToDevicePixels="False" Width="60" Height="47" HorizontalAlignment="Center" VerticalAlignment="Top" Grid.Row="1">
<Path Name="PathPickaxe" Stretch="Uniform" Height="35" Margin="10,6,0,0" StrokeThickness="2"
Data="M 963.6 858.2 410.816 305.504 C 508.116 213.304 609.204 196.8 711.104 128.6 837.11367 49.573762 879.34045 50.334062 751.5 49.5 611.3 52 471.8 96.2 353.3 182.4 309.8 155.7 252.1 161.2 214.5 198.9 176.9 236.6 171.3 294.2 198 337.7 111.8 456.3 67.6 595.8 65.1 735.9 63.315254 883.82034 65.077966 837.29308 144.2 695.488 212.4 593.588 228.888 492.4 321.088 395.2 L 873.9 948 c 0.60001 0.59999 1.6 0.6 2.2 0 l 87.5 -87.5 c 0.6 -0.7 0.6 -1.6 0 -2.3 z"
Stroke="{Binding Foreground, ElementName=PanBack}" HorizontalAlignment="Left" VerticalAlignment="Top">
<Path.RenderTransform>
<RotateTransform Angle="55" CenterX="30" CenterY="30" />
</Path.RenderTransform>
</Path>
<Path Opacity="0" Name="PathLeft" Stretch="Uniform" Fill="{Binding Foreground, ElementName=PanBack}" Width="3" Height="5" Data="M0,0L2,0L1,4" Margin="7,41,0,0" RenderTransformOrigin="0.5,0.5" HorizontalAlignment="Left" VerticalAlignment="Top" >
<Path.RenderTransform>
<RotateTransform Angle="-45"/>
</Path.RenderTransform>
</Path>
<Path Opacity="0" Name="PathRight" Stretch="Uniform" Fill="{Binding Foreground, ElementName=PanBack}" Width="3" Height="5" Data="M0,0L2,0L1,4" Margin="14,41,0,0" RenderTransformOrigin="0.5,0.5" HorizontalAlignment="Left" VerticalAlignment="Top" >
<Path.RenderTransform>
<RotateTransform Angle="45"/>
</Path.RenderTransform>
</Path>
<Path Opacity="0" Name="PathError" Stretch="Uniform" Fill="{Binding Foreground, ElementName=PanBack}" Width="17" Height="17" Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" Margin="4,23,0,0" RenderTransformOrigin="0.5,0.5" HorizontalAlignment="Left" VerticalAlignment="Top" >
<Path.RenderTransform>
<ScaleTransform ScaleX="0.6" ScaleY="0.6" />
</Path.RenderTransform>
</Path>
<Rectangle Width="25" Height="2" Fill="{Binding Foreground, ElementName=PanBack}" VerticalAlignment="Bottom" HorizontalAlignment="Left" />
</Grid>
<TextBlock x:Name="LabText" Text="Loading" HorizontalAlignment="Center" TextWrapping="Wrap" VerticalAlignment="Top" Foreground="{Binding Foreground, ElementName=PanBack}" FontSize="16" Margin="0,10,0,0" Grid.Row="2"/>
</Grid>
Plain Craft Launcher 2/Controls/MyLoading.xaml.vb
+313
View File
@@ -0,0 +1,313 @@
Imports PCL.MyLoading
Public Class MyLoading
Public Event IsErrorChanged(sender As Object, isError As Boolean)
Public Event StateChanged(sender As Object, newState As MyLoadingState, oldState As MyLoadingState)
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Public Property AutoRun As Boolean = True
Private Uuid As Integer = GetUuid()
#Region "颜色"
Public Property Foreground As SolidColorBrush
Get
Return GetValue(ForegroundProperty)
End Get
Set(value As SolidColorBrush)
SetValue(ForegroundProperty, value)
End Set
End Property
Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(SolidColorBrush), GetType(MyLoading))
Public Sub New()
InitializeComponent()
SetResourceReference(ForegroundProperty, "ColorBrush3")
End Sub
#End Region
#Region "文本"
Private Property _ShowProgress As Boolean = False
Public Property ShowProgress As Boolean
Get
Return _ShowProgress
End Get
Set(value As Boolean)
If _ShowProgress = value Then Exit Property
_ShowProgress = value
RefreshText()
End Set
End Property
Private _Text As String = "加载中"
Public Property Text As String
Get
Return _Text
End Get
Set(ByVal value As String)
_Text = value
RefreshText()
End Set
End Property
Private _TextError As String = "加载失败"
Public Property TextError As String
Get
Return _TextError
End Get
Set(ByVal value As String)
_TextError = value
RefreshText()
End Set
End Property
''' <summary>
''' 是否在使用 Loader 时使用 Loader 的错误输出来替换默认的错误文本显示。
''' </summary>
Public Property TextErrorInherit As Boolean = True
Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded
If InnerState = MyLoadingState.Error Then
If TextErrorInherit AndAlso State.IsLoader Then
Dim Ex As Exception = CType(State, Object).Error
If Ex Is Nothing Then
LabText.Text = "未知错误"
Else
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = StrTrim(Ex.Message)
If LabText.Text.Contains("远程主机强迫关闭了一个现有的连接") OrElse LabText.Text.Contains("操作已超时") OrElse LabText.Text.Contains("操作超时") OrElse LabText.Text.Contains("服务器超时") OrElse LabText.Text.Contains("连接超时") Then LabText.Text = "网络环境不佳，请重试或尝试使用 VPN"
End If
Else
LabText.Text = TextError
End If
Else
If ShowProgress AndAlso State.IsLoader Then
LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%"
Else
LabText.Text = Text
End If
End If
End Sub
#End Region
#Region "状态改变"
'状态枚举
Public Enum MyLoadingState
Unloaded = -1
Run = 0
[Stop] = 1
[Error] = 2
End Enum
'用于外部改变的公开状态
Private WithEvents _State As ILoadingTrigger
Public Property State As ILoadingTrigger
Get
InitState()
Return _State
End Get
Set(value As ILoadingTrigger)
_State = value
RefreshState()
End Set
End Property
Private Sub InitState() Handles Me.Loaded
If _State Is Nothing Then
_State = New MyLoadingStateSimulator
If AutoRun Then _State.LoadingState = MyLoadingState.Run
End If
End Sub
Private Sub RefreshState() Handles _State.LoadingStateChanged, Me.Loaded, Me.Unloaded
If _State.LoadingState = MyLoadingState.Run AndAlso Not IsLoaded Then InnerState = MyLoadingState.Stop
InnerState = _State.LoadingState
OuterState = _State.LoadingState
AniLoop()
End Sub
'用于引发外部事件的状态
Private Property _OuterState As MyLoadingState = MyLoadingState.Unloaded
Private Property OuterState As MyLoadingState
Get
Return _OuterState
End Get
Set(value As MyLoadingState)
If _OuterState = value Then Exit Property
Dim OldValue = _OuterState
_OuterState = value
'引发事件
RaiseEvent StateChanged(Me, value, OldValue)
If (OldValue = MyLoadingState.Error) <> (value = MyLoadingState.Error) Then RaiseEvent IsErrorChanged(Me, value = MyLoadingState.Error)
End Set
End Property
'用于引发内部动画事件的状态
Private Property _InnerState As MyLoadingState = MyLoadingState.Unloaded
Private Property InnerState As MyLoadingState
Get
Return _InnerState
End Get
Set(value As MyLoadingState)
If _InnerState = value Then Exit Property
Dim OldValue = _InnerState
_InnerState = value
'引发事件
AniLoop()
If (OldValue = MyLoadingState.Error) <> (value = MyLoadingState.Error) Then ErrorAnimation(Me, value = MyLoadingState.Error)
End Set
End Property
#End Region
#Region "动画"
''' <summary>
''' 是否需要动画。
''' </summary>
Public Property HasAnimation As Boolean = True
''' <summary>
''' 主动画循环是否正在运行中。
''' </summary>
Private IsLooping As Boolean = False
Private Sub AniLoop()
'这坨循环代码也是老屎坑了，救救.jpg
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
IsLooping = True
ErrorAnimationWaiting = True
If ShowProgress Then
RefreshText()
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaCode(AddressOf RefreshText, 100), '这是为了省下一个 Timer 线程……
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
PathRight.Margin = New Thickness(14, 41, 0, 0)
ErrorAnimationWaiting = False
RefreshText()
End Sub),
AaCode(AddressOf RefreshText, 100),
AaCode(AddressOf RefreshText, 200),
AaCode(AddressOf RefreshText, 300),
AaCode(AddressOf RefreshText, 400),
AaCode(AddressOf RefreshText, 500),
AaCode(AddressOf RefreshText, 600),
AaCode(AddressOf RefreshText, 700),
AaCode(AddressOf RefreshText, 800),
AaOpacity(PathLeft, -1, 100, 70),
AaX(PathLeft, -5, 180, 20, New AniEaseOutFluent),
AaY(PathLeft, -6, 180, 20, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 70),
AaX(PathRight, 5, 180, 20, New AniEaseOutFluent),
AaY(PathRight, -6, 180, 20, New AniEaseOutFluent),
AaCode(Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
Else
AniStart({
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
PathRight.Margin = New Thickness(14, 41, 0, 0)
ErrorAnimationWaiting = False
End Sub),
AaOpacity(PathLeft, -1, 100, 50),
AaX(PathLeft, -5, 180,, New AniEaseOutFluent),
AaY(PathLeft, -6, 180,, New AniEaseOutFluent),
AaOpacity(PathRight, -1, 100, 50),
AaX(PathRight, 5, 180,, New AniEaseOutFluent),
AaY(PathRight, -6, 180,, New AniEaseOutFluent),
AaCode(Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
End If
End Sub
''' <summary>
''' 镐子是否还没挥下去，要求错误动画等待。
''' </summary>
Private ErrorAnimationWaiting As Boolean = False
Private Sub ErrorAnimation(sender As Object, isError As Boolean)
If isError Then
'非错误变为错误
Dim Wait As Integer = If(ErrorAnimationWaiting, 400, 0)
AniStart({
AaColor(PanBack, ForegroundProperty, "ColorBrushRedLight", 300),
AaOpacity(PathError, 1 - PathError.Opacity, 100, 300 + Wait),
AaScaleTransform(PathError, 1 - CType(PathError.RenderTransform, ScaleTransform).ScaleX, 400, 300 + Wait, New AniEaseOutBack)
}, "MyLoader Error " & Uuid)
Else
'错误变为非错误
AniStart({
AaOpacity(PathError, -PathError.Opacity, 100),
AaScaleTransform(PathError, 0.5 - CType(PathError.RenderTransform, ScaleTransform).ScaleX, 200),
AaColor(PanBack, ForegroundProperty, "ColorBrush3", 300)
}, "MyLoader Error " & Uuid)
End If
End Sub
#End Region
#Region "点击事件"
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
RaiseEvent Click(sender, e)
End Sub
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
IsMouseDown = True
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.MouseLeftButtonUp
IsMouseDown = False
End Sub
#End Region
End Class
Public Interface ILoadingTrigger
ReadOnly Property IsLoader As Boolean
Property LoadingState As MyLoadingState
Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState)
End Interface
Public Class MyLoadingStateSimulator
Implements ILoadingTrigger
Private Property _LoadingState As MyLoadingState = MyLoadingState.Unloaded
Public Property LoadingState As MyLoadingState Implements ILoadingTrigger.LoadingState
Get
Return _LoadingState
End Get
Set(value As MyLoadingState)
If _LoadingState = value Then Exit Property
Dim OldState = _LoadingState
_LoadingState = value
RaiseEvent LoadingStateChanged(value, OldState)
End Set
End Property
Public ReadOnly Property IsLoader As Boolean = False Implements ILoadingTrigger.IsLoader
Public Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged
End Class
Plain Craft Launcher 2/Controls/MyMenuItem.vb
+55
View File
@@ -0,0 +1,55 @@
Public Class MyMenuItem
Inherits MenuItem
Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If Icon IsNot Nothing Then
Dim IconControl As Shapes.Path = GetTemplateChild("Icon")
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If
End Sub
'基础
Public Uuid As Integer = GetUuid()
'指向动画
Private Const AnimationTimeIn As Integer = 100
Private Const AnimationTimeOut As Integer = 200
Private ColorName As String
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged
'判断当前颜色
Dim BackName As String, ForeName As String
Dim Time As Integer
If Not IsEnabled Then
BackName = "ColorBrushTransparent"
ForeName = "ColorBrushGray5"
Time = AnimationTimeOut
ElseIf IsMouseOver Then
BackName = "ColorBrush6"
ForeName = "ColorBrush2"
Time = AnimationTimeIn
Else
BackName = "ColorBrushTransparent"
ForeName = "ColorBrush1"
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = BackName Then Exit Sub
ColorName = BackName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, BackgroundProperty, BackName, Time),
AaColor(Me, ForegroundProperty, ForeName, Time)
}, "MyMenuItem Color " & Uuid)
Else
'无动画
AniStop("MyMenuItem Color " & Uuid)
SetResourceReference(BackgroundProperty, BackName)
SetResourceReference(ForegroundProperty, ForeName)
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
+23
View File
@@ -0,0 +1,23 @@
<Grid x:Class="MyMsgInput"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="500" HorizontalAlignment="Center" VerticalAlignment="Center">
<Border Name="PanBorder" CornerRadius="5" Width="{Binding ActualWidth, ElementName=PanMain, Mode=OneWay}" Height="{Binding ActualHeight, ElementName=PanMain, Mode=OneWay}" Background="#00FBFBFB">
<Border.Effect>
<DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="15" ShadowDepth="0" Opacity="0" x:Name="EffectShadow" />
</Border.Effect>
</Border>
<StackPanel Name="PanMain" VerticalAlignment="Top">
<TextBlock FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="27,19,28,0" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle Height="2" Fill="{DynamicResource ColorBrush2}" Margin="20,9,20,15" Name="ShapeLine" Opacity="0" />
<Border Name="PanCaption" Padding="28,0,28,15">
<my:MyTextBox x:Name="TextCaption" UseLayoutRounding="False" MaxLength="1000" Width="450" Margin="1" />
</Border>
<StackPanel Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</StackPanel>
</Grid>
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb
+134
View File
@@ -0,0 +1,134 @@
Public Class MyMsgInput
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Public Sub New(Converter As MyMsgBoxConverter)
Try
InitializeComponent()
Btn1.Name = Btn1.Name & GetUuid()
Btn2.Name = Btn2.Name & GetUuid()
Btn3.Name = Btn3.Name & GetUuid()
MyConverter = Converter
LabTitle.Text = Converter.Title
TextCaption.Text = Converter.Content
TextCaption.HintText = Converter.HintText
TextCaption.ValidateRules = Converter.ValidateRules
Btn1.Text = Converter.Button1
If Converter.IsWarn Then
Btn1.ColorType = MyButton.ColorState.Red
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight")
ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight")
End If
Btn2.Text = Converter.Button2
Btn3.Text = Converter.Button3
Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible)
Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible)
'If Converter.Caption > 0 Then
' TextCaption.Focus()
' TextCaption.Select(Converter.Caption.Length - 1, 0)
'End If
Catch ex As Exception
Log(ex, "输入弹窗初始化失败", LogLevel.Hint)
End Try
End Sub
Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
Try
'UI 初始化
If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight
ShapeLine.StrokeThickness = GetWPFSize(1)
Measure(New Size(FrmMain.Width, FrmMain.Height))
Arrange(New Rect(0, 0, FrmMain.Width, FrmMain.Height))
If FrmMain.Width - ActualWidth < 20 Then Width = FrmMain.Width - GetWPFSize(2)
TextCaption.Focus()
'动画
AniStart({
AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent),
AaOpacity(EffectShadow, 0.75, 400, 50),
AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent),
AaOpacity(ShapeLine, 1, 200, 100),
AaWidth(LabTitle, LabTitle.ActualWidth, 200, 100, New AniEaseOutFluent),
AaOpacity(LabTitle, 1, 150, 150),
AaOpacity(PanCaption, 1, 150, 150),
AaOpacity(Btn1, 1, 150, 100),
AaOpacity(Btn2, 1, 150, 150),
AaOpacity(Btn3, 1, 150, 200),
AaCode(Sub()
ShapeLine.MinWidth = ShapeLine.ActualWidth
ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch
ShapeLine.Width = Double.NaN
LabTitle.Width = Double.NaN
LabTitle.TextTrimming = TextTrimming.CharacterEllipsis
End Sub, 350)
}, "MyMsgBox Start " & Uuid)
'动画初始化
ShapeLine.Width = 0
ShapeLine.HorizontalAlignment = HorizontalAlignment.Center
LabTitle.Width = 0
LabTitle.Opacity = 0
LabTitle.TextWrapping = TextWrapping.NoWrap
PanCaption.Opacity = 0
'记录日志
Log("[Control] 输入弹窗：" & LabTitle.Text)
Catch ex As Exception
Log(ex, "输入弹窗加载失败", LogLevel.Hint)
End Try
End Sub
Private Sub Close()
'结束线程阻塞
MyConverter.WaitFrame.Continue = False
Interop.ComponentDispatcher.PopModal()
'弹窗动画
LabTitle.TextTrimming = TextTrimming.None
LabTitle.TextWrapping = TextWrapping.NoWrap
AniStart({
AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent),
AaOpacity(EffectShadow, -0.75, 150),
AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent),
AaOpacity(ShapeLine, -1, 150, 100),
AaWidth(LabTitle, -LabTitle.ActualWidth, 250),
AaOpacity(LabTitle, -1, 200),
AaOpacity(PanCaption, -1, 200),
AaOpacity(Btn1, -1, 150),
AaOpacity(Btn2, -1, 150, 50),
AaOpacity(Btn3, -1, 150, 100),
AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
}, "MyMsgBox Close " & Uuid)
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse Not TextCaption.ValidateResult = "" Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = TextCaption.Text
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextCaption.ValidateChanged
Btn1.IsEnabled = TextCaption.ValidateResult = ""
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
On Error Resume Next
If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
End Sub
End Class
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
+27
View File
@@ -0,0 +1,27 @@
<Grid x:Name="PanBack" x:Class="MyMsgSelect"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="450" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="20">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Border Name="PanBorder" Grid.RowSpan="99" Width="{Binding ActualWidth, ElementName=PanBack, Mode=OneWay}" Height="{Binding ActualHeight, ElementName=PanBack, Mode=OneWay}" Background="#00FBFBFB" CornerRadius="5">
<Border.Effect>
<DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="15" ShadowDepth="0" Opacity="0" x:Name="EffectShadow" />
</Border.Effect>
</Border>
<TextBlock FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="28,19,28,0" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle Height="2" Grid.Row="1" Fill="{DynamicResource ColorBrush2}" Margin="20,9,20,13" Name="ShapeLine" Opacity="0" />
<my:MyScrollViewer x:Name="PanCaption" Grid.Row="2" Margin="19,0,19,20" Padding="9,0" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" SnapsToDevicePixels="True" UseLayoutRounding="True" DeltaMuity="0.5">
<StackPanel x:Name="PanSelection" Orientation="Vertical" />
</my:MyScrollViewer>
<StackPanel Name="PanBtn" Grid.Row="3" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" IsEnabled="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
+138
View File
@@ -0,0 +1,138 @@
Public Class MyMsgSelect
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Public Sub New(Converter As MyMsgBoxConverter)
Try
InitializeComponent()
Btn1.Name = Btn1.Name & GetUuid()
Btn2.Name = Btn2.Name & GetUuid()
Btn3.Name = Btn3.Name & GetUuid()
MyConverter = Converter
LabTitle.Text = Converter.Title
Btn1.Text = Converter.Button1
If Converter.IsWarn Then
Btn1.ColorType = MyButton.ColorState.Red
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight")
ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight")
End If
Btn2.Text = Converter.Button2
Btn3.Text = Converter.Button3
Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible)
Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible)
'添加选择控件
For Each Selection As IMyRadio In Converter.Content
PanSelection.Children.Add(Selection)
AddHandler Selection.Check, AddressOf OnChecked
If TypeOf Selection Is MyListItem Then
CType(Selection, MyListItem).Type = MyListItem.CheckType.RadioBox
CType(Selection, MyListItem).MinHeight = 24
Else
CType(Selection, MyRadioBox).MinHeight = 26
End If
Next
Catch ex As Exception
Log(ex, "选择弹窗初始化失败", LogLevel.Hint)
End Try
End Sub
Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
Try
'UI 初始化
If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight
ShapeLine.StrokeThickness = GetWPFSize(1)
Measure(New Size(FrmMain.Width, FrmMain.Height))
Arrange(New Rect(0, 0, FrmMain.Width, FrmMain.Height))
If FrmMain.Width - ActualWidth < 20 Then Width = FrmMain.Width - GetWPFSize(2)
'动画
AniStart({
AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent),
AaOpacity(EffectShadow, 0.75, 400, 50),
AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent),
AaOpacity(ShapeLine, 1, 200, 100),
AaWidth(LabTitle, LabTitle.ActualWidth, 200, 100, New AniEaseOutFluent),
AaOpacity(LabTitle, 1, 150, 150),
AaOpacity(PanCaption, 1, 150, 150),
AaOpacity(Btn1, 1, 150, 100),
AaOpacity(Btn2, 1, 150, 150),
AaOpacity(Btn3, 1, 150, 200),
AaCode(Sub()
ShapeLine.MinWidth = ShapeLine.ActualWidth
ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch
ShapeLine.Width = Double.NaN
LabTitle.Width = Double.NaN
LabTitle.TextTrimming = TextTrimming.CharacterEllipsis
End Sub, 350)
}, "MyMsgBox Start " & Uuid)
'动画初始化
ShapeLine.Width = 0
ShapeLine.HorizontalAlignment = HorizontalAlignment.Center
LabTitle.Width = 0
LabTitle.Opacity = 0
LabTitle.TextWrapping = TextWrapping.NoWrap
PanCaption.Opacity = 0
'记录日志
Log("[Control] 选择弹窗：" & LabTitle.Text)
Catch ex As Exception
Log(ex, "选择弹窗加载失败", LogLevel.Hint)
End Try
End Sub
Private Sub Close()
'结束线程阻塞
MyConverter.WaitFrame.Continue = False
Interop.ComponentDispatcher.PopModal()
'弹窗动画
LabTitle.TextTrimming = TextTrimming.None
LabTitle.TextWrapping = TextWrapping.NoWrap
AniStart({
AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent),
AaOpacity(EffectShadow, -0.75, 150),
AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent),
AaOpacity(ShapeLine, -1, 150, 100),
AaWidth(LabTitle, -LabTitle.ActualWidth, 250),
AaOpacity(LabTitle, -1, 200),
AaOpacity(PanCaption, -1, 200),
AaOpacity(Btn1, -1, 150),
AaOpacity(Btn2, -1, 150, 50),
AaOpacity(Btn3, -1, 150, 100),
AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
}, "MyMsgBox Close " & Uuid)
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = SelectedIndex
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private SelectedIndex As Integer = -1
Private Sub OnChecked(sender As IMyRadio, e As EventArgs)
Btn1.IsEnabled = True
SelectedIndex = PanSelection.Children.IndexOf(sender)
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
On Error Resume Next
If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
End Sub
End Class
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
+27
View File
@@ -0,0 +1,27 @@
<Grid x:Name="PanBack" x:Class="MyMsgText"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="450" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="20">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Border Name="PanBorder" Grid.RowSpan="99" Background="#00FBFBFB" CornerRadius="5">
<Border.Effect>
<DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="15" ShadowDepth="0" Opacity="0" x:Name="EffectShadow" />
</Border.Effect>
</Border>
<TextBlock FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="28,19,28,0" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle Height="2" Grid.Row="1" Fill="{DynamicResource ColorBrush2}" Margin="20,9,20,13" Name="ShapeLine" Opacity="0" />
<my:MyScrollViewer VerticalAlignment="Top" x:Name="PanCaption" Grid.Row="2" Margin="19,0,19,20" Padding="9,0" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" SnapsToDevicePixels="True" UseLayoutRounding="True" DeltaMuity="0.5">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
<StackPanel Name="PanBtn" Grid.Row="3" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb
+125
View File
@@ -0,0 +1,125 @@
Public Class MyMsgText
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Public Sub New(Converter As MyMsgBoxConverter)
Try
InitializeComponent()
Btn1.Name = Btn1.Name & GetUuid()
Btn2.Name = Btn2.Name & GetUuid()
Btn3.Name = Btn3.Name & GetUuid()
MyConverter = Converter
LabTitle.Text = Converter.Title
LabCaption.Text = Converter.Content
Btn1.Text = Converter.Button1
If Converter.IsWarn Then
Btn1.ColorType = MyButton.ColorState.Red
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight")
ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight")
End If
Btn2.Text = Converter.Button2
Btn3.Text = Converter.Button3
Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible)
Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible)
ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception
Log(ex, "普通弹窗初始化失败", LogLevel.Hint)
End Try
End Sub
Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
Try
'UI 初始化
If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight
Measure(New Size(FrmMain.Width - 20, FrmMain.Height - 20))
Arrange(New Rect(0, 0, FrmMain.Width - 20, FrmMain.Height - 20))
Btn1.Focus()
'动画
AniStart({
AaColor(FrmMain.PanMsg, BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent),
AaOpacity(EffectShadow, 0.75, 400, 50),
AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent),
AaOpacity(ShapeLine, 1, 200, 100),
AaWidth(LabTitle, LabTitle.ActualWidth, 200, 150, New AniEaseOutFluent),
AaOpacity(LabTitle, 1, 150, 150),
AaOpacity(PanCaption, 1, 150, 150),
AaOpacity(Btn1, 1, 150, 100),
AaOpacity(Btn2, 1, 150, 150),
AaOpacity(Btn3, 1, 150, 200),
AaCode(Sub()
ShapeLine.MinWidth = ShapeLine.ActualWidth
ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch
ShapeLine.Width = Double.NaN
LabTitle.Width = Double.NaN
LabTitle.TextTrimming = TextTrimming.CharacterEllipsis
End Sub, 350)
}, "MyMsgBox Start " & Uuid)
'动画初始化
ShapeLine.Width = 0
ShapeLine.HorizontalAlignment = HorizontalAlignment.Center
LabTitle.Width = 0
LabTitle.Opacity = 0
LabTitle.TextWrapping = TextWrapping.NoWrap
PanCaption.Opacity = 0
'记录日志
Log("[Control] 普通弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text)
Catch ex As Exception
Log(ex, "普通弹窗加载失败", LogLevel.Hint)
End Try
End Sub
Private Sub Close()
'结束线程阻塞
If MyConverter.ForceWait OrElse Not MyConverter.Button2 = "" Then MyConverter.WaitFrame.Continue = False
Interop.ComponentDispatcher.PopModal()
'弹窗动画
LabTitle.TextTrimming = TextTrimming.None
LabTitle.TextWrapping = TextWrapping.NoWrap
AniStart({
AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent),
AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent),
AaOpacity(EffectShadow, -0.75, 150),
AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(ShapeLine, -1, 200),
AaWidth(LabTitle, -LabTitle.ActualWidth, 250),
AaOpacity(LabTitle, -1, 200),
AaOpacity(PanCaption, -1, 200),
AaOpacity(Btn1, -1, 150),
AaOpacity(Btn2, -1, 150, 50),
AaOpacity(Btn3, -1, 150, 100),
AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
}, "MyMsgBox Close " & Uuid)
'动画初始化
ShapeLine.MinWidth = 0
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 1
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 2
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 3
Close()
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
On Error Resume Next
If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
End Sub
End Class
Plain Craft Launcher 2/Controls/MyPageLeft.vb
+100
View File
@@ -0,0 +1,100 @@
Public Class MyPageLeft
Inherits Grid
Private Uuid As Integer = GetUuid()
'执行逐个进入动画的控件
Public Property AnimatedControl As FrameworkElement
Get
Return GetValue(AnimatedControlProperty)
End Get
Set(value As FrameworkElement)
SetValue(AnimatedControlProperty, value)
End Set
End Property
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing))
Public Sub TriggerShowAnimation()
If AnimatedControl Is Nothing Then
'缩放动画
If TypeOf RenderTransform IsNot ScaleTransform Then
RenderTransform = New ScaleTransform(0.96, 0.96)
RenderTransformOrigin = New Point(0.5, 0.5)
End If
Opacity = 0
AniStart({
AaScaleTransform(Me, 1 - CType(RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutBack(2)),
AaOpacity(Me, 1, 100)
}, "PageLeft PageChange " & Uuid)
Else
'逐个进入动画
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
End If
End Sub
Public Sub TriggerHideAnimation()
If AnimatedControl Is Nothing Then
'缩放动画
If TypeOf RenderTransform IsNot ScaleTransform Then
RenderTransform = New ScaleTransform(1, 1)
RenderTransformOrigin = New Point(0.5, 0.5)
End If
AniStart({
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 130,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 100, 30)
}, "PageLeft PageChange " & Uuid)
Else
'逐个退出动画
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
AniList.Add(AaOpacity(Element, -Element.Opacity, 60, 80 / Controls.Count * Id))
AniList.Add(AaTranslateX(Element, -6, 60, 80 / Controls.Count * Id))
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
End If
End Sub
'遍历获取所有需要生成动画的控件
Private Function GetAllAnimControls() As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(AnimatedControl, AllControls)
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement))
If Element.Visibility = Visibility.Collapsed Then Exit Sub
If TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is MyListItem Then
CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls)
ElseIf TypeOf Element Is Panel Then
For Each Element2 As FrameworkElement In CType(Element, Panel).Children
GetAllAnimControls(Element2, AllControls)
Next
Else
AllControls.Add(Element)
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MyPageRight.vb
+376
View File
@@ -0,0 +1,376 @@
Public Class MyPageRight
Inherits AdornerDecorator
Public PageUuid As Integer = GetUuid()
'当前状态
Public Enum PageStates
Empty '默认状态，页面全空
LoaderWait '加载环初始等待
LoaderEnter '加载环进入动画
LoaderStayForce '加载环正常显示（强制等待）
LoaderStay '加载环正常显示
LoaderExit '加载环退出动画
ContentEnter '内容进入动画
ContentStay '内容正常显示
ReloadExit '刷新导致的全部退出动画
PageExit '切换页面导致的全部退出动画
End Enum
Private _PageState As PageStates = PageStates.Empty
Public Property PageState As PageStates
Get
Return _PageState
End Get
Set(value As PageStates)
If _PageState = value Then Exit Property
_PageState = value
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
End Set
End Property
#Region "加载器"
Private PageLoader As LoaderBase
Private PageLoaderInputInvoke
Private PageLoaderUi As MyLoading
Private PanLoader As FrameworkElement
Private PanContent As FrameworkElement
Private PanAlways As FrameworkElement
Private PageLoaderAutoRun As Boolean
'初始化
''' <summary>
''' 表明页面存在需要在后台执行的加载器。
''' </summary>
''' <param name="LoaderUi">MyLoading 控件。</param>
''' <param name="PanLoader">MyLoading 控件对应的卡片。</param>
''' <param name="PanContent">加载结束后出现的内容容器。</param>
''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
''' <param name="RealLoader">在工作线程执行的加载器。</param>
''' <param name="FinishedInvoke">当加载器执行完成，在 UI 线程触发的 UI 初始化事件。</param>
Public Sub PageLoaderInit(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
RealLoader As LoaderBase, FinishedInvoke As Action(Of LoaderBase), Optional InputInvoke As Func(Of Object) = Nothing,
Optional AutoRun As Boolean = True)
'初始化参数
Me.PanLoader = PanLoader
Me.PanContent = PanContent
Me.PanAlways = PanAlways
Me.PageLoader = RealLoader
Me.PageLoaderUi = LoaderUi
Me.PageLoaderInputInvoke = InputInvoke
Me.PageLoaderAutoRun = AutoRun
'添加结束 Invoke
AddHandler RealLoader.PreviewFinish,
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ReloadExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作，避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧，延迟触发 State 改变事件
End Sub
AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
'隐藏 UI
PanLoader.Visibility = Visibility.Collapsed
PanContent.Visibility = Visibility.Collapsed
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else
Dim Input = Nothing
If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
PageLoader.Start(Input)
End If
End If
If PageLoader.State = LoadState.Finished Then
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
End If
'设置加载环
PageLoaderUi.State = RealLoader
AddHandler PageLoaderUi.Click, Sub() If RealLoader.State = LoadState.Failed Then PageLoaderRestart() '点击重试事件
End Sub
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
PageLoader.Start(Input, IsForceRestart:=IsForceRestart)
End If
End Sub
#End Region
#Region "事件"
'外部触发的事件
''' <summary>
''' 需要切换到当前页面，并且原本的 Loaded 事件已执行完成。
''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。
''' </summary>
Public Sub PageOnEnter()
If ModeDebug Then Log("[UI] 已触发 PageOnEnter")
RaiseEvent OnPageEnter()
Select Case PageState
Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished Then
PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
ElseIf PageLoader.State = LoadState.Failed Then
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanAlways, PanLoader)
ElseIf PageLoader.State = LoadState.Waiting Then
'由于 “页面加载器 Minecraft Version List 不应在 PageOnEnter 事件出现 Waiting 状态” 的神秘反馈添加的临时修复
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
Log("[Anim] 警告：页面加载器 " & PageLoader.Name & " 不应在 PageOnEnter 事件出现 " & GetStringFromEnum(PageLoader.State) & " 状态", LogLevel.Debug)
Else
Throw New Exception("页面加载器 " & PageLoader.Name & " 不应在 PageOnEnter 事件出现 " & GetStringFromEnum(PageLoader.State) & " 状态。")
End If
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
End Select
End Sub
Public Event OnPageEnter()
''' <summary>
''' 需要切换到其他页面。
''' 需要立即切换至 PageExit 或 Empty。
''' </summary>
Public Sub PageOnExit()
If ModeDebug Then Log("[UI] 已触发 PageOnExit")
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
PageState = PageStates.PageExit
TriggerExitAnimation(PanAlways, If(PanContent, Child))
Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay
PageState = PageStates.PageExit
TriggerExitAnimation(PanAlways, PanLoader)
Case PageStates.LoaderWait
PageState = PageStates.PageExit
TriggerExitAnimation(PanAlways)
Case PageStates.LoaderExit, PageStates.ReloadExit
PageState = PageStates.PageExit
If PanAlways IsNot Nothing Then TriggerExitAnimation(PanAlways, If(PanContent, Child))
Case PageStates.PageExit, PageStates.Empty
End Select
End Sub
''' <summary>
''' 即将切换到其他页面，需要强制完成页面状态清理。
''' 需要立即切换至 Empty。
''' </summary>
Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Exit Sub
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid)
'由于动画会被强制中止，所以需要手动进行隐藏
If PageLoader Is Nothing Then
Child.Visibility = Visibility.Collapsed
Else
PanContent.Visibility = Visibility.Collapsed
PanLoader.Visibility = Visibility.Collapsed
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
End If
End Sub
'内部触发的事件
''' <summary>
''' 逐个进入动画已执行完成。
''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。
''' </summary>
Private Sub PageOnEnterAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished")
Select Case PageState
Case PageStates.ContentEnter
PageState = PageStates.ContentStay
Case PageStates.LoaderEnter
PageState = PageStates.LoaderStayForce
AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid)
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。")
End Select
End Sub
''' <summary>
''' 逐个退出动画已执行完成。
''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。
''' </summary>
Private Sub PageOnExitAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished")
Select Case PageState
Case PageStates.PageExit
PageState = PageStates.Empty
Case PageStates.ReloadExit
PageState = PageStates.Empty
PageOnEnter()
Case PageStates.LoaderExit
PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanContent)
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。")
End Select
End Sub
''' <summary>
''' 加载环进入等待已结束。
''' 需要从 LoaderWait 切换到 LoaderEnter。
''' </summary>
Private Sub PageOnLoaderWaitFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished")
Select Case PageState
Case PageStates.LoaderWait
PageState = PageStates.LoaderEnter
If PanAlways IsNot Nothing AndAlso PanAlways.Visibility = Visibility.Collapsed Then
TriggerEnterAnimation(PanAlways, PanLoader)
Else
TriggerEnterAnimation(PanLoader)
End If
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select
End Sub
''' <summary>
''' 加载环展示等待已结束。
''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。
''' </summary>
Private Sub PageOnLoaderStayFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished")
Select Case PageState
Case PageStates.LoaderStayForce
If PageLoader.State = LoadState.Finished Then
PageState = PageStates.LoaderExit
TriggerExitAnimation(PanLoader)
Else
PageState = PageStates.LoaderStay
End If
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select
End Sub
''' <summary>
''' 全局加载状态已改变。
''' </summary>
Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Failed, LoadState.Loading
If Not OldState = LoadState.Finished Then Exit Sub
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Refresh)")
'重新开始运行
'需要从部分状态切换到 ReloadExit
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
PageState = PageStates.ReloadExit
TriggerExitAnimation(PanContent)
Case PageStates.LoaderExit, PageStates.ReloadExit
PageState = PageStates.ReloadExit
End Select
Case LoadState.Finished
If Not OldState = LoadState.Loading Then Exit Sub
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop)")
'运行结束
'需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit
Select Case PageState
Case PageStates.LoaderWait
PageState = PageStates.ContentEnter
If PanAlways IsNot Nothing AndAlso PanAlways.Visibility = Visibility.Collapsed Then
TriggerEnterAnimation(PanAlways, PanContent)
Else
TriggerEnterAnimation(PanContent)
End If
Case PageStates.LoaderStay
PageState = PageStates.LoaderExit
TriggerExitAnimation(PanLoader)
End Select
End Select
End Sub
#End Region
#Region "动画"
'逐个进入动画
Public Sub TriggerEnterAnimation(ParamArray Elements As FrameworkElement())
'去除 Nothing 项
Dim RealElements As New List(Of FrameworkElement)
For Each Element In Elements
If Element IsNot Nothing Then RealElements.Add(Element)
Next
For Each Element In RealElements
Element.Visibility = Visibility.Visible '页面均处于默认的隐藏状态
Next
Dim AniList As New List(Of AniData)
Dim Delay As Integer = 0
For Each Element In RealElements
For Each Control As FrameworkElement In GetAllAnimControls(Element, True)
'还原被隐藏的卡片的消失动画
Control.IsHitTestVisible = True
If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing
Next
For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
Delay += 40
Next
Next
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
End Sub
'逐个退出动画
Public Sub TriggerExitAnimation(ParamArray Elements As FrameworkElement())
'去除 Nothing 项
Dim RealElements As New List(Of FrameworkElement)
For Each Element In Elements
If Element IsNot Nothing Then RealElements.Add(Element)
Next
Dim AniList As New List(Of AniData)
Dim Delay As Integer = 0
For Each Element In RealElements
For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
Delay += 20
Next
Next
AniList.Add(AaCode(Sub()
For Each Element In RealElements
Element.Visibility = Visibility.Collapsed
Next
PageOnExitAnimationFinished()
End Sub,, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
End Sub
'遍历获取所有需要生成动画的控件
Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(Element, AllControls, IgnoreInvisibility)
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint Then
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
GetAllAnimControls(CType(Element, ContentControl).Content, AllControls, IgnoreInvisibility)
ElseIf TypeOf Element Is Panel Then
For Each Element2 As FrameworkElement In CType(Element, Panel).Children
GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
Next
End If
End Sub
#End Region
End Class
Plain Craft Launcher 2/Controls/MyRadioBox.xaml
+9
View File
@@ -0,0 +1,9 @@
<Grid x:Class="MyRadioBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}"
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"/>
<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="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid>
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
+231
View File
@@ -0,0 +1,231 @@
Public Class MyRadioBox
Implements IMyRadio
'基础
Public Uuid As Integer = GetUuid()
Public Event PreviewCheck(sender As Object, e As RouteEventArgs)
Public Event PreviewChange(sender As Object, e As RouteEventArgs)
Public Event Check(sender As Object, e As RouteEventArgs) Implements IMyRadio.Check
Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
End Set
End Property
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try
'Preview 事件
If value AndAlso user Then
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewCheck(Me, e)
If e.Handled Then
Radiobox_MouseLeave()
Exit Sub
End If
End If
'自定义属性基础
Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not value = _Checked Then
_Checked = value
IsChanged = True
End If
'保证只有一个单选框选中
If Parent Is Nothing Then Exit Sub
Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children
If TypeOf Control Is MyRadioBox Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
End If
Next
'判断选中情况
Select Case CheckedCount
Case 0
'没有任何单选框被选中，选择第一个
RadioboxList(0).Checked = True
Case Is > 1
'选中项目多于 1 个
If Checked Then
'如果本控件选中，则取消其他所有控件的选中
For Each Control As MyRadioBox In RadioboxList
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
Next
Else
'如果本控件未选中，则只保留第一个选中的控件
Dim FirstChecked = False
For Each Control As MyRadioBox In RadioboxList
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
End If
Next
End If
End Select
'End If
'更改动画
If Not IsChanged Then Exit Sub
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try
End Sub
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue
End Sub)))
'点击事件
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
MouseDowned = False
Log("[Control] 按下单选框：" & Text)
SetChecked(True, True, True)
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrush9", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If
End Sub
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
MouseDowned = False
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If
End Sub
'指向动画
Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度
Private Const AnimationTimeOfMouseOut As Integer = 200 '鼠标指向动画长度
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
Private Sub Radiobox_IsEnabledChanged() Handles Me.IsEnabledChanged
If Me.IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
If Me.IsEnabled Then
'可用
Radiobox_MouseLeaveAnimation()
Else
'不可用
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray4 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
End If
Else
'无动画
AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
End If
End Sub
Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox TextColor " & Uuid)
End Sub
Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not Me.IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行，所以如果自定义事件修改了 IsEnabled，将导致显示错误
If IsLoaded AndAlso AniControlEnabled = 0 Then
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
Else
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MyRadioButton.xaml
+9
View File
@@ -0,0 +1,9 @@
<Border x:Name="PanBack" x:Class="MyRadioButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb
+255
View File
@@ -0,0 +1,255 @@
Public Class MyRadioButton
'基础
Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性
Public Property Logo As String
Get
Return ShapeLogo.Data.ToString
End Get
Set(value As String)
ShapeLogo.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Not IsNothing(ShapeLogo) Then ShapeLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
End Set
End Property
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try
'自定义属性基础
Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent Change(Me, user)
If Not value = _Checked Then
_Checked = value
IsChanged = True
End If
'保证只有一个单选框选中
If IsNothing(Parent) Then Exit Sub
Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children
If TypeOf Control Is MyRadioButton Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
End If
Next
'判断选中情况
Select Case CheckedCount
Case 0
'没有任何单选框被选中，选择第一个
RadioboxList(0).Checked = True
Case Is > 1
'选中项目多于 1 个
If Me.Checked Then
'如果本控件选中，则取消其他所有控件的选中
For Each Control As MyRadioButton In RadioboxList
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
Next
Else
'如果本控件未选中，则只保留第一个选中的控件
Dim FirstChecked = False
For Each Control As MyRadioButton In RadioboxList
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
End If
Next
End If
End Select
'更改动画
If Not IsChanged Then Exit Sub
RefreshColor(Nothing, anime)
'触发事件
If Checked Then RaiseEvent Check(Me, user)
Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
End Try
End Sub
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue
End Sub)))
Public Enum ColorState
White
Highlight
End Enum
Private _ColorType As ColorState = ColorState.White
Public Property ColorType As ColorState
Get
Return _ColorType
End Get
Set(value As ColorState)
_ColorType = value
RefreshColor()
End Set
End Property '颜色类别
'点击事件
Private IsMouseDown As Boolean = False
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Exit Sub
If Not IsMouseDown Then Exit Sub
Log("[Control] 按下单选按钮：" & Text)
IsMouseDown = False
SetChecked(True, True, True)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
If Checked Then Exit Sub
IsMouseDown = True
RefreshColor()
End Sub
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
End Sub
'动画
Private Const AnimationTimeOfMouseIn As Integer = 90 '鼠标指向动画长度
Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度
Private Const AnimationTimeOfCheck As Integer = 120 '勾选状态变更动画长度
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
Try
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画，若强制不执行动画，则 e 为 False
Select Case ColorType
Case ColorState.White
If Checked Then
'勾选
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfCheck),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfCheck)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, New MyColor(255, 255, 255) - Background, AnimationTimeOfCheck), "MyRadioButton Color " & Uuid)
ElseIf IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, New MyColor(120, Color8) - Background, 60), "MyRadioButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfMouseIn)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, New MyColor(50, Color8) - Background, AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid)
Else
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfMouseOut)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyRadioButton Color " & Uuid)
End If
Case ColorState.Highlight
If Checked Then
'勾选
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfCheck),
AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfCheck)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush3", AnimationTimeOfCheck), "MyRadioButton Color " & Uuid)
ElseIf IsMouseDown Then
'按下
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, "ColorBrush7", AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid)
Else
'正常
AniStart({
AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseOut),
AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseOut)
}, "MyRadioButton Checked " & Uuid)
AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyRadioButton Color " & Uuid)
End If
End Select
Else
'不使用动画
AniStop("MyRadioButton Checked " & Uuid)
AniStop("MyRadioButton Color " & Uuid)
Select Case ColorType
Case ColorState.White
If Checked Then
Background = New MyColor(255, 255, 255)
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush3")
LabText.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush3")
Else
Background = ColorSemiTransparent
ShapeLogo.Fill = New MyColor(255, 255, 255)
LabText.Foreground = New MyColor(255, 255, 255)
End If
Case ColorState.Highlight
If Checked Then
SetResourceReference(BackgroundProperty, "ColorBrush3")
ShapeLogo.Fill = New MyColor(255, 255, 255)
LabText.Foreground = New MyColor(255, 255, 255)
Else
Background = ColorSemiTransparent
ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush3")
LabText.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush3")
End If
End Select
End If
Catch ex As Exception
Log(ex, "刷新按钮颜色出错")
End Try
End Sub
End Class
Plain Craft Launcher 2/Controls/MyResizer.vb
+315
View File
@@ -0,0 +1,315 @@
Imports System.Runtime.InteropServices
Imports System.Windows.Interop
Imports System.Windows.Threading
Public Class MyResizer
Private Delegate Sub RefreshDelegate()
Private Structure POINT
Public x As Integer
Public y As Integer
Public Sub New(x As Integer, y As Integer)
Me.x = x
Me.y = y
End Sub
End Structure
Private Structure MINMAXINFO
Public ptReserved As POINT
Public ptMaxSize As POINT
Public ptMaxPosition As POINT
Public ptMinTrackSize As POINT
Public ptMaxTrackSize As POINT
End Structure
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
Public Shared Empty As RECT = Nothing
Public ReadOnly Property Width() As Integer
Get
Return Math.Abs(Me.right - Me.left)
End Get
End Property
Public ReadOnly Property Height() As Integer
Get
Return Me.bottom - Me.top
End Get
End Property
Public Sub New(left As Integer, top As Integer, right As Integer, bottom As Integer)
Me.left = left
Me.top = top
Me.right = right
Me.bottom = bottom
End Sub
Public Sub New(rcSrc As RECT)
Me.left = rcSrc.left
Me.top = rcSrc.top
Me.right = rcSrc.right
Me.bottom = rcSrc.bottom
End Sub
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Class MONITORINFO
Public cbSize As Integer = Marshal.SizeOf(GetType(MONITORINFO))
Public rcMonitor As RECT = Nothing
Public rcWork As RECT = Nothing
Public dwFlags As Integer = 0
End Class
Private Structure PointAPI
Public X As Integer
Public Y As Integer
End Structure
Private ReadOnly target As Window = Nothing
Private resizeRight As Boolean = False
Private resizeLeft As Boolean = False
Private resizeUp As Boolean = False
Private resizeDown As Boolean = False
Private ReadOnly leftElements As New Dictionary(Of UIElement, Short)()
Private ReadOnly rightElements As New Dictionary(Of UIElement, Short)()
Private ReadOnly upElements As New Dictionary(Of UIElement, Short)()
Private ReadOnly downElements As New Dictionary(Of UIElement, Short)()
Private startMousePoint As PointAPI = Nothing
Private startWindowSize As Size = Nothing
Private startWindowLeftUpPoint As POINT = Nothing
Private Shared workAreaMaxHeight As Integer = -1
Private hs As HwndSource
Public Sub New(target As Window)
Me.target = target
If IsNothing(target) Then Throw New Exception("Invalid Window handle")
AddHandler target.SourceInitialized, AddressOf Me.MyMacClass_SourceInitialized
End Sub
Private Sub MyMacClass_SourceInitialized(sender As Object, e As EventArgs)
Me.hs = (TryCast(PresentationSource.FromVisual(CType(sender, Visual)), HwndSource))
Me.hs.AddHook(AddressOf Me.WndProc)
End Sub
Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
If msg = 36 Then
WmGetMinMaxInfo(hwnd, lParam)
handled = True
End If
Return CType(0, IntPtr)
End Function
Private Shared Sub WmGetMinMaxInfo(hwnd As IntPtr, lParam As IntPtr)
Dim mINMAXINFO As MINMAXINFO = CType(Marshal.PtrToStructure(lParam, GetType(MINMAXINFO)), MINMAXINFO)
Dim flags As Integer = 2
Dim intPtr As IntPtr = MonitorFromWindow(hwnd, flags)
Dim flag As Boolean = intPtr <> IntPtr.Zero
If flag Then
Dim mONITORINFO As New MONITORINFO()
GetMonitorInfo(intPtr, mONITORINFO)
Dim rcWork As RECT = mONITORINFO.rcWork
Dim rcMonitor As RECT = mONITORINFO.rcMonitor
mINMAXINFO.ptMaxPosition.x = Math.Abs(rcWork.left - rcMonitor.left)
mINMAXINFO.ptMaxPosition.y = Math.Abs(rcWork.top - rcMonitor.top)
mINMAXINFO.ptMaxSize.y = Math.Abs(rcWork.bottom - rcWork.top)
workAreaMaxHeight = mINMAXINFO.ptMaxSize.y
If rcWork.Height = rcMonitor.Height Then
mINMAXINFO.ptMaxSize.y -= 2
End If
End If
Marshal.StructureToPtr(mINMAXINFO, lParam, True)
End Sub
Private Declare Function GetMonitorInfo Lib "user32" (hMonitor As IntPtr, lpmi As MONITORINFO) As Boolean
Friend Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
Private Sub connectMouseHandlers(element As UIElement)
AddHandler element.MouseLeftButtonDown, AddressOf Me.element_MouseLeftButtonDown
End Sub
Public Sub addResizerRight(element As UIElement)
Me.connectMouseHandlers(element)
Me.rightElements.Add(element, 0)
End Sub
Public Sub addResizerLeft(element As UIElement)
Me.connectMouseHandlers(element)
Me.leftElements.Add(element, 0)
End Sub
Public Sub addResizerUp(element As UIElement)
Me.connectMouseHandlers(element)
Me.upElements.Add(element, 0)
End Sub
Public Sub addResizerDown(element As UIElement)
Me.connectMouseHandlers(element)
Me.downElements.Add(element, 0)
End Sub
Public Sub addResizerRightDown(element As UIElement)
Me.connectMouseHandlers(element)
Me.rightElements.Add(element, 0)
Me.downElements.Add(element, 0)
End Sub
Public Sub addResizerLeftDown(element As UIElement)
Me.connectMouseHandlers(element)
Me.leftElements.Add(element, 0)
Me.downElements.Add(element, 0)
End Sub
Public Sub addResizerRightUp(element As UIElement)
Me.connectMouseHandlers(element)
Me.rightElements.Add(element, 0)
Me.upElements.Add(element, 0)
End Sub
Public Sub addResizerLeftUp(element As UIElement)
Me.connectMouseHandlers(element)
Me.leftElements.Add(element, 0)
Me.upElements.Add(element, 0)
End Sub
Private Sub element_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs)
GetCursorPos(startMousePoint)
startMousePoint.X = GetWPFSize(startMousePoint.X)
startMousePoint.Y = GetWPFSize(startMousePoint.Y)
startWindowSize = New Size(target.Width, target.Height)
startWindowLeftUpPoint = New POINT(target.Left, target.Top)
Dim key As UIElement = CType(sender, UIElement)
If leftElements.ContainsKey(key) Then resizeLeft = True
If rightElements.ContainsKey(key) Then resizeRight = True
If upElements.ContainsKey(key) Then resizeUp = True
If downElements.ContainsKey(key) Then resizeDown = True
RunInNewThread(AddressOf updateSizeLoop, "窗口大小调整检测")
End Sub
Private Sub updateSizeLoop()
Try
While resizeDown OrElse resizeLeft OrElse resizeRight OrElse resizeUp
target.Dispatcher.Invoke(AddressOf updateSize, DispatcherPriority.Render)
target.Dispatcher.Invoke(AddressOf updateMouseDown, DispatcherPriority.Render)
Thread.Sleep(0)
End While
Catch
End Try
End Sub
Private Sub updateSize()
Dim pointAPI As PointAPI = Nothing
GetCursorPos(pointAPI)
pointAPI.X = GetWPFSize(pointAPI.X)
pointAPI.Y = GetWPFSize(pointAPI.Y)
Try
Dim NewWidth As Double = -1
Dim NewHeight As Double = -1
Dim NewLeft As Double = -10000
Dim NewTop As Double = -10000
If resizeRight Then
If target.Width = target.MinWidth Then
If startMousePoint.X < pointAPI.X Then
NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X)
End If
Else
If startWindowSize.Width - ((startMousePoint.X - pointAPI.X)) >= target.MinWidth Then
NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X)
Else
NewWidth = target.MinWidth
End If
End If
End If
If resizeDown Then
If target.Height = target.MinHeight Then
If startMousePoint.Y < pointAPI.Y Then
If workAreaMaxHeight > 0 Then
NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= workAreaMaxHeight), (startWindowSize.Height - ((startMousePoint.Y - pointAPI.Y))), ((workAreaMaxHeight) - target.Top))
Else
NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)
End If
End If
Else
If startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then
If workAreaMaxHeight > 0 Then
NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= (workAreaMaxHeight)), (startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)), ((workAreaMaxHeight) - target.Top))
Else
NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)
End If
Else
NewHeight = target.MinHeight
End If
End If
End If
If resizeLeft Then
If target.Width = target.MinWidth Then
If startMousePoint.X > pointAPI.X Then
NewWidth = startWindowSize.Width + startMousePoint.X - pointAPI.X
NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X)
Else
NewWidth = target.MinWidth
NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width
End If
Else
If startWindowSize.Width + (startMousePoint.X - pointAPI.X) >= target.MinWidth Then
NewWidth = startWindowSize.Width + (startMousePoint.X - pointAPI.X)
NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X)
Else
NewWidth = target.MinWidth
NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width
End If
End If
End If
If resizeUp Then
If target.Height = target.MinHeight Then
If startMousePoint.Y > pointAPI.Y Then
NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y
NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y)
Else
NewHeight = target.MinHeight
NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height
End If
Else
If startWindowSize.Height + (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then
NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y
NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y)
Else
NewHeight = target.MinHeight
NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height
End If
End If
End If
If NewWidth > 10 AndAlso Math.Abs(NewWidth - target.Width) > 0.7 Then target.Width = NewWidth
If NewHeight > 10 AndAlso Math.Abs(NewHeight - target.Height) > 0.7 Then target.Height = NewHeight
If NewLeft > -9999 AndAlso Math.Abs(NewLeft - target.Left) > 0.7 Then target.Left = NewLeft
If NewTop > -9999 AndAlso Math.Abs(NewTop - target.Top) > 0.7 Then target.Top = NewTop
Catch
End Try
End Sub
Private Sub updateMouseDown()
Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released
If flag Then
resizeRight = False
resizeLeft = False
resizeUp = False
resizeDown = False
End If
End Sub
Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
End Class
Plain Craft Launcher 2/Controls/MyScrollBar.vb
+51
View File
@@ -0,0 +1,51 @@
Public Class MyScrollBar
Inherits Primitives.ScrollBar
'基础
Public Uuid As Integer = GetUuid()
'指向动画
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.GotMouseCapture, Me.LostMouseCapture, Me.MouseEnter, Me.MouseLeave, Me.IsVisibleChanged
Try
'判断当前颜色
Dim NewOpacity As Double, NewColor As String, Time As Integer
If Not IsVisible Then
NewOpacity = 0
Time = 20 '防止错误的尺寸判断导致闪烁
NewColor = "ColorBrush4"
ElseIf IsMouseCaptureWithin Then
NewOpacity = 1
NewColor = "ColorBrush4"
Time = 50
ElseIf IsMouseOver Then
NewOpacity = 0.9
NewColor = "ColorBrush3"
Time = 130
Else
NewOpacity = 0.5
NewColor = "ColorBrush4"
Time = 180
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, ForegroundProperty, NewColor, Time),
AaOpacity(Me, NewOpacity - Opacity, Time)
}, "MyScrollBar Color " & Uuid)
Else
'无动画
AniStop("MyScrollBar Color " & Uuid)
SetResourceReference(ForegroundProperty, NewColor)
Opacity = NewOpacity
End If
Catch ex As Exception
Log(ex, "滚动条颜色改变出错")
End Try
End Sub
End Class
Plain Craft Launcher 2/Controls/MyScrollViewer.vb
+27
View File
@@ -0,0 +1,27 @@
Public Class MyScrollViewer
Inherits ScrollViewer
Public Property DeltaMuity As Double = 1
Private RealOffset As Double
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
Dim SourceTypeName As String = e.Source.GetType.Name
If Content.TemplatedParent Is Nothing AndAlso (SourceTypeName.Contains("Combo") OrElse SourceTypeName = "MyTextBox") Then Exit Sub '确定可视树，防止滚动问题
PerformVerticalOffsetDelta(-e.Delta)
e.Handled = True
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double)
RealOffset = MathRange(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
End Sub
Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged
RealOffset = VerticalOffset
If FrmMain IsNot Nothing AndAlso (e.VerticalChange OrElse e.ViewportHeightChange) Then FrmMain.BtnExtraBack.ShowRefresh()
End Sub
Private Sub MyScrollViewer_IsVisibleChanged(sender As Object, e As DependencyPropertyChangedEventArgs) Handles Me.IsVisibleChanged
FrmMain.BtnExtraBack.ShowRefresh()
End Sub
End Class
Plain Craft Launcher 2/Controls/MySearchBox.xaml
+15
View File
@@ -0,0 +1,15 @@
<local:MyCard x:Class="MySearchBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d"
d:DesignHeight="450" d:DesignWidth="800"
Height="40">
<Grid>
<local:MyTextBox HasAnimation="False" x:Name="TextBox" BorderThickness="0" Padding="32,0,40,0" MaxLength="50" FontSize="13.5" UseLayoutRounding="False" SnapsToDevicePixels="False" VerticalContentAlignment="Center" />
<Path Width="14" Margin="14,0,0,0" IsHitTestVisible="False" Height="14" Fill="{DynamicResource ColorBrush1}" Stretch="Uniform" Data="M675.9168 242.816C556.3008 123.2 362.4448 123.2 242.8288 242.816 123.2128 362.432 123.2128 556.288 242.8288 675.904 362.4448 795.52 556.3008 795.52 675.9168 675.904 795.5328 556.288 795.5328 362.432 675.9168 242.816L675.9168 242.816ZM1000.7168 892.48C1030.6048 922.368 1030.6048 970.816 1000.7168 1000.704 970.8288 1030.656 922.3808 1030.656 892.4288 1000.704L730.0608 838.336C728.1408 836.416 727.4368 833.92 725.7728 831.872 546.3168 960.448 295.7568 945.408 134.5408 784.192-44.8512 604.8-44.8512 313.92 134.5408 134.528 313.9328-44.864 604.8128-44.864 784.2048 134.528 945.4208 295.744 960.4608 546.304 831.8848 725.76 833.9328 727.424 836.4288 728.128 838.3488 730.048L1000.7168 892.48Z" HorizontalAlignment="Left" />
<local:MyIconButton x:Name="BtnClear" IsHitTestVisible="False" Opacity="0" Width="24" Margin="0,0,10,0" LogoScale="0.75" Height="24" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" HorizontalAlignment="Right" Theme="Black" />
</Grid>
</local:MyCard>
Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb
+42
View File
@@ -0,0 +1,42 @@
Class MySearchBox
Inherits MyCard
Public Event TextChanged(ByVal sender As Object, ByVal e As EventArgs)
Private Sub MySearchBox_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
TextBox.Focus()
End Sub
'属性
Public Property HintText() As String
Get
Return TextBox.HintText
End Get
Set(ByVal value As String)
TextBox.HintText = value
End Set
End Property
Public Property Text() As String
Get
Return TextBox.Text
End Get
Set(ByVal value As String)
TextBox.Text = value
End Set
End Property
Private Sub Text_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextBox.TextChanged
If String.IsNullOrEmpty(TextBox.Text) Then
AniStart(AaOpacity(BtnClear, -BtnClear.Opacity, 90), "MySearchBox ClearBtn " & Uuid)
BtnClear.IsHitTestVisible = False
Else
AniStart(AaOpacity(BtnClear, 1 - BtnClear.Opacity, 90), "MySearchBox ClearBtn " & Uuid)
BtnClear.IsHitTestVisible = True
End If
RaiseEvent TextChanged(sender, e)
End Sub
Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click
TextBox.Text = ""
TextBox.Focus()
End Sub
End Class
Plain Craft Launcher 2/Controls/MySlider.xaml
+27
View File
@@ -0,0 +1,27 @@
<Border x:Class="MySlider"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
mc:Ignorable="d"
d:DesignHeight="16" d:DesignWidth="162"
FocusVisualStyle="{x:Null}"
MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush1}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<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="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" />
<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.RenderTransform>
<ScaleTransform />
</Ellipse.RenderTransform>
</Ellipse>
<Popup Name="Popup" AllowsTransparency="True" IsHitTestVisible="False" PopupAnimation="Fade" VerticalOffset="38" HorizontalOffset="{Binding Margin.Left, ElementName=ShapeDot}" Placement="Center" PlacementRectangle="8,0,0,0">
<Border BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="3" MaxWidth="500" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.4" BlurRadius="4" ShadowDepth="2" />
</Border.Effect>
<TextBlock Name="TextHint" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</Popup>
</Grid>
</Border>
Plain Craft Launcher 2/Controls/MySlider.xaml.vb
+177
View File
@@ -0,0 +1,177 @@
Public Class MySlider
'基础
Public Uuid As Integer = GetUuid()
Public Event Change(sender As Object, user As Boolean)
Public Event PreviewChange(sender As Object, e As RouteEventArgs)
'自定义属性
Private _MaxValue As Integer = 100
Public Property MaxValue As Integer
Get
Return _MaxValue
End Get
Set(value As Integer)
If value = _MaxValue Then Exit Property
_MaxValue = value
RefreshWidth(Nothing, Nothing)
End Set
End Property
Private ChangeByKey As Boolean = False
Private _Value As Integer = 0
Public Property Value As Integer
Get
Return _Value
End Get
Set(newValue As Integer)
Try
newValue = MathRange(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
'触发 Preview 事件，修改新值
Dim OldValue = _Value
_Value = newValue
If AniControlEnabled = 0 Then
Dim e = New RouteEventArgs(False)
RaiseEvent PreviewChange(Me, e)
If e.Handled Then
_Value = OldValue
DragStop()
Exit Property
End If
End If
If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualWidth < 16 Then Exit Property
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16)
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - 16) - _Value / MaxValue)
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
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(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)),
AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
}, "MySlider Progress " & Uuid)
Else
RefreshWidth(Nothing, Nothing)
End If
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
Catch ex As Exception
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
End Try
End Set
End Property
Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width
AniStop("MySlider Progress " & Uuid)
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16)
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))
SetLeft(ShapeDot, NewWidth)
End Sub
'拖动
Public GetHintText As [Delegate]
Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
e.Handled = True '防止 ScrollViewer 失焦问题
DragControl = Me
FrmMain.DragDoing()
AniStart({
AaScaleTransform(ShapeDot, 0.8 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 75,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid)
'更新 Popup
If GetHintText IsNot Nothing Then
TextHint.Text = GetHintText.DynamicInvoke(Value)
Popup.IsOpen = True
AniStop("MySlider KeyPopup " & Uuid)
End If
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - 8) / (ActualWidth - 16), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
End If
'更新 Popup
If GetHintText IsNot Nothing Then TextHint.Text = GetHintText.DynamicInvoke(NewValue)
End Sub
Public Sub DragStop()
RefreshColor()
AniStart({
AaScaleTransform(ShapeDot, 1 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid)
If GetHintText IsNot Nothing Then Popup.IsOpen = False
End Sub
'指向动画
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave
Try
'判断当前颜色
Dim ColorName As String
Dim AnimationTime As Integer
If IsEnabled Then
If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then
ColorName = "ColorBrush3"
AnimationTime = 100
Else
ColorName = "ColorBrush1"
AnimationTime = 200
End If
Else
ColorName = "ColorBrushGray4"
AnimationTime = 200
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid)
Else
'无动画
AniStop("MySlider Color " & Uuid)
SetResourceReference(BorderBrushProperty, ColorName)
End If
Catch ex As Exception
Log(ex, "滑动条颜色改变出错")
End Try
End Sub
'按键改变
Public Property ValueByKey As UInteger = 1
Private Sub MySlider_MouseEnter() Handles Me.MouseEnter
Focus() '确保按键能改变值
End Sub
Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
'拒绝一边拖动一边用按键改变
If ReferenceEquals(Me, DragControl) Then Exit Sub
'改变值
If e.Key = Key.Left Then
ChangeByKey = True
Value -= ValueByKey
ChangeByKey = False
e.Handled = True
ElseIf e.Key = Key.Right Then
ChangeByKey = True
Value += ValueByKey
ChangeByKey = False
e.Handled = True
Else
Exit Sub
End If
'更新 Popup
If GetHintText IsNot Nothing Then
TextHint.Text = GetHintText.DynamicInvoke(Value)
Popup.IsOpen = True
AniStop("MySlider KeyPopup " & Uuid)
AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid)
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MySliderDot.xaml
+19
View File
@@ -0,0 +1,19 @@
<Border x:Class="MySliderDot"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
mc:Ignorable="d"
d:DesignWidth="16" d:DesignHeight="162"
FocusVisualStyle="{x:Null}"
MinWidth="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush1}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<Grid x:Name="PanMain" MinWidth="16" MaxWidth="16" RenderTransformOrigin="0.5,0.5">
<Line IsHitTestVisible="False" Width="0" Name="LineBack" Stroke="{StaticResource ColorBrushGray5}" StrokeThickness="1.5" Y2="10000" X1="2" X2="2" VerticalAlignment="Bottom" Height="0" SnapsToDevicePixels="True" Margin="0,0,0,1" />
<Line IsHitTestVisible="False" Width="0" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1.5" Y2="10000" X1="2" X2="2" Height="0" VerticalAlignment="Top" SnapsToDevicePixels="True" Margin="0,1,0,0" />
<Ellipse IsHitTestVisible="True" VerticalAlignment="Top" Height="16" Stroke="White" StrokeThickness="1.5" Fill="{DynamicResource ColorBrush3}" Name="ShapeDot" Width="16" HorizontalAlignment="Center" RenderTransformOrigin="0.5,0.5" Opacity="0.8">
<Ellipse.RenderTransform>
<ScaleTransform ScaleX="2.3" ScaleY="2.3" />
</Ellipse.RenderTransform>
</Ellipse>
</Grid>
</Border>
Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb
+169
View File
@@ -0,0 +1,169 @@
Public Class MySliderDot
'基础
Public Uuid As Integer = GetUuid()
Public Event Change(sender As Object, user As Boolean)
Public Event PreviewChange(sender As Object, e As RouteEventArgs)
'自定义属性
Private _MaxValue As Integer = 100
Public Property MaxValue As Integer
Get
Return _MaxValue
End Get
Set(value As Integer)
If value = _MaxValue Then Exit Property
_MaxValue = value
RefreshHeight(Nothing, Nothing)
End Set
End Property
Private ChangeByKey As Boolean = False
Private _Value As Integer = 0
Public Property Value As Integer
Get
Return _Value
End Get
Set(newValue As Integer)
Try
newValue = MathRange(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
'触发前瞻事件，修改新值
Dim OldValue = _Value
_Value = newValue
If AniControlEnabled = 0 Then
Dim e = New RouteEventArgs(False)
RaiseEvent PreviewChange(Me, e)
If e.Handled Then
_Value = OldValue
Exit Property
End If
End If
If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualHeight < 16 Then Exit Property
Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16)
Dim DeltaProcess As Double = Math.Abs(LineFore.Height / (ActualHeight - 16) - _Value / MaxValue)
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 400 + If(ChangeByKey, 100, 0)
AniStart({
AaHeight(LineFore, Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5)) - LineFore.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaHeight(LineBack, Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5)) - LineBack.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaY(ShapeDot, NewHeight - ShapeDot.Margin.Top, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
}, "MySlider Progress " & Uuid)
Else
RefreshHeight(Nothing, Nothing)
End If
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
Catch ex As Exception
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
End Try
End Set
End Property
Private Sub RefreshHeight(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not IsNothing(e) Then PanMain.Height = e.NewSize.Height
AniStop("MySlider Progress " & Uuid)
Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16)
LineFore.Height = Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5))
LineBack.Height = Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5))
SetTop(ShapeDot, NewHeight)
End Sub
'拖动
Public GetHintText As [Delegate]
Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles ShapeDot.MouseLeftButtonDown
e.Handled = True '防止 ScrollViewer 失焦问题
DragControl = Me
AniStart({
AaScaleTransform(ShapeDot, 2 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid)
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).Y - 8) / (ActualHeight - 16), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then Value = NewValue
End Sub
Public Sub DragStop()
RefreshColor()
AniStart({
AaScaleTransform(ShapeDot, 2.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid)
If Value > 0 Then
Value = MaxValue
Else
FrmMain.SliderDrag_Finish()
End If
End Sub
'指向动画
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave
'Try
' '判断当前颜色
' Dim ColorName As String
' Dim AnimationTime As Integer
' If IsEnabled Then
' If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then
' ColorName = "ColorBrush3"
' AnimationTime = 100
' Else
' ColorName = "ColorBrush1"
' AnimationTime = 200
' End If
' Else
' ColorName = "ColorBrushGray4"
' AnimationTime = 200
' End If
' '触发颜色动画
' If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
' '有动画
' AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid)
' Else
' '无动画
' AniStop("MySlider Color " & Uuid)
' SetResourceReference(BorderBrushProperty, ColorName)
' End If
'Catch ex As Exception
' Log(ex, "滑动条颜色改变出错")
'End Try
End Sub
'按键改变
'Public Property ValueByKey As UInteger = 1
'Private Sub MySlider_MouseEnter() Handles Me.MouseEnter
' Focus() '确保按键能改变值
'End Sub
'Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
' '拒绝一边拖动一边用按键改变
' If ReferenceEquals(Me, DragControl) Then Exit Sub
' '改变值
' If e.Key = Key.Left Then
' ChangeByKey = True
' Value -= ValueByKey
' ChangeByKey = False
' e.Handled = True
' ElseIf e.Key = Key.Right Then
' ChangeByKey = True
' Value += ValueByKey
' ChangeByKey = False
' e.Handled = True
' Else
' Exit Sub
' End If
' '更新 Popup
' If GetHintText IsNot Nothing Then
' TextHint.Text = GetHintText.DynamicInvoke(Value)
' Popup.IsOpen = True
' AniStop("MySlider KeyPopup " & Uuid)
' AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid)
' End If
'End Sub
End Class
Plain Craft Launcher 2/Controls/MyTextBox.vb
+277
View File
@@ -0,0 +1,277 @@
Public Class MyTextBox
Inherits TextBox
'自定义属性
Public Property HasAnimation As Boolean = True
Public Property ShowValidateResult As Boolean = True
'额外控件初始化
Private _labWrong As TextBlock = Nothing
Private ReadOnly Property labWrong As TextBlock
Get
If Template Is Nothing Then Return Nothing
If _labWrong Is Nothing Then _labWrong = Template.FindName("labWrong", Me)
Return _labWrong
End Get
End Property
Private _labHint As TextBlock = Nothing
Private ReadOnly Property labHint As TextBlock
Get
If Template Is Nothing Then Return Nothing
If _labHint Is Nothing Then _labHint = Template.FindName("labHint", Me)
Return _labHint
End Get
End Property
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If HintText = "" OrElse labHint.Text <> "" Then Exit Sub
labHint.Text = If(Text = "", HintText, "")
End Sub
'事件
Public Uuid As Integer = GetUuid()
Public Shared Event ValidateChanged(sender As Object, e As EventArgs)
Public ChangedEventList As New List(Of RoutedEventHandler)
Public Custom Event ValidatedTextChanged As RoutedEventHandler
AddHandler(value As RoutedEventHandler)
ChangedEventList.Add(value)
End AddHandler
RemoveHandler(value As RoutedEventHandler)
ChangedEventList.Remove(value)
End RemoveHandler
RaiseEvent(sender As Object, e As TextChangedEventArgs)
For Each handler As RoutedEventHandler In ChangedEventList
If Not IsNothing(handler) Then handler.Invoke(sender, e)
Next
End RaiseEvent
End Event
'输入验证
''' <summary>
''' 输入验证结果。若为空字符串则无错误，否则为第一个错误原因。
''' </summary>
Public Property ValidateResult As String
Get
Return GetValue(ValidateResultProperty)
End Get
Set(value As String)
SetValue(ValidateResultProperty, value)
End Set
End Property
Public Shared ReadOnly ValidateResultProperty As DependencyProperty = DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata(""))
''' <summary>
''' 输入验证的规则。
''' </summary>
Public Property ValidateRules As ObjectModel.Collection(Of Validate)
Get
Return _ValidateRules
End Get
Set(Value As ObjectModel.Collection(Of Validate))
_ValidateRules = Value
Validate()
End Set
End Property
Private _ValidateRules As New ObjectModel.Collection(Of Validate)
''' <summary>
''' 进行输入验证。
''' </summary>
Public Sub Validate() Handles Me.Loaded
'执行输入验证
ValidateResult = ""
For Each ValidateRule As Validate In ValidateRules
ValidateResult = ValidateRule.Validate(Text)
If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For
Next
Dim NewResult As Integer = If(ValidateResult = "", 0, 1)
'根据结果改变样式
If ShownValidateResult <> NewResult Then
If IsLoaded AndAlso labWrong IsNot Nothing Then
ChangeValidateResult(ValidateResult = "", True)
Else
RunInNewThread(Sub()
Thread.Sleep(30)
RunInUi(Sub() ChangeValidateResult(NewResult, False))
End Sub, "DelayedValidate Change")
End If
End If
'更新错误信息
If ShowValidateResult AndAlso Not ValidateResult = "" Then
If IsLoaded AndAlso labWrong IsNot Nothing Then
labWrong.Text = ValidateResult
Else
RunInNewThread(Sub()
Dim IsFinished As Boolean = False
Do Until IsFinished
Thread.Sleep(20)
RunInUiWait(Sub()
If labWrong IsNot Nothing Then
labWrong.Text = ValidateResult
IsFinished = True
End If
If Not IsLoaded Then IsFinished = True
End Sub)
Loop
End Sub, "DelayedValidate Text")
End If
End If
End Sub
Private ShownValidateResult As Integer = -1
Private Sub ChangeValidateResult(NewResult As Boolean, IsLoaded As Boolean)
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso IsTextChanged AndAlso labWrong IsNot Nothing Then
If NewResult Then
'变为正确
ShownValidateResult = 0
AniStart({
AaOpacity(labWrong, -labWrong.Opacity, 150),
AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent),
AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True)
}, "MyTextBox Validate " & Uuid)
ElseIf ShowValidateResult Then
'变为错误
ShownValidateResult = 1
labWrong.Visibility = Visibility.Visible
AniStart({
AaOpacity(labWrong, 1 - labWrong.Opacity, 170),
AaHeight(labWrong, 21 - labWrong.Height, 300,, New AniEaseOutBack(AniEasePower.Weak))
}, "MyTextBox Validate " & Uuid)
Else
'变为错误，但不显示文本
ShownValidateResult = 2
End If
Else
ShownValidateResult = 3
'AniStop("MyTextBox Validate " & Uuid)
'If NewResult Then
' '变为正确
' labWrong.Opacity = 0
' labWrong.Height = 0
' labWrong.Visibility = Visibility.Collapsed
'Else
' '变为错误
' labWrong.Visibility = Visibility.Visible
' labWrong.Text = ValidateResult
' labWrong.Opacity = 1
' labWrong.Height = 20.5
'End If
'Dim OriginalEnabled As Integer = AniControlEnabled
'AniControlEnabled += 1
'RefreshColor()
'AniControlEnabled = OriginalEnabled
End If
RefreshColor()
RaiseEvent ValidateChanged(Me, New EventArgs)
End Sub
'提示文本
''' <summary>
''' 是否已经由用户输入过文本，若尚未输入过，则不显示输入检查的失败。
''' </summary>
Private IsTextChanged As Boolean = False
Private _HintText As String = ""
Public Property HintText As String
Get
Return _HintText
End Get
Set(value As String)
_HintText = value
If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "")
End Set
End Property
Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged
Try
'改变提示文本
If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "")
'改变输入记录
IsTextChanged = IsLoaded
'进行输入验证
Validate()
If Not ValidateResult = "" Then Exit Sub
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", LogLevel.Assert)
End Try
End Sub
'颜色
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
Try
'手动关闭动画
If Not HasAnimation Then Exit Sub
'不对 ComboBox 从属进行动画
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
'判断当前颜色
Dim ForeColorName As String, BackColorName As String
Dim AnimationTime As Integer
If IsEnabled Then
If ValidateResult = "" OrElse Not IsTextChanged Then
If IsFocused Then
ForeColorName = "ColorBrush4"
BackColorName = "ColorBrush9"
AnimationTime = 60
ElseIf IsMouseOver Then
ForeColorName = "ColorBrush3"
BackColorName = "ColorBrushHalfWhite"
AnimationTime = 100
Else
ForeColorName = "ColorBrush1"
BackColorName = "ColorBrushHalfWhite"
AnimationTime = 200
End If
Else
ForeColorName = "ColorBrushRedLight"
BackColorName = "ColorBrushRedBack"
AnimationTime = 200
'If IsFocused OrElse IsMouseOver Then
' ForeColorName = "ColorBrushRedLight"
' BackColorName = "ColorBrushRedBack"
' AnimationTime = 100
'Else
' ForeColorName = "ColorBrushRedDark"
' BackColorName = "ColorBrushHalfWhite"
' AnimationTime = 200
'End If
End If
Else
ForeColorName = "ColorBrushGray4"
BackColorName = "ColorBrushHalfWhite"
AnimationTime = 200
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime)，
AaColor(Me, BackgroundProperty, BackColorName, AnimationTime)
}, "MyTextBox Color " & Uuid)
Else
'无动画
AniStop("MyTextBox Color " & Uuid)
SetResourceReference(BorderBrushProperty, ForeColorName)
SetResourceReference(BackgroundProperty, BackColorName)
End If
Catch ex As Exception
Log(ex, "文本框颜色改变出错")
End Try
End Sub
Private Sub RefreshTextColor() Handles Me.IsEnabledChanged
Dim NewColor As MyColor = If(IsEnabled, ColorGray1, ColorGray4)
If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Exit Sub
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then
'有动画
AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid)
Else
'无动画
AniStop("MyTextBox TextColor " & Uuid)
Foreground = NewColor
End If
End Sub
End Class
Plain Craft Launcher 2/Controls/MyTextButton.vb
+110
View File
@@ -0,0 +1,110 @@
Public Class MyTextButton
Inherits Label
Public Event Click(sender As Object, e As EventArgs)
'基础
Public Uuid As Integer = GetUuid()
Public Sub New()
SetResourceReference(ForegroundProperty, "ColorBrush1")
Background = ColorSemiTransparent
End Sub
'文本
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property
Public Shared ReadOnly TextProperty As DependencyProperty =
DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("", Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
If Not e.OldValue = e.NewValue Then
AniStart({
AaOpacity(sender, -sender.Opacity, 50),
AaCode(Sub() sender.Content = e.NewValue,, True),
AaOpacity(sender, 1, 170)
}, "MyTextButton Text " & sender.Uuid)
End If
End Sub))
'鼠标事件
Public IsMouseDown As Boolean = False
Private Sub MyTextButton_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
IsMouseDown = True
e.Handled = True
End Sub
Private Sub MyTextButton_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False
End Sub
Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
IsMouseDown = False
Log("[Control] 按下文本按钮：" & Text)
RaiseEvent Click(Me, Nothing)
ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True
End If
End Sub
'指向动画
Private Const AnimationTimeIn As Integer = 100
Private Const AnimationTimeOut As Integer = 200
Private ColorName As String
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown， Me.MouseLeftButtonUp
'判断当前颜色
Dim ForeName As String
Dim Time As Integer
If IsMouseDown Then
ForeName = "ColorBrush4"
Time = 30
ElseIf IsMouseOver Then
ForeName = "ColorBrush3"
Time = AnimationTimeIn
Else
ForeName = "ColorBrush1"
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = ForeName Then Exit Sub
ColorName = ForeName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart(AaColor(Me, ForegroundProperty, ForeName, Time), "MyTextButton Color " & Uuid)
Else
'无动画
AniStop("MyTextButton Color " & Uuid)
SetResourceReference(ForegroundProperty, ForeName)
End If
End Sub
'实现自定义事件
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(ByVal value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(ByVal value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
End Class
Plain Craft Launcher 2/FormMain.xaml
+179
View File
@@ -0,0 +1,179 @@
<Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher 2　" AllowsTransparency="True" MinHeight="450" MinWidth="760" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" Left="-10000" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
<Window.TaskbarItemInfo>
<TaskbarItemInfo ThumbnailClipMargin="{Binding Margin, ElementName=PanForm}" />
</Window.TaskbarItemInfo>
<Grid x:Name="PanBack" SnapsToDevicePixels="True" UseLayoutRounding="True" Margin="1" RenderTransformOrigin="0.5,0.5">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0.95" ScaleY="0.95" />
</Grid.RenderTransform>
<Rectangle x:Name="ResizerT" Stroke="{x:Null}" StrokeThickness="0.0001" Height="8" VerticalAlignment="Top" Margin="13,0" Cursor="SizeNS">
<Rectangle.Fill>
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">
<GradientStop Color="#21000000" Offset="1" />
<GradientStop Color="#11000000" Offset="0.7" />
<GradientStop Color="#00000000" Offset="0" />
</LinearGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerB" Stroke="{x:Null}" StrokeThickness="0.0001" Height="8" VerticalAlignment="Bottom" Margin="13,0" Cursor="SizeNS">
<Rectangle.Fill>
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">
<GradientStop Color="#21000000" Offset="0" />
<GradientStop Color="#11000000" Offset="0.3" />
<GradientStop Color="#00000000" Offset="1" />
</LinearGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerR" HorizontalAlignment="Right" Margin="0,13" Stroke="{x:Null}" StrokeThickness="0.0001" Width="8" Cursor="SizeWE">
<Rectangle.Fill>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop Color="#21000000" Offset="0" />
<GradientStop Color="#11000000" Offset="0.3" />
<GradientStop Color="#00000000" Offset="1" />
</LinearGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerL" HorizontalAlignment="Left" Stroke="{x:Null}" Width="8" Margin="0,13" StrokeThickness="0.0001" Cursor="SizeWE">
<Rectangle.Fill>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop Color="#21000000" Offset="1" />
<GradientStop Color="#11000000" Offset="0.7" />
<GradientStop Color="#00000000" Offset="0" />
</LinearGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerLT" HorizontalAlignment="Left" Stroke="{x:Null}" Width="13" StrokeThickness="0.0001" VerticalAlignment="Top" Height="13" Cursor="SizeNWSE">
<Rectangle.Fill>
<RadialGradientBrush Center="1,1" GradientOrigin="1,1" RadiusX="1" RadiusY="1">
<GradientStop Color="#21000000" Offset="0.2" />
<GradientStop Color="#00000000" Offset="1" />
</RadialGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerLB" HorizontalAlignment="Left" Stroke="{x:Null}" Width="13" StrokeThickness="0.0001" VerticalAlignment="Bottom" Height="13" Cursor="SizeNESW">
<Rectangle.Fill>
<RadialGradientBrush Center="1,0" GradientOrigin="1,0" RadiusX="1" RadiusY="1">
<GradientStop Color="#21000000" Offset="0.2" />
<GradientStop Color="#00000000" Offset="1" />
</RadialGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerRB" HorizontalAlignment="Right" Stroke="{x:Null}" Width="13" StrokeThickness="0.0001" VerticalAlignment="Bottom" Height="13" Cursor="SizeNWSE">
<Rectangle.Fill>
<RadialGradientBrush Center="0,0" GradientOrigin="0,0" RadiusX="1" RadiusY="1">
<GradientStop Color="#21000000" Offset="0.2" />
<GradientStop Color="#00000000" Offset="1" />
</RadialGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Rectangle x:Name="ResizerRT" HorizontalAlignment="Right" Stroke="{x:Null}" Width="13" StrokeThickness="0.0001" VerticalAlignment="Top" Height="13" Cursor="SizeNESW">
<Rectangle.Fill>
<RadialGradientBrush Center="0,1" GradientOrigin="0,1" RadiusX="1" RadiusY="1">
<GradientStop Color="#21000000" Offset="0.2" />
<GradientStop Color="#00000000" Offset="1" />
</RadialGradientBrush>
</Rectangle.Fill>
</Rectangle>
<Border Margin="8" x:Name="BorderForm">
<Border.Clip>
<RectangleGeometry x:Name="RectForm" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Grid x:Name="PanForm" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition />
</Grid.RowDefinitions>
<Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality" />
<Grid x:Name="PanTitle" Height="48">
<Grid.Background>
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0">
<GradientStop Color="{StaticResource ColorObject3}" Offset="0"/>
<GradientStop Color="{StaticResource ColorObject2}" Offset="0.5"/>
<GradientStop Color="{StaticResource ColorObject3}" Offset="1"/>
</LinearGradientBrush>
</Grid.Background>
<Image x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyIconButton x:Name="BtnTitleClose" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,12,0" Theme="White"
LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
<local:MyIconButton x:Name="BtnTitleMin" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,44,0" Theme="White"
LogoScale="0.72" Logo="F1 M0,0 h15 v2 h-15 v-2 Z" />
<Grid x:Name="PanTitleMain" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" />
<TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" />
<Image x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0">
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" />
<local:MyRadioButton x:Name="BtnTitleSelect1" Text="{DynamicResource LangTitleDownload}" Tag="1" Margin="5,0" Padding="2,0"
LogoScale="0.9" Logo="M955.076923 610.461538h-59.076923c-15.753846 0-29.538462 13.784615-29.538462 29.538462v196.923077c0 15.753846-13.784615 29.538462-29.538461 29.538461h-649.846154c-15.753846 0-29.538462-13.784615-29.538461-29.538461v-196.923077c0-15.753846-13.784615-29.538462-29.538462-29.538462h-59.076923c-15.753846 0-29.538462 13.784615-29.538462 29.538462V905.846154c0 43.323077 35.446154 78.769231 78.769231 78.769231h787.692308c43.323077 0 78.769231-35.446154 78.769231-78.769231V640c0-15.753846-13.784615-29.538462-29.538462-29.538462zM492.307692 740.430769c11.815385 11.815385 29.538462 11.815385 41.353846 0l265.846154-265.846154c11.815385-11.815385 11.815385-29.538462 0-41.353846l-41.353846-41.353846c-11.815385-11.815385-29.538462-11.815385-41.353846 0l-110.276923 110.276923c-11.815385 11.815385-33.476923 3.938462-33.476923-13.784615V68.923077C571.076923 53.169231 555.323077 39.384615 541.538462 39.384615h-59.076924c-15.753846 0-29.538462 13.784615-29.538461 29.538462v417.476923c0 17.723077-21.661538 25.6-33.476923 13.784615l-110.276923-110.276923c-11.815385-11.815385-29.538462-11.815385-41.353846 0L226.461538 433.230769c-11.815385 11.815385-11.815385 29.538462 0 41.353846L492.307692 740.430769z" />
<local:MyRadioButton x:Name="BtnTitleSelect2" Text="联机" Tag="2" Margin="5,0" Padding="2,0"
LogoScale="1.05" Logo="M512 817c-48.601 0-88-39.399-88-88s39.399-88 88-88 88 39.399 88 88-39.399 88-88 88zM237.671 565.74C308.335 474.58 397.369 429 504.774 429c118.433 0 214.225 55.421 287.377 166.264l-53.407 30.369c-13.84 7.87-31.362 4.367-41.114-8.219-50.291-64.911-114.577-97.367-192.856-97.367-86.851 0-156.835 40.318-209.95 120.953l-47.995-28.02c-15.263-8.91-20.412-28.507-11.502-43.77a32 32 0 0 1 2.344-3.47zM107.691 419.47C205.24 278.491 337.805 208 505.379 208c178.77 0 317.694 80.224 416.772 240.672l-56.54 31.73c-13.686 7.68-30.922 4.303-40.697-7.975C735.581 360.213 629.07 303.009 505.38 300.815 373.997 298.485 261.637 362.88 168.3 494l-50.116-28.505c-15.362-8.738-20.732-28.275-11.994-43.637a32 32 0 0 1 1.5-2.387z"/>
<local:MyRadioButton x:Name="BtnTitleSelect3" Text="{DynamicResource LangTitleSetup}" Tag="3" Margin="5,0" Padding="2,0"
LogoScale="1.1" Logo="M940.4 463.7L773.3 174.2c-17.3-30-49.2-48.4-83.8-48.4H340.2c-34.6 0-66.5 18.5-83.8 48.4L89.2 463.7c-17.3 30-17.3 66.9 0 96.8L256.4 850c17.3 30 49.2 48.4 83.8 48.4h349.2c34.6 0 66.5-18.5 83.8-48.4l167.2-289.5c17.3-29.9 17.3-66.8 0-96.8z m-94.6 96.8L725.9 768.1c-17.3 30-49.2 48.4-83.8 48.4H387.5c-34.6 0-66.5-18.5-83.8-48.4L183.9 560.5c-17.3-30-17.3-66.9 0-96.8l119.8-207.5c17.3-30 49.2-48.4 83.8-48.4h254.6c34.6 0 66.5 18.5 83.8 48.4l119.8 207.5c17.3 30 17.3 66.9 0.1 96.8z M522.3 321.2c-2.5-0.1-5-0.2-7.5-0.2-119.9 0-214 110.3-186.3 235 15.8 70.9 71.5 126.6 142.4 142.4 17.5 3.9 34.7 5.4 51.4 4.7 102.1-3.9 183.6-87.9 183.6-191 0.1-103-81.5-187-183.6-190.9z m68.6 269.1c-18.5 18-43 28.9-68.6 30.7l-6 0.3c-30.2 0.4-58.6-11.4-79.7-33-19.5-20.1-30.7-47-30.9-75-0.3-29.6 11.1-57.4 32-78.3 20.6-20.6 48-32 77.2-32 2.5 0 5 0.1 7.5 0.3 26.7 1.8 51.5 13.2 70.5 32.5 19.6 20 30.8 46.9 31.2 74.9 0.2 30.2-11.5 58.6-33.2 79.6z"/>
<local:MyRadioButton x:Name="BtnTitleSelect4" Text="{DynamicResource LangTitleOther}" Tag="4" Margin="5,0" Padding="2,0"
LogoScale="0.93" Logo="M364.145778 0h-273.066667C40.846222 0 0 40.846222 0 91.022222v273.066667C0 414.264889 40.846222 455.111111 91.136 455.111111h273.066667C414.321778 455.111111 455.111111 414.264889 455.111111 364.032V91.022222C455.111111 40.846222 414.321778 0 364.145778 0zM341.333333 341.333333H113.777778V113.777778h227.555555v227.555555zM933.034667 0h-273.066667C609.792 0 568.888889 40.846222 568.888889 91.022222v273.066667c0 50.176 40.903111 91.022222 91.136 91.022222h273.066667C983.210667 455.111111 1024 414.264889 1024 364.032V91.022222c0-50.176-40.789333-91.022222-90.965333-91.022222zM910.222222 341.333333h-227.555555V113.777778h227.555555v227.555555zM364.145778 568.888889h-273.066667C40.846222 568.888889 0 609.735111 0 659.911111v273.066667c0 50.176 40.846222 91.022222 91.136 91.022222h273.066667C414.321778 1024 455.111111 983.153778 455.111111 932.920889v-273.066667C455.111111 609.735111 414.321778 568.888889 364.145778 568.888889zM341.333333 910.222222H113.777778v-227.555555h227.555555v227.555555zM933.034667 568.888889h-273.066667c-50.176 0-91.079111 40.846222-91.079111 91.022222v273.066667c0 50.176 40.903111 91.022222 91.136 91.022222h273.066667c50.119111 0 90.908444-40.846222 90.908444-91.079111v-273.066667c0-50.119111-40.789333-90.965333-90.965333-90.965333zM910.222222 910.222222h-227.555555v-227.555555h227.555555v227.555555z"/>
</StackPanel>
</Grid>
<Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
<local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28"
LogoScale="0.87" Logo="M1097.162313 584.707482 250.272424 584.707482 562.833701 896.95123C591.749274 925.859979 591.749274 972.659975 562.833701 1001.568724 533.91812 1030.477473 487.058315 1030.477473 458.142742 1001.568724L21.580946 565.451235C6.757449 550.631234-0.361728 531.131238 0.028357 511.679985L0.028357 511.631236 0.028357 511.582486C-0.361728 492.13124 6.757449 472.582488 21.580946 457.762487L458.142742 21.644997C487.058315-7.215002 533.91812-7.215002 562.833701 21.644997 591.749274 50.553746 591.749274 97.4025 562.833701 126.262499L250.272424 438.55499 1097.162313 438.55499C1137.585605 438.55499 1170.304578 471.266238 1170.304578 511.631236 1170.304578 551.947483 1137.585605 584.707482 1097.162313 584.707482L1097.162313 584.707482Z" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,0,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
</Grid>
</Grid>
<Grid x:Name="PanLeft" Grid.Row="1" HorizontalAlignment="Left" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto"/>
<ColumnDefinition Width="1*"/>
</Grid.ColumnDefinitions>
<Rectangle x:Name="RectLeftBackground" Width="0" Fill="{DynamicResource ColorBrushBackgroundTransparentSidebar}" IsHitTestVisible="False" />
<Rectangle x:Name="RectLeftShadow" Width="4" HorizontalAlignment="Left" IsHitTestVisible="False" Grid.Column="1" >
<Rectangle.Fill>
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.085">
<GradientStop Color="#000000" Offset="0"/>
<GradientStop Color="#00000000" Offset="1"/>
</LinearGradientBrush>
</Rectangle.Fill>
</Rectangle>
</Grid>
<Grid x:Name="PanMain" Grid.Row="1" HorizontalAlignment="Left" VerticalAlignment="Top">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto"/>
<ColumnDefinition Width="1*"/>
</Grid.ColumnDefinitions>
<Border Grid.Column="1" Grid.IsSharedSizeScope="True" UseLayoutRounding="True" SnapsToDevicePixels="True">
<Border x:Name="PanMainRight" RenderOptions.BitmapScalingMode="NearestNeighbor" UseLayoutRounding="False" SnapsToDevicePixels="False">
</Border>
</Border>
<Border Grid.IsSharedSizeScope="True" UseLayoutRounding="True" SnapsToDevicePixels="True">
<Border x:Name="PanMainLeft" RenderOptions.BitmapScalingMode="NearestNeighbor" UseLayoutRounding="False" SnapsToDevicePixels="False">
</Border>
</Border>
</Grid>
<StackPanel x:Name="PanHint" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" IsHitTestVisible="False" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<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" />
<local:MyExtraButton x:Name="BtnExtraDownload" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="下载管理" Visibility="Collapsed"
Logo="M955.076923 610.461538h-59.076923c-15.753846 0-29.538462 13.784615-29.538462 29.538462v196.923077c0 15.753846-13.784615 29.538462-29.538461 29.538461h-649.846154c-15.753846 0-29.538462-13.784615-29.538461-29.538461v-196.923077c0-15.753846-13.784615-29.538462-29.538462-29.538462h-59.076923c-15.753846 0-29.538462 13.784615-29.538462 29.538462V905.846154c0 43.323077 35.446154 78.769231 78.769231 78.769231h787.692308c43.323077 0 78.769231-35.446154 78.769231-78.769231V640c0-15.753846-13.784615-29.538462-29.538462-29.538462zM492.307692 740.430769c11.815385 11.815385 29.538462 11.815385 41.353846 0l265.846154-265.846154c11.815385-11.815385 11.815385-29.538462 0-41.353846l-41.353846-41.353846c-11.815385-11.815385-29.538462-11.815385-41.353846 0l-110.276923 110.276923c-11.815385 11.815385-33.476923 3.938462-33.476923-13.784615V68.923077C571.076923 53.169231 555.323077 39.384615 541.538462 39.384615h-59.076924c-15.753846 0-29.538462 13.784615-29.538461 29.538462v417.476923c0 17.723077-21.661538 25.6-33.476923 13.784615l-110.276923-110.276923c-11.815385-11.815385-29.538462-11.815385-41.353846 0L226.461538 433.230769c-11.815385 11.815385-11.815385 29.538462 0 41.353846L492.307692 740.430769z" />
<local:MyExtraButton x:Name="BtnExtraApril" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="投降" Visibility="Collapsed"
Logo="M124.96 32c-28.64 0-60.064 23.2-60.064 51.904v856.192c0 28.576 30.688 51.904 59.296 51.904s60.064-23.328 60.064-51.904V83.904C184.256 55.2 153.536 32 124.96 32z m616.352 71.264c-168.416 0-168.416-69.024-336.8-69.024-97.216 0-172.256 45.344-172.256 45.344l-0.736 516.736s75.776-45.28 172.96-45.28c168.416 0 168.416 69.024 336.8 69.024 105.344 0 211.168-55.328 211.168-55.328V48.064c0.032 0-105.792 55.2-211.136 55.2z m0 0" />
<local:MyExtraButton x:Name="BtnExtraShutdown" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="关闭 Minecraft" Visibility="Collapsed"
Logo="M802.152 143.682c31.236 22.212 59.004 47.379 83.297 75.486 24.297 28.116 45.12 58.481 62.472 91.105 17.356 32.624 30.543 67.159 39.569 103.6 9.023 36.442 13.533 73.403 13.533 110.887 0 64.556-12.32 125.116-36.96 181.69-24.643 56.57-57.963 105.854-99.956 147.847-41.994 41.998-91.278 75.313-147.851 99.955-56.57 24.642-117.134 36.966-181.684 36.966-63.86 0-124.08-12.324-180.649-36.966-56.575-24.642-106.032-57.957-148.37-99.955-42.344-41.993-75.662-91.277-99.956-147.846C81.3 649.876 69.155 589.315 69.155 524.76c0-36.788 4.337-72.884 13.016-108.283 8.678-35.4 20.996-69.065 36.96-100.999 15.969-31.926 35.75-61.774 59.35-89.537 23.6-27.768 49.976-52.757 79.133-74.969 15.272-11.107 31.755-15.271 49.456-12.497 17.697 2.782 32.1 11.455 43.21 26.03 11.108 14.583 15.27 30.891 12.496 48.94-2.781 18.047-11.454 32.622-26.03 43.732-43.732 31.927-77.225 71.145-100.48 117.653-23.247 46.507-34.873 96.483-34.873 149.93 0 45.812 8.673 89.027 26.03 129.632 17.352 40.605 41.124 76.003 71.317 106.198 30.2 30.2 65.599 54.145 106.204 71.846 40.607 17.697 83.814 26.549 129.631 26.549 45.811 0 89.02-8.852 129.626-26.549 40.606-17.701 76.01-41.647 106.203-71.846 30.195-30.195 54.14-65.593 71.841-106.198 17.702-40.607 26.549-83.82 26.549-129.631 0-54.14-12.49-105.334-37.478-153.577-24.994-48.24-60.048-87.977-105.162-119.213-15.272-10.412-24.468-24.643-27.592-42.69-3.125-18.049 0.518-34.709 10.93-49.983 10.412-14.575 24.643-23.427 42.69-26.547 18.047-3.12 34.698 0.519 49.97 10.93zM534.57 527.888c-18.05 0-33.495-6.421-46.337-19.264-12.841-12.841-19.263-28.287-19.263-46.335V66.635c0-18.048 6.42-33.666 19.263-46.854C501.076 6.593 516.521 0 534.571 0c18.738 0 34.53 6.593 47.371 19.781 12.842 13.188 19.263 28.806 19.263 46.854v395.654c0 18.047-6.42 33.493-19.263 46.335-12.842 12.843-28.633 19.264-47.371 19.264z" />
<local:MyExtraButton x:Name="BtnExtraMusic" HorizontalAlignment="Right" VerticalAlignment="Center" Visibility="Collapsed" CanRightClick="True" />
</StackPanel>
<Grid x:Name="PanMsg" Grid.RowSpan="2" Background="#00000000" Visibility="Collapsed" />
</Grid>
</Border>
</Grid>
</Window>
Plain Craft Launcher 2/FormMain.xaml.vb
+1509
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/GlobalSuppressions.vb
+12
View File
@@ -0,0 +1,12 @@
' This file is used by Code Analysis to maintain SuppressMessage
' attributes that are applied to this project.
' Project-level suppressions either have no target or are given
' a specific target and scoped to a namespace, type, member, etc.
Imports System.Diagnostics.CodeAnalysis
<Assembly: SuppressMessage("样式", "IDE0060:删除未使用的参数", Justification:="<挂起>")>
<Assembly: SuppressMessage("样式", "IDE0058:永远不会使用表达式值", Justification:="<挂起>")>
<Assembly: SuppressMessage("样式", "IDE0044:添加只读修饰符", Justification:="<挂起>")>
<Assembly: SuppressMessage("样式", "IDE1006:命名样式", Justification:="<挂起>")>
<Assembly: SuppressMessage("样式", "IDE0010:添加开关", Justification:="<挂起>")>
Plain Craft Launcher 2/Images/Blocks/Anvil.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 880 B

Plain Craft Launcher 2/Images/Blocks/CobbleStone.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 991 B

Plain Craft Launcher 2/Images/Blocks/CommandBlock.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.7 KiB

Plain Craft Launcher 2/Images/Blocks/Egg.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 231 B

Plain Craft Launcher 2/Images/Blocks/Fabric.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 275 B

Plain Craft Launcher 2/Images/Blocks/GoldBlock.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

Plain Craft Launcher 2/Images/Blocks/Grass.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

Plain Craft Launcher 2/Images/Blocks/GrassPath.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

Plain Craft Launcher 2/Images/Blocks/OptiFabric.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 521 B

Plain Craft Launcher 2/Images/Blocks/RedstoneBlock.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 791 B

Plain Craft Launcher 2/Images/Blocks/RedstoneLampOff.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.0 KiB

Plain Craft Launcher 2/Images/Blocks/RedstoneLampOn.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 815 B

Plain Craft Launcher 2/Images/Heads/00ll00.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 332 B

Plain Craft Launcher 2/Images/Heads/DoodleHuang.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

Plain Craft Launcher 2/Images/Heads/Hao_Tian.jpg
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.6 KiB

Plain Craft Launcher 2/Images/Heads/LTCat.jpg
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

Plain Craft Launcher 2/Images/Heads/Logo.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.7 KiB

Plain Craft Launcher 2/Images/Heads/MCBBS.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 715 B

Plain Craft Launcher 2/Images/Heads/PCL2.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.7 KiB

Plain Craft Launcher 2/Images/Heads/Patrick.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.8 KiB

Plain Craft Launcher 2/Images/Heads/bangbang93.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.3 KiB

Plain Craft Launcher 2/Images/Heads/noin.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 434 B

Plain Craft Launcher 2/Images/Heads/wiki.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 345 B

Plain Craft Launcher 2/Images/Icons/A.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 963 B

Plain Craft Launcher 2/Images/Icons/B.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

Plain Craft Launcher 2/Images/Icons/NoIcon.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 312 B

Plain Craft Launcher 2/Images/Icons/R.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

Plain Craft Launcher 2/Images/Skins/Alex.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

Plain Craft Launcher 2/Images/Skins/Steve.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

Plain Craft Launcher 2/Images/Themes/10.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

Plain Craft Launcher 2/Images/Themes/11.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.0 KiB

Plain Craft Launcher 2/Images/Themes/12.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 24 KiB

Plain Craft Launcher 2/Images/Themes/13.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 18 KiB

Plain Craft Launcher 2/Images/Themes/42.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.0 KiB

Plain Craft Launcher 2/Images/Themes/5.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 24 KiB

Plain Craft Launcher 2/Images/Themes/6.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 16 KiB

Plain Craft Launcher 2/Images/Themes/7.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

Plain Craft Launcher 2/Images/Themes/8.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

Plain Craft Launcher 2/Images/Themes/9.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 21 KiB

Plain Craft Launcher 2/Images/icon.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 195 KiB

Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+1003
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+2471
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+700
View File
@@ -0,0 +1,700 @@
Public Module ModLoader
'各类加载器
''' <summary>
''' 加载器的统一基类。
''' </summary>
Public MustInherit Class LoaderBase
Implements ILoadingTrigger
Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader
'基础属性
''' <summary>
''' 加载器的标识编号。
''' </summary>
Public Uuid As Integer = GetUuid()
''' <summary>
''' 加载器的名称。
''' </summary>
Public Name As String = "未命名任务 " & Uuid & "#"
''' <summary>
''' 用于状态改变检测的同步锁。
''' </summary>
Public ReadOnly LockState As New Object
''' <summary>
''' 父加载器。
''' </summary>
Public Parent As LoaderBase = Nothing
''' <summary>
''' 最上级的加载器。
''' </summary>
Public ReadOnly Property RealParent As LoaderBase
Get
Try
RealParent = Parent
While RealParent IsNot Nothing AndAlso RealParent.Parent IsNot Nothing
RealParent = RealParent.Parent
End While
Catch ex As Exception
Log(ex, "获取父加载器失败（" & Name & "）", LogLevel.Feedback)
Return Nothing
End Try
End Get
End Property
Public Overridable Sub InitParent(Parent As LoaderBase)
Me.Parent = Parent
End Sub
'事件
''' <summary>
''' 当状态改变时，在工作线程触发代码。在添加事件后，必须将 HasOnStateChangedThread 设为 True。
''' </summary>
Public Event OnStateChangedThread(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
Public HasOnStateChangedThread As Boolean = False
''' <summary>
''' 当状态改变时，在 UI 线程触发代码。
''' </summary>
Public Event OnStateChangedUi(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
''' <summary>
''' 简易的在 UI 线程添加触发事件的方式。主要用于在新建 Loader 时直接使用 With 绑定事件，以及进行老代码兼容。
''' </summary>
Public WriteOnly Property OnStateChanged As Action(Of LoaderBase)
Set(value As Action(Of LoaderBase))
AddHandler OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) value(Loader)
End Set
End Property
''' <summary>
''' 在加载器目标事件执行完成，加载器状态即将变为 Finish 时调用。可以视为扩展加载器目标事件。
''' </summary>
Public Event PreviewFinish(Loader As LoaderBase)
Protected Sub RaisePreviewFinish()
RaiseEvent PreviewFinish(Me)
End Sub
'状态监控
''' <summary>
''' 加载器的状态。
''' </summary>
Public Property State As LoadState
Get
Return _State
End Get
Set(value As LoadState)
If _State = value Then Exit Property
Dim OldState = _State
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value
Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value))
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(Sub()
Select Case value
Case LoadState.Loading
LoadingState = MyLoading.MyLoadingState.Run
Case LoadState.Failed
LoadingState = MyLoading.MyLoadingState.Error
Case Else
LoadingState = MyLoading.MyLoadingState.Stop
End Select
RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
End Set
End Property
Private _State As LoadState = LoadState.Waiting
Public Property LoadingState As MyLoading.MyLoadingState Implements ILoadingTrigger.LoadingState
Get
Return _LoadingState
End Get
Set(value As MyLoading.MyLoadingState)
If _LoadingState = value Then Exit Property
Dim OldState = _LoadingState
_LoadingState = value
RaiseEvent LoadingStateChanged(value, OldState)
End Set
End Property
Private _LoadingState As MyLoading.MyLoadingState = MyLoading.MyLoadingState.Stop
Public Event LoadingStateChanged(NewState As MyLoading.MyLoadingState, OldState As MyLoading.MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged
''' <summary>
''' 若加载器出错，可提供给外部参考的异常。
''' </summary>
Public Property [Error] As Exception = Nothing
''' <summary>
''' 使用 LoaderCombo 加载时，该任务是否会阻碍后续任务的进行。
''' </summary>
Public Block As Boolean = True
''' <summary>
''' 该加载器是否显示在列表中。
''' </summary>
Public Show As Boolean = True
''' <summary>
''' 当前加载器是否由 IsForceRestart 强制调起。
''' 这个属性自身不会干任何事，而是提供给加载器执行的函数，使得加载器调用另一个加载器时，可以继承强制重启属性。
''' </summary>
Public IsForceRestarting As Boolean = False
'进度监控
''' <summary>
''' 加载器的执行进度，为 0 至 1 的小数。
''' </summary>
Public Overridable Property Progress As Double
Get
Select Case State
Case LoadState.Waiting
Return 0
Case LoadState.Loading
Return If(_Progress = -1, 0.02, _Progress)
Case Else
Return 1
End Select
End Get
Set(value As Double)
_Progress = value
End Set
End Property
Private _Progress As Double = -1
''' <summary>
''' 计算总进度时的权重。它应该为预计时间（秒）。
''' </summary>
Public Property ProgressWeight As Double = 1
'状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
Public MustOverride Sub Abort()
'等待结束
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
''' <summary>
''' 无限期地等待加载器完成，直到结束或抛出异常。若加载器尚未开始，则会开始执行。
''' </summary>
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False)
Start(Input, IsForceRestart)
Do While State = LoadState.Loading
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
Thread.Sleep(10)
Loop
If State = LoadState.Finished Then
Exit Sub
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误！")
Else
Throw New Exception([Error].Message, [Error]) '保留调用堆栈，同时不影响信息输出与单元测试
End If
End Sub
''' <summary>
''' 等待加载器完成，直到结束、抛出异常或超时。若加载器尚未开始，则会开始执行。
''' </summary>
''' <param name="Timeout">等待的超时时间，以毫秒为单位。</param>
''' <param name="TimeoutMessage">若执行超时，将会抛出的异常信息。</param>
Public Sub WaitForExitTime(Timeout As Integer, Optional Input As Object = Nothing, Optional TimeoutMessage As String = WaitForExitTimeoutMessage, Optional LoaderToSyncProgress As Object = Nothing, Optional IsForceRestart As Boolean = False)
Start(Input, IsForceRestart)
Do While State = LoadState.Loading
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
Thread.Sleep(10)
Timeout -= 10
If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage)
Loop
If State = LoadState.Finished Then
Exit Sub
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误！")
Else
Throw [Error]
End If
End Sub
'相同重载
Public Overrides Function Equals(obj As Object) As Boolean
Dim base = TryCast(obj, LoaderBase)
Return base IsNot Nothing AndAlso Uuid = base.Uuid
End Function
End Class
''' <summary>
''' 用于异步执行并监控单一函数的加载器。
''' </summary>
Public Class LoaderTask(Of InputType, OutputType)
Inherits LoaderBase
'线程设定
Protected Friend ThreadPriority As ThreadPriority
'执行事件
Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType))
Protected Friend InputDelegate As Func(Of Object)
'状态指示
''' <summary>
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断，不可跨线程调用。
''' </summary>
Public ReadOnly Property IsAborted As Boolean
Get
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread.CurrentThread, LastRunningThread)
End Get
End Property
''' <summary>
''' 在输入相同时使用原有结果的超时，单位为毫秒。
''' </summary>
Public ReloadTimeout As Integer = -1
''' <summary>
''' 上次完成加载时的时间。
''' </summary>
Public LastFinishedTime As Long = 0
''' <summary>
''' 最后一次运行加载器的线程。可能为 Nothing，或线程已结束。
''' </summary>
Public LastRunningThread As Thread = Nothing
'输入输出
Public Input As InputType = Nothing
Public Output As OutputType = Nothing
'获取输入
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断
If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
RunInUiWait(Sub() Input = InputDelegate())
End If
Return Input
End Function
'代码执行
Public Function ShouldStart(ByRef Input As Object, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
'获取输入
Try
Input = StartGetInput(Input)
Catch ex As Exception
Log(ex, "加载输入获取失败（" & Name & "）", LogLevel.Hint)
[Error] = ex
SyncLock LockState
State = LoadState.Failed
End SyncLock
End Try
'检验输入以确定情况
If (Not IsForceRestart) AndAlso '不要求强行重启
((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同
(State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
'如果输入相同且未出错则不重试
Return False
Else
'需要开始
Return True
End If
End Function
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
'确认是否开始加载
If ShouldStart(Input, IsForceRestart) Then
'输入不同或失败，开始加载
If State = LoadState.Loading Then TriggerThreadAbort()
Me.Input = Input
SyncLock LockState
State = LoadState.Loading
End SyncLock
Else
Exit Sub
End If
LastRunningThread = New Thread(
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动")
LoadDelegate(Me)
If IsAborted Then
Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束，输出被弃用（最新线程：" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & "）", LogLevel.Developer)
Else
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断，本次输出有效
End If
Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断")
'如果线程是因为判断到 IsAborted 而提前中止，则代表已有新线程被重启，此时不应当改为 Aborted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Exit Sub
Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
End Try
End Sub) With {.Name = Name, .Priority = ThreadPriority}
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
End Sub
Public Overrides Sub Abort()
If State <> LoadState.Loading Then Exit Sub
SyncLock LockState
State = LoadState.Aborted
End SyncLock
TriggerThreadAbort()
End Sub
Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Exit Sub
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
LastRunningThread = Nothing
End Sub
Public Sub New()
'仅仅是为了避免一些智障报错（继承类必须重写 New 的情况）
End Sub
Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)), Optional InputDelegate As Func(Of InputType) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
Me.Name = Name
Me.LoadDelegate = LoadDelegate
Me.InputDelegate = InputDelegate
ThreadPriority = Priority
End Sub
End Class
''' <summary>
''' 支持多个加载器连续运作的复合加载器。
''' </summary>
Public Class LoaderCombo(Of InputType)
Inherits LoaderBase
Public Overrides Property Progress() As Double
Get
Select Case State
Case LoadState.Waiting
Return 0
Case LoadState.Loading
Dim Total As Double = 0, Finished As Double = 0
For Each Loader In Loaders
Total += Loader.ProgressWeight
Finished += Loader.ProgressWeight * Loader.Progress
Next
If Total = 0 Then Return 0
Return Finished / Total
Case Else
Return 1
End Select
End Get
Set(value As Double)
Throw New Exception("多重加载器不支持设置进度")
End Set
End Property
Public Loaders As New List(Of LoaderBase)
Public Input As InputType
Public Sub New(Name As String, Loaders As IEnumerable(Of LoaderBase))
Me.Loaders.Clear()
For Each Loader As LoaderBase In Loaders
If Loader IsNot Nothing Then
Me.Loaders.Add(Loader)
AddHandler Loader.OnStateChangedThread, AddressOf SubTaskStateChanged
Loader.HasOnStateChangedThread = True
End If
Next
InitParent(Nothing)
Me.Name = Name
End Sub
Public Overrides Sub InitParent(Parent As LoaderBase)
Me.Parent = Parent
For Each Loader In Loaders
Loader.InitParent(Me)
Next
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
IsForceRestarting = IsForceRestart
'改变状态
SyncLock LockState
If State = LoadState.Loading Then
Exit Sub
Else
State = LoadState.Loading
End If
End SyncLock
'启动加载
Me.Input = Input
If IsForceRestart Then
For Each Loader In Loaders
Loader.State = LoadState.Waiting
Next
End If
Update()
End Sub
Public Overrides Sub Abort()
'改变状态
SyncLock LockState
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Aborted
Else
Exit Sub
End If
End SyncLock
RunInThread(Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
'从列表删除
SyncLock LoaderTaskbarLock
If LoaderTaskbar.Contains(Me) Then LoaderTaskbar.Remove(Me)
End SyncLock
End Sub)
End Sub
''' <summary>
''' 子任务状态变更。
''' </summary>
Private Sub SubTaskStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Loading
'开始，啥都不干
Case LoadState.Waiting
'子加载器可能由于外部输入改变而暂时变为 Waiting，之后会立即重新启动
'所以啥都不干就行
Case LoadState.Finished
'正常结束，触发刷新
Update()
Case LoadState.Aborted
'被中断，这个任务也中断
Abort()
Case Else
'完蛋，出错了
SyncLock LockState
If State >= LoadState.Finished Then Exit Sub
[Error] = New Exception(Loader.Name & "失败", Loader.Error)
State = Loader.State
End SyncLock
For Each Loader In Loaders
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
Exit Sub
End Select
End Sub
''' <summary>
''' 触发一次更新，以启动新加载器或完成。
''' </summary>
Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
Dim IsFinished As Boolean = True
Dim Ignore As Boolean = False
Dim Input As Object = Me.Input
For Each Loader In Loaders
Select Case Loader.State
Case LoadState.Finished
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name)
GoTo Restart
End If
'更新下一个加载器的输入
Input = CType(Loader, Object).Output
End If
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
End If
End If
'已经有正在加载中的了，不需要再启动了
IsFinished = False
Ignore = True
Case Else
Restart:
'未启动，则启动加载器
IsFinished = False
If Ignore Then Continue For
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
ElseIf LoaderType.StartsWith("LoaderDownload") Then
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else
Throw New Exception("未知的加载器类型（" & LoaderType & "）")
End If
Else
Loader.Start(IsForceRestart:=IsForceRestarting)
End If
'如果不让继续启动，那就不启动呗
If Loader.Block Then Ignore = True
End Select
Next
If IsFinished Then
'顺利完成，贼棒
RaisePreviewFinish()
State = LoadState.Finished
FrmMain.BtnExtraDownload.ShowRefresh()
End If
End Sub
''' <summary>
''' 获得最底层的，应被显示给用户的加载器列表，并追加于 List。
''' </summary>
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List)
Next
End Sub
''' <summary>
''' 获得最底层的，应被显示给用户的加载器列表，并追加于 List。
''' </summary>
Public Sub GetLoaderList(ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
GetLoaderList(Me, List, RequireShow)
End Sub
''' <summary>
''' 获得最底层的，应被显示给用户的加载器列表。
''' </summary>
Public Function GetLoaderList(Optional RequireShow As Boolean = True) As List(Of LoaderBase)
Dim List As New List(Of LoaderBase)
GetLoaderList(List, RequireShow)
Return List
End Function
End Class
'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
End SyncLock
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成，若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成，则刷新并移除
Dim RemovedTask As New List(Of LoaderBase)
For i = 0 To LoaderTaskbar.Count - 1
If (IsAllDownloadTaskCompleted OrElse LoaderTaskbar(i).State = LoadState.Aborted) AndAlso LoaderTaskbar(i).Show Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(LoaderTaskbar(i))
RemovedTask.Add(LoaderTaskbar(i))
End If
Next
For Each Task In RemovedTask
LoaderTaskbar.Remove(Task)
Next
End SyncLock
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
Else
LoaderTaskbarProgress = LoaderTaskbarProgress * 0.9 + NewProgress * 0.1
End If
'更新任务栏信息
If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then
NewState = Shell.TaskbarItemProgressState.None
ElseIf LoaderTaskbarProgress < 0.015 Then
NewState = Shell.TaskbarItemProgressState.Indeterminate
Else
NewState = Shell.TaskbarItemProgressState.Normal
FrmMain.TaskbarItemInfo.ProgressValue = LoaderTaskbarProgress
End If
If LoaderTaskbarProgressLast <> NewState Then
LoaderTaskbarProgressLast = NewState
FrmMain.TaskbarItemInfo.ProgressState = NewState
FrmMain.BtnExtraDownload.ShowRefresh()
End If
Catch ex As Exception
Log(ex, "刷新任务栏进度显示失败", LogLevel.Feedback)
End Try
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
Total += LoaderTaskbar(i).Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathRange(Total / Count, 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
End Try
End Function
'文件夹刷新类委托
Private LoaderFolderDictionary As New Dictionary(Of LoaderBase, LoaderFolderDictionaryEntry)
Private Structure LoaderFolderDictionaryEntry
Public LastCheckTime As Date?
Public FolderPath As String
Public Overrides Function Equals(obj As Object) As Boolean
If TypeOf obj IsNot LoaderFolderDictionaryEntry Then Return False
Dim entry = DirectCast(obj, LoaderFolderDictionaryEntry)
Return EqualityComparer(Of Date?).Default.Equals(LastCheckTime, entry.LastCheckTime) AndAlso
FolderPath = entry.FolderPath
End Function
End Structure
Public Enum LoaderFolderRunType
RunOnUpdated
ForceRun
UpdateOnly
End Enum
''' <summary>
''' 执行以文件夹检测作为输入的加载器。加载器需以文件夹路径为输入值。
''' 返回是否执行了加载器。
''' </summary>
''' <param name="ExtraPath">用于检查文件夹修改的额外路径。该路径不会传入加载器。</param>
Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean
Dim FolderInfo As DirectoryInfo
Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing}
Try
'获取数据
FolderInfo = New DirectoryInfo(FolderPath & ExtraPath)
Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
'如果已经检查过，则跳过
If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
If FolderInfo.Exists Then
If LoaderFolderDictionary(Loader).LastCheckTime IsNot Nothing AndAlso
Value.Equals(LoaderFolderDictionary(Loader)) Then Return False
Else
If LoaderFolderDictionary(Loader).LastCheckTime Is Nothing Then Return False
End If
End If
Catch ex As Exception
Log(ex, "文件夹加载器启动检测出错")
End Try
'写入检查数据
DictionaryAdd(LoaderFolderDictionary, Loader, Value)
'开始检查
If Type = LoaderFolderRunType.UpdateOnly Then Return False
If WaitForExit Then
Loader.WaitForExit(FolderPath, IsForceRestart:=True)
Else
Loader.Start(FolderPath, IsForceRestart:=True)
End If
Return True
End Function
Private Function GetActualLastWriteTimeUtc(FolderInfo As DirectoryInfo, MaxDepth As Integer) As Date
Dim Time As Date = FolderInfo.LastWriteTimeUtc
If MaxDepth > 0 Then
For Each Folder In FolderInfo.EnumerateDirectories
Dim FolderTime As Date = GetActualLastWriteTimeUtc(Folder, MaxDepth - 1)
If FolderTime > Time Then Time = FolderTime
Next
End If
Return Time
End Function
End Module
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+2054
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+315
View File
@@ -0,0 +1,315 @@
'提供不同的输入验证方法，名称以 Validate 开头
''' <summary>
''' 输入验证规则基类。要查看所有的输入验证规则，可在输入 Validate 后查看自动补全。
''' </summary>
Public MustInherit Class Validate
''' <summary>
''' 验证某字符串是否符合验证要求。若符合，返回空字符串；若不符合，返回错误原因。
''' </summary>
Public MustOverride Function Validate(Str As String) As String
End Class
''' <summary>
''' 若为空则直接通过检查。
''' </summary>
Public Class ValidateNullable
Inherits Validate
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return Nothing
Return ""
End Function
End Class
''' <summary>
''' 不能为 Nothing 或空字符串（不包括全空格检查）。
''' </summary>
Public Class ValidateNullOrEmpty
Inherits Validate
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return "输入内容不能为空！"
Return ""
End Function
End Class
''' <summary>
''' 不能为 Nothing 或空字符串（包括全空格检查）。
''' </summary>
Public Class ValidateNullOrWhiteSpace
Inherits Validate
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrWhiteSpace(Str) Then Return "输入内容不能为空！"
Return ""
End Function
End Class
''' <summary>
''' 必须满足正则表达式。
''' </summary>
Public Class ValidateRegex
Inherits Validate
Public Property Regex As String
Public Property ErrorDescription As String = ""
Public Sub New()
End Sub '用于 XAML 初始化
Public Sub New(Regex As String, Optional ErrorDescription As String = "")
Me.Regex = Regex
Me.ErrorDescription = ErrorDescription
End Sub
Public Overrides Function Validate(Str As String) As String
If Not RegexCheck(Str, Regex) Then Return ErrorDescription
Return ""
End Function
End Class
''' <summary>
''' 必须是一个完整网址。
''' </summary>
Public Class ValidateHttp
Inherits Validate
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效！"
Return ""
End Function
End Class
''' <summary>
''' 必须为整数。
''' </summary>
Public Class ValidateInteger
Inherits Validate
Public Property Min As Integer
Public Property Max As Integer = Integer.MaxValue
Public Sub New()
End Sub '用于 XAML 初始化
Public Sub New(Min As Integer, Max As Integer)
Me.Min = Min
Me.Max = Max
End Sub
Public Overrides Function Validate(Str As String) As String
If Str.Length > 9 Then Return "请输入一个大小合理的数字！"
Dim Valed As Integer = Val(Str)
If Valed.ToString <> Str Then Return "请输入一个整数！"
If Val(Str) > Max Then Return "不可超过 " & Max & "！"
If Val(Str) < Min Then Return "不可低于 " & Min & "！"
Return ""
End Function
End Class
''' <summary>
''' 长度限制。
''' </summary>
Public Class ValidateLength
Inherits Validate
Public Property Min As Integer = 0
Public Property Max As Integer = Integer.MaxValue
Public Sub New()
End Sub '用于 XAML 初始化
Public Sub New(Min As Integer, Optional Max As Integer = Integer.MaxValue)
Me.Min = Min
Me.Max = Max
End Sub
Public Overrides Function Validate(Str As String) As String
If Len(Str) <> Max AndAlso Max = Min Then Return "长度必须为 " & Max & " 个字符！"
If Len(Str) > Max Then Return "长度最长为 " & Max & " 个字符！"
If Len(Str) < Min Then Return "长度至少需 " & Min & " 个字符！"
Return ""
End Function
End Class
''' <summary>
''' 不能包含某些特定字符串。忽略大小写。
''' </summary>
Public Class ValidateExcept
Inherits Validate
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String
Public Sub New()
ErrorMessage = "输入内容不能包含 %！"
End Sub '用于 XAML 初始化
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %！")
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %！")
Me.Excepts = New ObjectModel.Collection(Of String)
Me.ErrorMessage = ErrorMessage
For Each Data As String In Excepts
Me.Excepts.Add(Data)
Next
End Sub
Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts
If Str.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch)
End If
Next
Return ""
End Function
End Class
''' <summary>
''' 不能与某些特定字符串相同。
''' </summary>
Public Class ValidateExceptSame
Inherits Validate
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String
Public Property IgnoreCase As Boolean = False
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %！", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %！", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String)
For Each Data As String In Excepts
Me.Excepts.Add(Data)
Next
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Overrides Function Validate(Str As String) As String
If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")
For Each Ch As String In Excepts
If IgnoreCase Then
If Str.ToLower = Ch.ToLower Then Return ErrorMessage.Replace("%", Ch)
Else
If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写
End If
Next
Return ""
End Function
End Class
''' <summary>
''' 对文件夹名的粗略的特化检测。
''' </summary>
Public Class ValidateFolderName
Inherits Validate
Public Property Path As String
Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
Me.Path = Path
Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next
PathIgnore = New DirectoryInfo(Path).EnumerateDirectories
End Sub
Public Overrides Function Validate(Str As String) As String
Try
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头！"
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾！"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾！"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查文件夹重名
Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then
For Each Folder As DirectoryInfo In PathIgnore
Arr.Add(Folder.Name)
Next
End If
Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
If Not SameNameCheck = "" Then Return SameNameCheck
Return ""
Catch ex As Exception
Log(ex, "检查文件夹名出错")
Return "错误：" & ex.Message
End Try
End Function
End Class
''' <summary>
''' 要求输入一个可用的文件夹路径。
''' </summary>
Public Class ValidateFolderPath
Inherits Validate
Public Property UseMinecraftCharCheck As Boolean = True
Public Sub New()
End Sub
Public Sub New(UseMinecraftCharCheck As Boolean)
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
End Sub
Public Overrides Function Validate(Str As String) As String
'去除尾部斜线，统一为 \
Str = Str.Replace("/", "\")
If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查长度
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查开头
If Str.StartsWith("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return ""
If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin
Next
Return "文件夹路径头存在错误！"
Fin:
'对首层以外的路径检查
For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
Dim SubStr As String = Str.Split("\")(i)
'检查是否为空
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
If Not SubLengthCheck = "" Then Return "文件夹路径存在错误！"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符！").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头！"
If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾！"
'检查尾部小数点
If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾！"
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
Next
Return ""
End Function
End Class
''' <summary>
''' 敏感词过滤。
''' </summary>
Public Class ValidateFilter
Inherits Validate
Private Shared Excepts As String() = SecretDecrypt(SecretSensitiveWordsRaw).Split("|")
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
'提取无间隔符的字符串
Dim RealStr As String = ""
For Each St In If(Str, "").ToLower
If String.IsNullOrWhiteSpace(St.ToString) OrElse ("!@#$%^&*()_+-={}[]|\;':"",./<>? ~　·！￥…（）—，。、《》？‘；：【】｛｝" & vbLQ & vbRQ).ToCharArray.Contains(St) Then Continue For
RealStr += St
Next
'检查
For Each Except In Excepts
If RealStr.Contains(Except) Then Return "存在敏感内容！"
Next
Return ""
End Function
End Class
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+158
View File
@@ -0,0 +1,158 @@
'一个万能的自动图片类型转换工具类
Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Dictionary(Of String, MyBitmap)
''' <summary>
''' 存储的图片
''' </summary>
Public Pic As System.Drawing.Bitmap
'自动类型转换
'支持的类：Image，ImageSource，Bitmap，ImageBrush，BitmapSource
Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
Try
Dim size = rect.Width * rect.Height * 4
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, DPI, DPI, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride)
Finally
Bitmap.UnlockBits(bitmapData)
End Try
End Operator
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush
Return New ImageBrush(New MyBitmap(Image.Pic))
End Operator
'构造函数
Public Sub New()
End Sub
Public Sub New(FilePathOrResourceName As String)
Try
If FilePathOrResourceName.StartsWith(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic
Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.Add(FilePathOrResourceName, Pic)
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
Pic = New System.Drawing.Bitmap(InputStream)
InputStream.Dispose()
End Using
End If
Catch ex As Exception
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, "加载位图失败（" & FilePathOrResourceName & "）")
Throw
Else
Log(ex, "指定类型有误的位图加载（" & FilePathOrResourceName & "）", LogLevel.Developer)
Exit Try
End If
End Try
End Sub
Public Sub New(Image As ImageSource)
Using MS = New MemoryStream()
Dim Encoder = New PngBitmapEncoder()
Encoder.Frames.Add(BitmapFrame.Create(Image))
Encoder.Save(MS)
Pic = New System.Drawing.Bitmap(MS)
End Using
End Sub
Public Sub New(Image As System.Drawing.Image)
Pic = Image
End Sub
Public Sub New(Image As System.Drawing.Bitmap)
Pic = Image
End Sub
Public Sub New(Image As ImageBrush)
Using MS = New MemoryStream()
Dim Encoder = New BmpBitmapEncoder()
Encoder.Frames.Add(BitmapFrame.Create(Image.ImageSource))
Encoder.Save(MS)
Pic = New System.Drawing.Bitmap(MS)
End Using
End Sub
''' <summary>
''' 获取旋转的图片，这个方法不会导致原对象改变且会返回一个新的对象。图片长宽必须相等。
''' </summary>
''' <param name="angle">旋转角度（单位为角度）。</param>
Public Function Rotation(angle As Double) As System.Drawing.Bitmap
With Me
Dim img As System.Drawing.Image = Me.Pic
Dim bitSize As Single = img.Width
Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize))
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.TranslateTransform(bitSize / 2, bitSize / 2)
g.RotateTransform(angle)
g.TranslateTransform(-bitSize / 2, -bitSize / 2)
g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width))
End Using
Return bmp
End With
End Function
''' <summary>
''' 获取裁切的图片，这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap
With Me
Dim img As System.Drawing.Image = Pic
Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.DrawImageUnscaled(img, rect)
End Using
Return bmp
End With
End Function
''' <summary>
''' 获取左右翻转的图片，这个方法不会导致原对象改变。
''' </summary>
Public Function LeftRightFilp() As System.Drawing.Bitmap
Dim bmp As New System.Drawing.Bitmap(Pic)
bmp.RotateFlip(System.Drawing.RotateFlipType.RotateNoneFlipX)
Return bmp
End Function
''' <summary>
''' 将图像保存到文件。
''' </summary>
Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream = New System.IO.FileStream(FilePath, FileMode.Create)
encoder.Save(fileStream)
End Using
End Sub
End Class
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+887
View File
@@ -0,0 +1,887 @@
Public Class CrashAnalyzer
Private Shared IsAnalyzeCacheCleared As Boolean = False
Private Shared IsAnalyzeCacheClearedLock As New Object
'构造函数
Private TempFolder As String
Public Sub New(UUID As Integer)
'清理缓存
SyncLock IsAnalyzeCacheClearedLock
If Not IsAnalyzeCacheCleared Then
Try
DeleteDirectory(PathTemp & "CrashAnalyzer")
Catch ex As Exception
Log(ex, "清理崩溃分析缓存失败")
End Try
IsAnalyzeCacheCleared = True
End If
End SyncLock
'构建文件结构
TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\"
DeleteDirectory(TempFolder)
Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder)
End Sub
'1：准备用于分析的 Log 文件
Private AnalyzeRawFiles As New List(Of KeyValuePair(Of String, String())) '暂存的日志文件：文件完整路径 -> 文件内容
''' <summary>
''' 将可用于分析的日志存储到 AnalyzeRawFiles。
''' </summary>
''' <param name="LatestLog">从 PCL2 捕获到的最后 200 行程序输出。</param>
Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing)
Log("[Crash] 步骤 1：收集日志文件")
'简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String)
Try
Dim DirInfo As New DirectoryInfo(VersionPathIndie & "crash-reports\")
If DirInfo.Exists Then
For Each File In DirInfo.EnumerateFiles
PossibleLogs.Add(File.FullName)
Next
End If
Catch ex As Exception
Log(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try
Try
For Each File In New DirectoryInfo(VersionPathIndie).Parent.Parent.EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName)
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 主文件夹下的日志失败")
End Try
Try
For Each File In New DirectoryInfo(VersionPathIndie).EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName)
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 隔离文件夹下的日志失败")
End Try
PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志
PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志
PossibleLogs = ArrayNoDouble(PossibleLogs)
'确定最新的日志文件
Dim RightLogs As New List(Of String)
For Each LogFile In PossibleLogs
Try
Dim Info As New FileInfo(LogFile)
If Not Info.Exists Then Continue For
Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes)
If Time < 3 AndAlso Info.Length > 0 Then
RightLogs.Add(LogFile)
Log("[Crash] 可能可用的日志文件：" & LogFile & "（" & Math.Round(Time, 1) & " 分钟）")
End If
Catch ex As Exception
Log(ex, "确认崩溃日志时间失败（" & LogFile & "）")
End Try
Next
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
Try
If FilePath.Contains("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, File.ReadAllLines(FilePath, Encoding.UTF8)))
End If
Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then
Dim RawOutput As String = Join(LatestLog, vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear()
End If
Log("[Crash] 步骤 1：收集日志文件完成，收集到 " & AnalyzeRawFiles.Count & " 个文件")
End Sub
''' <summary>
''' 从文件路径直接导入日志文件或崩溃报告压缩包。
''' </summary>
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1：自主导入日志文件")
'解压压缩包
Try
Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
'解压成功
Log("[Crash] 已解压导入的日志文件：" & FilePath)
Else
'解压失败
File.Copy(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath)
End If
Catch ex As Exception
Log(ex, "解压导入文件中的压缩包失败")
End Try
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles
Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" 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)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, File.ReadAllLines(TargetFile.FullName, Encoding.UTF8)))
End If
End If
Catch ex As Exception
Log(ex, "导入单个日志文件失败")
End Try
Next
Log("[Crash] 步骤 1：自主导入日志文件，收集到 " & AnalyzeRawFiles.Count & " 个文件")
End Sub
'2：确认实际用于分析的 Log 文本
Private Enum AnalyzeFileType
HsErr
MinecraftLog
ExtraLog
CrashReport
End Enum
''' <summary>
''' 从 AnalyzeRawFiles 中提取实际有用的文本片段存储到 AnalyzeFiles，并整理可用于生成报告的文件。
''' 返回找到的用于分析的项目数。
''' </summary>
Public Function Prepare() As Integer
Log("[Crash] 步骤 2：准备日志文本")
'对日志文件进行分类
Dim TotalFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim FileName As String = GetFileNameFromPath(LogFile.Key)
Dim TargetType As AnalyzeFileType
If FileName.StartsWith("hs_err") Then
TargetType = AnalyzeFileType.HsErr
ElseIf FileName.StartsWith("crash-") Then
TargetType = AnalyzeFileType.CrashReport
ElseIf FileName = "latest.log" OrElse FileName = "latest log.txt" OrElse
FileName = "debug.log" OrElse FileName = "debug log.txt" OrElse FileName = "游戏崩溃前的输出.txt" OrElse
FileName = "rawoutput.log" OrElse FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "log1.txt" Then
TargetType = AnalyzeFileType.MinecraftLog
ElseIf FileName.EndsWith(".log") OrElse FileName.EndsWith(".txt") Then
TargetType = AnalyzeFileType.ExtraLog
Else
Log("[Crash] " & FileName & " 分类为 Ignore")
Continue For
End If
If LogFile.Value.Count = 0 Then
Log("[Crash] " & FileName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & FileName & " 分类为 " & GetStringFromEnum(TargetType))
End If
Next
'将分类后的文件分别写入
For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLog, AnalyzeFileType.CrashReport}
'获取该种类的所有文件 {文件路径 -> 文件内容行}
Dim SelectedFiles As New List(Of KeyValuePair(Of String, String()))
For Each File In TotalFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If SelectedFiles.Count = 0 Then Continue For
Try
'根据文件类别判断
Select Case SelectType
Case AnalyzeFileType.HsErr, AnalyzeFileType.CrashReport
'获取文件的修改日期
Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))()
For Each File In SelectedFiles
Try
DatedFiles.Add(New FileInfo(File.Key).LastWriteTime, File)
Catch ex As Exception
Log(ex, "获取日志文件修改时间失败")
DatedFiles.Add(New Date(1900, 1, 1), File)
End Try
Next
'输出最新的文件
Dim NewestFile As KeyValuePair(Of String, String()) = DatedFiles.Last.Value
OutputFiles.Add(NewestFile.Key)
If SelectType = AnalyzeFileType.HsErr Then
LogHs = GetHeadTailLines(NewestFile.Value, 200, 100)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为虚拟机错误信息")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为虚拟机错误信息")
Else
LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
End If
Case AnalyzeFileType.MinecraftLog
LogMc = ""
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
DictionaryAdd(FileNameDict, GetFileNameFromPath(SelectedFile.Key).ToLower, SelectedFile)
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志")
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
'截取 “以下为游戏输出的最后一段内容” 后的内容
Dim HasLauncherMark As Boolean = False
For Each Line In CurrentLog.Value
If HasLauncherMark Then
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL2 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) & vbLf & "[" '路径包含中文且存在编码问题导致找不到或无法加载主类的末端检测
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为启动器日志")
Exit For
End If
Next
'选择一份最佳的 Minecraft Log
For Each FileName As String In {"latest.log", "latest log.txt", "debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500) & vbLf & "["
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft 日志")
Exit For
End If
Next
'检查错误
If LogMc = "" Then
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
End If
Case AnalyzeFileType.ExtraLog
'全部丢过去
For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为额外日志")
Next
End Select
Catch ex As Exception
Log(ex, "分类处理日志文件时出错")
End Try
Next
'获取种类数
Dim ResultCount As Integer = If(LogMc Is Nothing, 0, 1) + If(LogHs Is Nothing, 0, 1) + If(LogCrash Is Nothing, 0, 1)
If ResultCount = 0 Then
Log("[Crash] 步骤 2：准备日志文本完成，没有任何可供分析的日志")
Else
Log(("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
End If
Return ResultCount
End Function
''' <summary>
''' 输出字符串的前后某些行，并统一行尾为 vbLf (\r)、删除空行。
''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw, vbLf)
Dim Result As New StringBuilder
For i = 0 To Raw.Count - 1
If i < HeadLines OrElse Raw.Count - i < TailLines Then
If Raw(i) = "" Then Continue For
Result.Append(Raw(i) & vbLf)
End If
Next
Return Result.ToString
End Function
'3：根据文本分析崩溃原因
Private LogMc As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing
Private LogAll As String
'可能导致崩溃的原因与附加信息
Private CrashReasons As New Dictionary(Of CrashReason, List(Of String))
''' <summary>
''' 导致崩溃的原因枚举。
''' </summary>
Private Enum CrashReason
Mod文件被解压
内存不足
使用JDK
显卡不支持OpenGL
使用OpenJ9
Java版本过高
显卡驱动不支持导致无法设置像素格式
路径包含中文且存在编码问题导致找不到或无法加载主类
Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-32606
AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-31618
Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION
玩家手动触发调试崩溃
光影或资源包导致OpenGL1282错误
文件或内容校验失败
确定Mod导致游戏崩溃
Mod配置文件导致游戏崩溃
ModMixin失败
Mod加载器报错
Mod初始化失败
崩溃日志堆栈分析发现关键字
崩溃日志堆栈分析发现Mod名称
MC日志堆栈分析发现关键字
OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
特定方块导致崩溃
特定实体导致崩溃
材质过大或显卡配置不足
没有可用的分析文件
使用32位Java导致JVM无法分配足够多的内存
Mod重复安装
Fabric报错
Fabric报错并给出解决方案
Forge报错
低版本Forge与高版本Java不兼容
版本Json中存在多个Forge
Mod过多导致超出ID限制
End Enum
''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Log("[Crash] 步骤 3：分析崩溃原因")
LogAll = (If(LogMc, "") & If(LogHs, "") & If(LogCrash, "")).ToLower
'1. 精准日志匹配 1
AnalyzeCrit1()
If CrashReasons.Count > 0 Then GoTo Done
'2. 堆栈分析
If LogAll.Contains("forge") OrElse LogAll.Contains("fabric") OrElse LogAll.Contains("liteloader") Then
'来源崩溃日志的分析
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Dim Keywords = AnalyzeStackKeyword(LogCrash.Replace("A detailed walkthrough of the error", "¨").Split("¨").First)
If Keywords.Count > 0 Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.崩溃日志堆栈分析发现关键字, Keywords)
Else
AppendReason(CrashReason.崩溃日志堆栈分析发现Mod名称, Names)
End If
GoTo Done
End If
End If
'来自 Minecraft 日志的分析
If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项")
If Fatals.Count > 0 Then
Dim Keywords As New List(Of String)
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
If Keywords.Count > 0 Then
AppendReason(CrashReason.MC日志堆栈分析发现关键字, ArrayNoDouble(Keywords))
GoTo Done
End If
End If
End If
Else
Log("[Crash] 可能并未安装 Mod，不进行堆栈分析")
End If
'3. 精准日志匹配 2
AnalyzeCrit2()
'输出到日志
Done:
If CrashReasons.Count = 0 Then
Log("[Crash] 步骤 3：分析崩溃原因完成，未找到可能的原因")
Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "（" & Join(Reason.Value, "；") & "）", ""))
Next
End If
End Sub
''' <summary>
''' 增加一个可能的崩溃原因。
''' </summary>
Private Sub AppendReason(Reason As CrashReason, Optional Additional As ICollection(Of String) = Nothing)
If CrashReasons.ContainsKey(Reason) Then
If Additional IsNot Nothing Then
CrashReasons(Reason).AddRange(Additional)
CrashReasons(Reason) = ArrayNoDouble(CrashReasons(Reason))
End If
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "（" & Join(Additional, "；") & "）", ""))
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
End Sub
'具体的分析代码
''' <summary>
''' 进行精准日志匹配。匹配优先级高于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit1()
'空白分析
If LogMc Is Nothing AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing Then
AppendReason(CrashReason.没有可用的分析文件)
Exit Sub
End If
'崩溃报告分析，高优先级
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
End If
'游戏日志分析
If LogMc IsNot Nothing Then
If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\t - [^\n]+\n)+"), ""), "(?<=\t)[^\n]+"), vbLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Could not reserve enough space") Then
If LogMc.Contains("for 1048576KB object heap") Then
AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
Else
AppendReason(CrashReason.内存不足)
End If
End If
'Mod 重复安装
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'找不到或无法加载主类
If (RegexCheck(LogMc, "^[^\n.]+.\w+.[^\n]+\n\[$") OrElse RegexCheck(LogMc, "^\[[^\]]+\] [^\n.]+.\w+.[^\n]+\n\[")) AndAlso
Not (LogMc.Contains("at net.") OrElse LogMc.Contains("/INFO]")) AndAlso
LogHs Is Nothing AndAlso LogCrash Is Nothing Then
AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类)
End If
'Mod 导致的崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.InjectionError") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
End If
'虚拟机日志分析
If LogHs IsNot Nothing Then
If LogHs.Contains("The system is out of physical RAM or swap space") Then AppendReason(CrashReason.内存不足)
If LogHs.Contains("Out of Memory Error") Then AppendReason(CrashReason.内存不足)
If LogHs.Contains("EXCEPTION_ACCESS_VIOLATION") Then
If LogHs.Contains("# C [ig") Then AppendReason(CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION)
If LogHs.Contains("# C [atio") Then AppendReason(CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION)
If LogHs.Contains("# C [nvoglv") Then AppendReason(CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION)
End If
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains("maximum id range exceeded") Then AppendReason(CrashReason.Mod过多导致超出ID限制)
If LogCrash.Contains("Entity being rendered") AndAlso LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogLeft = LogCrash.Split("-- MOD").Last
If LogLeft.Contains("Failure message: MISSING") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If
End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit2()
'游戏日志分析
If LogMc IsNot Nothing Then
If LogMc.Contains("]: Warnings were found!") Then AppendReason(CrashReason.Fabric报错, If(RegexSeek(LogMc, "(?<=\]: Warnings were found! ?[\n]+)[\w\W]+?(?=[\n]+\[)"), "").Trim(vbCrLf.ToCharArray))
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(RegexSeek(LogCrash, "(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(RegexSeek(LogCrash, "(?<=\tBlock location: World: )\([^\)]+\)"), ""))
If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
End If
End Sub
''' <summary>
''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。
''' </summary>
Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String)
'进行正则匹配
Dim StackSearchResults As List(Of String) = RegexSearch(If(ErrorStack, "") & vbCrLf, "(?<=\n[^{]+)[a-zA-Z]+\w+\.[a-zA-Z]+[\w\.]+(?=\.[\w\.$]+\.)")
'检查堆栈开头
Dim PossibleStacks As New List(Of String)
For Each Stack As String In StackSearchResults
'If Not Stack.Contains(".") Then Continue For
For Each IgnoreStack In {
"java", "sun", "javax", "jdk",
"org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"com.electronwill.nightconfig",
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
NextStack:
Next
PossibleStacks = ArrayNoDouble(PossibleStacks)
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
If PossibleStacks.Count = 0 Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Next
'检查堆栈关键词
Dim PossibleWords As New List(Of String)
For Each Stack As String In PossibleStacks
Dim Splited = Stack.Split(".")
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base",
"forge", "setup", "block", "model", "mixin", "event",
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler",
"optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
Next
PossibleWords = ArrayNoDouble(PossibleWords)
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String)
Else
Return PossibleWords
End If
End Function
''' <summary>
''' 根据 Mod 关键词与详细信息（崩溃报告第二部分）与，获取实际的 Mod 名称。
''' 若失败则返回 Nothing。
''' </summary>
Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String)
Dim ModFileNames As New List(Of String)
'预处理关键词（分割括号）
Dim RealKeywords As New List(Of String)
For Each Keyword In Keywords
For Each SubKeyword In Keyword.Split("(")
RealKeywords.Add(SubKeyword.Trim(" )".ToCharArray))
Next
Next
Keywords = RealKeywords
'获取崩溃报告对应部分
If LogCrash Is Nothing Then Return Nothing
If Not LogCrash.Contains("A detailed walkthrough of the error") Then Return Nothing
Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨")
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 检测到 Fabric Mod 信息格式")
End If
Details = Details.Split("¨").Last
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
Next
HintLines = ArrayNoDouble(HintLines)
Log("[Crash] 找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModName As String In HintLines
Log("[Crash] - " & ModName)
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
ModFileNames = ArrayNoDouble(ModFileNames)
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Next
Return If(ModFileNames.Count = 0, Nothing, ModFileNames)
End Function
''' <summary>
''' 尝试获取 Mod 名称，若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As String) As List(Of String)
Dim RawList As New List(Of String) From {Keywords}
If String.IsNullOrEmpty(Keywords) Then Return RawList
Return If(AnalyzeModName(RawList), RawList)
End Function
'4：根据原因输出信息
Private OutputFiles As New List(Of String)
''' <summary>
''' 弹出崩溃弹窗，并指导导出崩溃报告。
''' </summary>
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示
FrmMain.ShowWindowToTop()
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), "确定", If(IsHandAnalyze, "", "导出错误报告"))
Case 2
Dim FileAddress As String = Nothing
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Exit Sub
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
'输出诊断信息
FeedbackInfo()
LogFlush()
'复制文件
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles
Try
Dim FileName As String = GetFileNameFromPath(OutputFile)
Select Case FileName
Case "LatestLaunch.bat"
FileName = "启动脚本.bat"
Case "Log1.txt"
FileName = "PCL2 启动器日志.txt"
Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt"
End Select
File.Copy(OutputFile, TempFolder & "Report\" & FileName, True)
Catch ex As Exception
Log(ex, "复制错误报告文件失败（" & OutputFile & "）")
End Try
Next
'导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Finish)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Exit Sub
End Try
Try
Process.Start("explorer", "/select," & FileAddress)
Catch ex As Exception
Log(ex, "打开错误报告的存放文件夹失败")
End Try
End Select
End Sub
''' <summary>
''' 获取崩溃分析的结果描述。
''' </summary>
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'非一个结果的处理
Dim ResultString As String
If CrashReasons.Count = 0 Then
If IsHandAnalyze Then
Return "很抱歉，PCL2 无法确定错误原因。"
Else
Return "很抱歉，你的游戏出现了一些问题……" & vbCrLf &
"如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。" & vbCrLf &
"你也可以查看错误报告，其中可能会有出错的原因。"
End If
ElseIf CrashReasons.Count >= 2 Then
Hint("错误分析时发现数个可能的原因，窗口中仅显示了第一条，你可以在启动器日志中检查更多可能的原因！", HintType.Finish)
End If
'根据不同原因判断
Dim Additional As List(Of String) = CrashReasons.First.Value
Select Case CrashReasons.First.Key
Case CrashReason.Mod文件被解压
ResultString = "由于 Mod 文件被解压了，导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可，若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod，然后再启动游戏。"
Case CrashReason.内存不足
ResultString = "Minecraft 内存不足，导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足，或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存，删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效，请在开始游戏前尽量关闭其他软件，或者……换台电脑？\h"
Case CrashReason.使用OpenJ9
ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java 8，然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK，或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
ResultString = "你似乎正在使用 32 位 Java，这会导致 Minecraft 无法使用 1GB 以上的内存，进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏，然后再启动游戏。\n如果你没有安装 64 位的 Java，你可以从网络中下载、安装一个。"
Else
ResultString = "你正在使用 32 位的操作系统，这会导致 Minecraft 无法使用 1GB 以上的内存，进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内，那或许只能换台电脑了……\h"
End If
Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字
If Additional.Count = 1 Then
ResultString = "你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL2 找到了一个可疑的关键词：" & Additional.First & "。\n\n如果你知道它对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h"
Else
ResultString = "你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL2 找到了以下可疑的关键词：\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h"
End If
Case CrashReason.崩溃日志堆栈分析发现Mod名称
If Additional.Count = 1 Then
ResultString = "名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h"
Else
ResultString = "可能是以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h"
Else
ResultString = "以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.ModMixin失败
If Additional.Count = 1 Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着该 Mod 存在 Bug，或与当前环境不兼容。\n\e\h"
Else
ResultString = "以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug，或与当前环境不兼容。\n\e\h"
End If
Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h"
Else
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错：\n其配置文件 " & Additional(1) & " 存在异常，无法读取。"
End If
Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then
ResultString = "名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n\e\h"
Else
ResultString = "以下 Mod 初始化失败，导致游戏无法继续加载：\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
ResultString = "游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是该方块导致出错，你或许需要使用一些方式删除此方块。\n - 若仍然出错，问题就可能来自其他原因……\h"
Else
ResultString = "游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是某些方块导致出错，你或许需要删除该世界。\n - 若仍然出错，问题就可能来自其他原因……\h"
End If
Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then
ResultString = "你重复安装了多个相同的 Mod：\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。"
Else
ResultString = "你可能重复安装了多个相同的 Mod，导致游戏无法继续加载。\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。\e\h"
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
ResultString = "游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并生成一个该实体，然后观察游戏的运行情况：\n - 若正常运行，则是该实体导致出错，你或许需要使用一些方式删除此实体。\n - 若仍然出错，问题就可能来自其他原因……\h"
Else
ResultString = "游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界，并生成各种实体，观察游戏的运行情况：\n - 若正常运行，则是某些实体导致出错，你或许需要删除该世界。\n - 若仍然出错，问题就可能来自其他原因……\h"
End If
Case CrashReason.低版本Forge与高版本Java不兼容
ResultString = "由于低版本 Forge 与当前 Java 不兼容，导致了游戏崩溃。\n\n请尝试以下解决方案：\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java"
Case CrashReason.版本Json中存在多个Forge
ResultString = "可能由于使用其他启动器修改了 Forge 版本，当前版本的文件存在异常，导致了游戏崩溃。\n请尝试重新全新安装 Forge，而非使用其他启动器修改 Forge 版本。"
Case CrashReason.玩家手动触发调试崩溃
ResultString = "* 事实上，你的游戏没有任何问题，这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗？"
Case CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类
ResultString = "由于游戏路径含有中文字符，且 Java 或系统编码存在错误，导致游戏无法运行。\n\n解决这一问题的最简单方法是检查游戏的完整路径，并删除各个文件夹名中的中文字符。\n这包括了游戏的版本名、它所处的 .minecraft 文件夹及其之前的文件夹名。\h"
Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
ResultString = "你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现，你可以尝试更换 OptiFine 的版本。\h"
Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL
If LogAll.Contains("hd graphics ") Then
ResultString = "你的显卡驱动存在问题，或未使用独立显卡，导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡，请使用独立显卡而非 Intel 核显启动 PCL2 与 Minecraft。\n如果问题依然存在，请尝试升级你的显卡驱动到最新版本，或回退到出厂版本。\n如果还是不行，还可以尝试使用 8.0.51 或更低版本的 Java。\h"
Else
ResultString = "你的显卡驱动存在问题，导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本，或回退到出厂版本，然后再启动游戏。\n如果还是不行，可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在，那么你可能需要换个更好的显卡……\h"
End If
Case CrashReason.材质过大或显卡配置不足
ResultString = "你所使用的材质分辨率过高，或显卡配置不足，导致游戏无法继续运行。\n\n如果你正在使用高清材质，请将它移除。\n如果你没有使用材质，那么你可能需要更新显卡驱动，或者换个更好的显卡……\h"
Case CrashReason.光影或资源包导致OpenGL1282错误
ResultString = "你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h"
Case CrashReason.Mod过多导致超出ID限制
ResultString = "你所安装的 Mod 过多，超出了游戏的 ID 限制，导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod，或删除部分大型 Mod。"
Case CrashReason.文件或内容校验失败
ResultString = "部分文件或内容校验失败，导致游戏出现了问题。\n\n请尝试删除游戏（包括 Mod）并重新下载，或尝试在重新下载时使用 VPN。\h"
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
ResultString = "Fabric 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then
ResultString = "Mod 加载器提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then
ResultString = "Fabric 提供了以下解决方案：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Forge报错
If Additional.Count = 1 Then
ResultString = "Forge 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.没有可用的分析文件
ResultString = "你的游戏出现了一些问题，但 PCL2 未能找到相关记录文件，因此无法进行分析。\h"
Case Else
ResultString = "PCL2 获取到了没有详细信息的错误原因（" & CrashReasons.First.Key & "），请向 PCL2 作者提交反馈以获取详情。\h"
End Select
ResultString = ResultString.
Replace("\n", vbCrLf).
Replace("\h", If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。")).
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
Return ResultString.Trim(vbCrLf.ToCharArray)
End Function
End Class
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+1670
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+1826
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+3835
View File
File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More