上传公开代码
This commit is contained in:
龙腾猫跃
@@ -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>
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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>
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -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:="<挂起>")>
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 880 B |
Binary file not shown.
|
After Width: | Height: | Size: 991 B |
Binary file not shown.
|
After Width: | Height: | Size: 2.7 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 231 B |
Binary file not shown.
|
After Width: | Height: | Size: 275 B |
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.4 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 521 B |
Binary file not shown.
|
After Width: | Height: | Size: 791 B |
Binary file not shown.
|
After Width: | Height: | Size: 2.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 815 B |
Binary file not shown.
|
After Width: | Height: | Size: 332 B |
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 2.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 2.7 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 715 B |
Binary file not shown.
|
After Width: | Height: | Size: 2.7 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.8 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 2.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 434 B |
Binary file not shown.
|
After Width: | Height: | Size: 345 B |
Binary file not shown.
|
After Width: | Height: | Size: 963 B |
Binary file not shown.
|
After Width: | Height: | Size: 2.1 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 312 B |
Binary file not shown.
|
After Width: | Height: | Size: 951 B |
Binary file not shown.
|
After Width: | Height: | Size: 2.1 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 8.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 24 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 18 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 6.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 24 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 16 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 20 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 15 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 21 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 195 KiB |
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,619 @@
|
||||
Public Module ModModpack
|
||||
|
||||
'触发整合包安装的外部接口
|
||||
''' <summary>
|
||||
''' 弹窗要求选择一个整合包文件并进行安装。
|
||||
''' </summary>
|
||||
Public Sub ModpackInstall()
|
||||
Dim File As String = SelectFile("压缩包文件(*.rar;*.zip)|*.rar;*.zip", "选择整合包压缩文件") '选择整合包文件
|
||||
If String.IsNullOrEmpty(File) Then Exit Sub
|
||||
RunInThread(Sub() ModpackInstall(File))
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。
|
||||
''' </summary>
|
||||
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True) As Boolean
|
||||
Log("[ModPack] 整合包安装请求：" & If(File, "null"))
|
||||
Dim Archive As Compression.ZipArchive = Nothing
|
||||
Dim ArchiveBaseFolder As String = ""
|
||||
Try
|
||||
'获取整合包种类与关键 Json
|
||||
Dim PackType As Integer = -1
|
||||
Try
|
||||
Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open))
|
||||
'从根目录判断整合包类型
|
||||
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
|
||||
If Archive.GetEntry("manifest.json") IsNot Nothing Then
|
||||
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
|
||||
If Json("addons") Is Nothing Then
|
||||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||||
Else
|
||||
PackType = 3 : Exit Try 'MCBBS 整合包
|
||||
End If
|
||||
End If
|
||||
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
|
||||
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
|
||||
'从一级目录判断整合包类型
|
||||
For Each Entry In Archive.Entries
|
||||
Dim FullNames As String() = Entry.FullName.Split("/")
|
||||
ArchiveBaseFolder = FullNames(0) & "/"
|
||||
If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
|
||||
'确定为一级目录下
|
||||
If FullNames.Count <> 2 Then Continue For
|
||||
'判断是否为关键文件
|
||||
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
|
||||
If FullNames(1) = "manifest.json" Then
|
||||
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
|
||||
If Json("addons") Is Nothing Then
|
||||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||||
Else
|
||||
PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
|
||||
End If
|
||||
End If
|
||||
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
|
||||
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
|
||||
Next
|
||||
Catch ex As Exception
|
||||
If File.ToLower.EndsWith(".rar") Then
|
||||
Log(ex, "PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Else
|
||||
Log(ex, "打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
End If
|
||||
End Try
|
||||
'执行对应的安装方法
|
||||
Select Case PackType
|
||||
Case 0
|
||||
Log("[ModPack] 整合包种类：CurseForge")
|
||||
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName)
|
||||
Case 1
|
||||
Log("[ModPack] 整合包种类：HMCL")
|
||||
InstallPackHMCL(File, Archive, ArchiveBaseFolder)
|
||||
Case 2
|
||||
Log("[ModPack] 整合包种类：MMC")
|
||||
InstallPackMMC(File, Archive, ArchiveBaseFolder)
|
||||
Case 3
|
||||
Log("[ModPack] 整合包种类：MCBBS")
|
||||
InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
|
||||
Case 9
|
||||
Log("[ModPack] 整合包种类：压缩包")
|
||||
Archive.Dispose()
|
||||
Archive = Nothing
|
||||
InstallPackCompress(File, ArchiveBaseFolder)
|
||||
Case Else
|
||||
If ShowHint Then
|
||||
Hint("未能识别该整合包的种类，无法安装！", HintType.Critical)
|
||||
Else
|
||||
Log("[ModPack] 未能识别该整合包的种类，无法安装！")
|
||||
End If
|
||||
Return False
|
||||
End Select
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
Log(ex, "准备安装整合包失败", LogLevel.Feedback)
|
||||
Return False
|
||||
Finally
|
||||
If Archive IsNot Nothing Then Archive.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
'整合包缓存清理
|
||||
Private IsInstallCacheCleared As Boolean = False
|
||||
Private IsInstallCacheClearing As Boolean = False
|
||||
Private Sub UnpackFiles(InstallTemp As String, FileAddress As String)
|
||||
'清理缓存文件夹
|
||||
If Not IsInstallCacheCleared Then
|
||||
IsInstallCacheCleared = True
|
||||
IsInstallCacheClearing = True
|
||||
Try
|
||||
Log("[ModPack] 开始清理整合包安装缓存")
|
||||
DeleteDirectory(PathTemp & "PackInstall\")
|
||||
Log("[ModPack] 已清理整合包安装缓存")
|
||||
Catch ex As Exception
|
||||
Log(ex, "清理整合包安装缓存失败")
|
||||
Finally
|
||||
IsInstallCacheClearing = False
|
||||
End Try
|
||||
ElseIf IsInstallCacheClearing Then
|
||||
'等待另一个整合包安装的清理步骤完成
|
||||
Do While IsInstallCacheClearing
|
||||
Thread.Sleep(1)
|
||||
Loop
|
||||
End If
|
||||
'解压文件
|
||||
Dim RetryCount As Integer = 1
|
||||
Dim Encode = Encoding.Default
|
||||
Try
|
||||
Retry:
|
||||
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之多试试
|
||||
Directory.CreateDirectory(InstallTemp)
|
||||
DeleteDirectory(InstallTemp)
|
||||
Compression.ZipFile.ExtractToDirectory(FileAddress, InstallTemp, Encode)
|
||||
Catch ex As Exception
|
||||
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
|
||||
If TypeOf ex Is ArgumentException Then
|
||||
Encode = Encoding.UTF8
|
||||
Log("[ModPack] 已切换压缩包解压编码为 UTF8")
|
||||
End If
|
||||
If RetryCount < 5 Then
|
||||
Thread.Sleep(RetryCount * 2000)
|
||||
RetryCount += 1
|
||||
GoTo Retry
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
#Region "不同类型整合包的安装方法"
|
||||
|
||||
'CurseForge
|
||||
''' <summary>
|
||||
''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。
|
||||
''' 加载器以安装目标版本文件夹为输入。
|
||||
''' </summary>
|
||||
Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
|
||||
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Return Nothing
|
||||
End Try
|
||||
'获取 Mod API 版本信息
|
||||
Dim ForgeVersion As String = Nothing
|
||||
Dim FabricVersion As String = Nothing
|
||||
For Each Entry In If(Json("minecraft")("modLoaders"), {})
|
||||
Dim Id As String = If(Entry("id"), "").ToString.ToLower
|
||||
If Id.StartsWith("forge-") Then
|
||||
'Forge 指定
|
||||
If Id.Contains("recommended") Then
|
||||
Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint)
|
||||
Return Nothing
|
||||
End If
|
||||
Try
|
||||
Log("[ModPack] 整合包 Forge 版本：" & Id)
|
||||
ForgeVersion = Id.Split("-")(1)
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 Forge 版本失败：" & Id)
|
||||
End Try
|
||||
ElseIf Id.StartsWith("fabric-") Then
|
||||
'Fabric 指定
|
||||
Try
|
||||
Log("[ModPack] 整合包 Fabric 版本：" & Id)
|
||||
FabricVersion = Id.Split("-")(1)
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 Fabric 版本失败：" & Id)
|
||||
End Try
|
||||
End If
|
||||
Next
|
||||
'解压与配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
Dim OverrideHome As String = If(Json("overrides"), "")
|
||||
If OverrideHome <> "" Then
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {
|
||||
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
End If
|
||||
'获取 Mod 列表
|
||||
Dim ModFileList As New List(Of Integer)
|
||||
For Each ModEntry In If(Json("files"), {})
|
||||
If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
|
||||
Hint("某项 Mod 缺少必要信息，已跳过：" & ModEntry.ToString)
|
||||
Continue For
|
||||
End If
|
||||
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then Continue For
|
||||
ModFileList.Add(ModEntry("fileID"))
|
||||
Next
|
||||
If ModFileList.Count > 0 Then
|
||||
'获取 Mod 下载信息
|
||||
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)(
|
||||
"获取 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||||
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
|
||||
'如果文件已被删除，则 API 会跳过那一项
|
||||
If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
|
||||
'构造 NetFile
|
||||
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
|
||||
Dim FileList As New Dictionary(Of Integer, NetFile)
|
||||
For Each ModJson In Task.Input
|
||||
'跳过重复的 Mod（疑似 CurseForge Bug）
|
||||
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
|
||||
'实际的添加
|
||||
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
|
||||
Task.Progress += 1 / (1 + ModFileList.Count)
|
||||
Next
|
||||
Task.Output = FileList.Values.ToList
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
|
||||
'下载 Mod 文件
|
||||
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
End If
|
||||
'构造加载器
|
||||
Dim Request As New McInstallRequest With {
|
||||
.TargetVersionName = VersionName,
|
||||
.MinecraftName = Json("minecraft")("version").ToString,
|
||||
.ForgeVersion = ForgeVersion,
|
||||
.FabricVersion = FabricVersion
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Return Nothing
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中！", HintType.Critical)
|
||||
Return Nothing
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Return Loader
|
||||
End Function
|
||||
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing)
|
||||
|
||||
'获取版本名
|
||||
Dim ShowRibble As Boolean = VersionName Is Nothing
|
||||
If VersionName Is Nothing Then
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
|
||||
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
End Try
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
VersionName = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
|
||||
Title:="输入版本名", Button2:="取消")
|
||||
If String.IsNullOrEmpty(VersionName) Then Exit Sub
|
||||
End If
|
||||
|
||||
'启动加载器
|
||||
Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName)
|
||||
If Loader Is Nothing Then Exit Sub
|
||||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
|
||||
|
||||
End Sub
|
||||
|
||||
'HMCL
|
||||
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
|
||||
Title:="输入版本名", Button2:="取消")
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
'解压与配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造加载器
|
||||
If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Request As New McInstallRequest With {
|
||||
.TargetVersionName = VersionName,
|
||||
.MinecraftName = Json("gameVersion").ToString
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
|
||||
Sub()
|
||||
Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
|
||||
Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
|
||||
If File.Exists(OldFileName) Then
|
||||
'修改 id
|
||||
Dim FileJson = GetJson(ReadFile(OldFileName))
|
||||
FileJson("id") = VersionName
|
||||
'替换文件
|
||||
File.Delete(OldFileName)
|
||||
WriteFile(RealFileName, FileJson.ToString)
|
||||
Log("[ModPack] 已重命名版本 Json：" & RealFileName)
|
||||
End If
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase) From {
|
||||
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime},
|
||||
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime},
|
||||
New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
|
||||
}
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中！", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
|
||||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
|
||||
'MMC
|
||||
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
'读取 Json 文件
|
||||
Dim PackJson As JObject, PackInstance As String
|
||||
Try
|
||||
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
|
||||
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
|
||||
Title:="输入版本名", Button2:="取消")
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
'解压与配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造版本安装请求
|
||||
If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
|
||||
For Each Component In PackJson("components")
|
||||
Select Case If(Component("uid"), "").ToString
|
||||
Case "org.lwjgl"
|
||||
Log("[ModPack] 已跳过 LWJGL 项")
|
||||
Case "net.minecraft"
|
||||
Request.MinecraftName = Component("version")
|
||||
Case "net.minecraftforge"
|
||||
Request.ForgeVersion = Component("version")
|
||||
End Select
|
||||
Next
|
||||
'构造加载器
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中！", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
|
||||
'MCBBS
|
||||
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
|
||||
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
|
||||
Title:="输入版本名", Button2:="取消")
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
'解压与配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造加载器
|
||||
If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Addons As New Dictionary(Of String, String)
|
||||
For Each Entry In Json("addons")
|
||||
Addons.Add(Entry("id"), Entry("version"))
|
||||
Next
|
||||
If Not Addons.ContainsKey("game") Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Request As New McInstallRequest With {
|
||||
.TargetVersionName = VersionName,
|
||||
.MinecraftName = Addons("game"),
|
||||
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
|
||||
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
|
||||
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中！", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
|
||||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
|
||||
'普通压缩包
|
||||
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
|
||||
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
|
||||
'获取解压路径
|
||||
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
|
||||
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Exit Sub
|
||||
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Exit Sub
|
||||
'要求显示名称
|
||||
Dim NewName As String = MyMsgBoxInput(GetFolderNameFromPath(TargetFolder), New ObjectModel.Collection(Of Validate) From {
|
||||
New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})
|
||||
},, "输入它在列表中的显示名称",, "取消")
|
||||
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
|
||||
'解压
|
||||
Hint("正在解压压缩包……")
|
||||
UnpackFiles(TargetFolder, FileAddress)
|
||||
'加入文件夹列表
|
||||
PageSelectLeft.AddFolder(TargetFolder, NewName, False)
|
||||
Hint("已加入游戏文件夹列表：" & NewName, HintType.Finish)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Module
|
||||
@@ -0,0 +1,361 @@
|
||||
Public Module ModWatcher
|
||||
|
||||
'对全体的监视
|
||||
Public McWatcherList As New List(Of Watcher)
|
||||
Private IsWatcherRunning As Boolean = False
|
||||
Public HasRunningMinecraft As Boolean = False
|
||||
Private Sub WatcherStateChanged()
|
||||
Dim IsRunning As Boolean = False
|
||||
Dim IsCrashed As Boolean = False
|
||||
For Each Watcher In McWatcherList
|
||||
If Watcher.State = Watcher.MinecraftState.Loading OrElse Watcher.State = Watcher.MinecraftState.Running Then
|
||||
IsRunning = True
|
||||
Exit For
|
||||
ElseIf Watcher.State = Watcher.MinecraftState.Crashed Then
|
||||
IsCrashed = True
|
||||
End If
|
||||
Next
|
||||
If IsWatcherRunning = IsRunning Then Exit Sub
|
||||
IsWatcherRunning = IsRunning
|
||||
If IsWatcherRunning Then
|
||||
MinecraftStart()
|
||||
Else
|
||||
MinecraftStop(IsCrashed)
|
||||
End If
|
||||
End Sub
|
||||
Private Sub MinecraftStart()
|
||||
McLaunchLog("[全局] 出现运行中的 Minecraft")
|
||||
HasRunningMinecraft = True
|
||||
FrmMain.BtnExtraShutdown.ShowRefresh()
|
||||
End Sub
|
||||
Private Sub MinecraftStop(HasMinecraftCrashed As Boolean)
|
||||
McLaunchLog("[全局] 已无运行中的 Minecraft")
|
||||
HasRunningMinecraft = False
|
||||
FrmMain.BtnExtraShutdown.ShowRefresh()
|
||||
'音乐播放
|
||||
If Setup.Get("UiMusicStop") Then
|
||||
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放"))
|
||||
ElseIf Setup.Get("UiMusicStart") Then
|
||||
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放"))
|
||||
End If
|
||||
'启动器可见性
|
||||
Select Case Setup.Get("LaunchArgumentVisible")
|
||||
Case 2
|
||||
'直接关闭
|
||||
If HasMinecraftCrashed Then
|
||||
RunInUi(Sub() FrmMain.Hidden = False)
|
||||
Else
|
||||
RunInUi(Sub() FrmMain.EndProgram(False))
|
||||
End If
|
||||
Case 3
|
||||
'恢复
|
||||
RunInUi(Sub() FrmMain.Hidden = False)
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
'对单个进程的监视
|
||||
Public Class Watcher
|
||||
|
||||
'初始化
|
||||
Public GameProcess As Process
|
||||
Public Version As McVersion
|
||||
Private WindowTitle As String = ""
|
||||
Private PID As Integer
|
||||
Public Loader As LoaderTask(Of Process, Integer)
|
||||
Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String)
|
||||
Me.Loader = Loader
|
||||
Me.Version = Version
|
||||
Me.WindowTitle = WindowTitle
|
||||
Me.PID = Loader.Input.Id
|
||||
WatcherLog("开始 Minecraft 日志监控")
|
||||
If Me.WindowTitle <> "" Then WatcherLog("要求窗口标题：" & WindowTitle)
|
||||
|
||||
'更改列表
|
||||
Dim NewWatcherList As New List(Of Watcher)
|
||||
For Each Watch In McWatcherList
|
||||
If Watch.State = MinecraftState.Crashed OrElse Watch.State = MinecraftState.Ended Then Continue For
|
||||
NewWatcherList.Add(Watch)
|
||||
Next
|
||||
NewWatcherList.Add(Me)
|
||||
McWatcherList = NewWatcherList
|
||||
WatcherStateChanged()
|
||||
|
||||
'初始化进程与日志读取
|
||||
Me.GameProcess = Loader.Input
|
||||
GameProcess.BeginOutputReadLine()
|
||||
GameProcess.BeginErrorReadLine()
|
||||
AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived
|
||||
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
|
||||
|
||||
'初始化时钟
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
MinecraftBeforeLaunch = GetAllMinecraftWindowHandle(False).Keys.ToList
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse Loader.State = LoadState.Aborted
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
If State = MinecraftState.Loading Then ProgressUpdate()
|
||||
'设置窗口标题
|
||||
For i = 1 To 3
|
||||
If IsWindowFinished AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
|
||||
Dim RealTitle As String = WindowTitle.Replace("{time}", Date.Now.ToShortTimeString)
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
Next
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
End Sub
|
||||
|
||||
'状态
|
||||
Private _State As MinecraftState = MinecraftState.Loading
|
||||
Public Property State As MinecraftState
|
||||
Get
|
||||
Return _State
|
||||
End Get
|
||||
Set(ByVal value As MinecraftState)
|
||||
If _State = value Then Exit Property
|
||||
_State = value
|
||||
WatcherStateChanged()
|
||||
End Set
|
||||
End Property
|
||||
Public Enum MinecraftState
|
||||
Loading
|
||||
Running
|
||||
Crashed
|
||||
Ended
|
||||
End Enum
|
||||
|
||||
'日志
|
||||
Public WaitingLog As New List(Of String)(1000)
|
||||
Private ReadOnly WaitingLogLock As New Object
|
||||
Private Sub LogReceived(sender As Object, e As DataReceivedEventArgs)
|
||||
SyncLock WaitingLogLock
|
||||
WaitingLog.Add(e.Data)
|
||||
End SyncLock
|
||||
End Sub
|
||||
Private Sub TimerLog()
|
||||
Try
|
||||
'输出文本
|
||||
Dim Copyed As New List(Of String)
|
||||
SyncLock WaitingLogLock
|
||||
If WaitingLog.Count = 0 Then Exit Sub
|
||||
Copyed = WaitingLog
|
||||
WaitingLog = New List(Of String)(1000)
|
||||
End SyncLock
|
||||
For Each Str As String In Copyed
|
||||
GameLog(Str)
|
||||
Next
|
||||
'游戏退出检查
|
||||
If GameProcess.HasExited Then
|
||||
WatcherLog("Minecraft 已退出，返回值：" & GameProcess.ExitCode)
|
||||
'If Process.ExitCode = 1 Then
|
||||
' '返回值为 1，考虑是任务管理器结束
|
||||
' WatcherLog("Minecraft 返回值为 1，考虑为任务管理器结束") '并不，崩了照样是 1
|
||||
' State = MinecraftState.Ended
|
||||
'Else
|
||||
If State = MinecraftState.Loading Then
|
||||
'窗口未出现
|
||||
WatcherLog("Minecraft 尚未加载完成，可能已崩溃")
|
||||
Crashed()
|
||||
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then
|
||||
'返回值不为 0 且未结束
|
||||
WatcherLog("Minecraft 返回值异常，可能已崩溃")
|
||||
Crashed()
|
||||
Else
|
||||
'正常关闭
|
||||
State = MinecraftState.Ended
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
Public LatestLog As New Queue(Of String)
|
||||
Private Sub GameLog(Text As String)
|
||||
'预处理
|
||||
If Text Is Nothing Then Exit Sub
|
||||
Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
|
||||
'加入预存储
|
||||
LatestLog.Enqueue(Text)
|
||||
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
|
||||
'进度处理
|
||||
If LogProgress < 1 Then
|
||||
WatcherLog("日志 1/5：已出现日志输出")
|
||||
LogProgress = 1
|
||||
End If '可能第一句就是后面需要判断的 Log（重现：启动 1.15.2 原版）
|
||||
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
|
||||
WatcherLog("日志 2/5：游戏用户已设置") '仅确保支持 Minecraft 1.7+
|
||||
LogProgress = 2
|
||||
ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then
|
||||
WatcherLog("日志 3/5：LWJGL 版本已确认")
|
||||
LogProgress = 3
|
||||
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
|
||||
WatcherLog("日志 4/5：OpenAL 已加载") '仅确保支持 Minecraft 1.7+
|
||||
LogProgress = 4
|
||||
ElseIf LogProgress < 5 AndAlso ((Text.Contains("Created") AndAlso Text.Contains("textures") AndAlso Text.Contains("-atlas")) OrElse Text.Contains("Found animation info")) Then
|
||||
WatcherLog("日志 5/5：材质已加载") '仅确保支持 Minecraft 1.7+
|
||||
LogProgress = 5
|
||||
End If
|
||||
'输出日志
|
||||
'Log(Text)
|
||||
'关闭与崩溃检测
|
||||
If Not Text.Contains("[CHAT]") Then
|
||||
If Text.Contains("Someone is closing me!") Then
|
||||
WatcherLog("识别为关闭的 Log：" & Text)
|
||||
State = MinecraftState.Ended
|
||||
ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then
|
||||
' Text.Contains("Minecraft ran into a problem! Report saved to:") Then
|
||||
'Minecraft 崩溃，忽略 VanillaFix
|
||||
WatcherLog("识别为崩溃的 Log：" & Text)
|
||||
Crashed()
|
||||
ElseIf Text.Contains("Could not save crash report to") Then
|
||||
'Minecraft 崩溃，无法保存崩溃日志
|
||||
WatcherLog("识别为崩溃的 Log：" & Text)
|
||||
Crashed()
|
||||
ElseIf Text.Contains("/ERROR]: Unable to launch") OrElse Text.Contains("An exception was thrown, the game will display an error screen and halt.") Then
|
||||
'Forge 崩溃
|
||||
WatcherLog("识别为崩溃的 Log：" & Text)
|
||||
Crashed()
|
||||
'ElseIf Text.Contains("Shutdown failure!") Then
|
||||
' 'Minecraft 强行崩溃，由于点 X 强行关闭也会触发这句话，所以不可用
|
||||
' Crashed(Nothing)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Private Sub WatcherLog(Text As String)
|
||||
McLaunchLog("[" & PID & "] " & Text)
|
||||
End Sub
|
||||
|
||||
'进度更新
|
||||
Private LogProgress As Integer = 0
|
||||
Private Sub ProgressUpdate()
|
||||
Dim CurrentProgress As Double
|
||||
If IsWindowAppeared OrElse LogProgress = 5 Then
|
||||
CurrentProgress = 0.95
|
||||
WatcherLog("Minecraft 加载已完成")
|
||||
State = MinecraftState.Running
|
||||
Else
|
||||
CurrentProgress = Math.Min(LogProgress, 3) / 3 * 0.9
|
||||
End If
|
||||
Loader.Progress = CurrentProgress
|
||||
End Sub
|
||||
|
||||
'窗口检查
|
||||
Private IsWindowAppeared As Boolean = False
|
||||
Private IsWindowFinished As Boolean = False
|
||||
Private WindowHandle As IntPtr
|
||||
Private MinecraftBeforeLaunch As List(Of IntPtr)
|
||||
Private Sub TimerWindow()
|
||||
Try
|
||||
If GameProcess.HasExited Then Exit Sub
|
||||
If Not IsWindowFinished Then
|
||||
'获取全部窗口，检查是否有新增的
|
||||
Dim MinecraftWindows = GetAllMinecraftWindowHandle(True)
|
||||
For Each Window In MinecraftBeforeLaunch
|
||||
If MinecraftWindows.ContainsKey(Window) Then MinecraftWindows.Remove(Window)
|
||||
Next
|
||||
If MinecraftWindows.Count = 0 Then Exit Sub
|
||||
'已找到窗口
|
||||
If MinecraftWindows.Values(0) Then
|
||||
'已找到 Minecraft 窗口
|
||||
WindowHandle = MinecraftWindows.Keys(0)
|
||||
WatcherLog("Minecraft 窗口已加载：" & WindowHandle.ToInt64)
|
||||
IsWindowFinished = True
|
||||
'最大化
|
||||
Thread.Sleep(3000) '1.7.10 LiteLoader 不延迟会显示错误
|
||||
If Setup.Get("LaunchArgumentWindowType") = 4 Then ShowWindow(WindowHandle, 3)
|
||||
ElseIf Not IsWindowAppeared Then
|
||||
'已找到 FML 窗口
|
||||
WatcherLog("FML 窗口已加载：" & MinecraftWindows.Keys(0).ToInt64)
|
||||
End If
|
||||
IsWindowAppeared = True
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 获取所有 Minecraft 窗口句柄。
|
||||
''' Value: 是否为 Minecraft 窗口，而不是 FML 窗口。
|
||||
''' </summary>
|
||||
''' <param name="CanUseFml">是否包含 FML 窗口</param>
|
||||
Private Function GetAllMinecraftWindowHandle(CanUseFml As Boolean) As Dictionary(Of IntPtr, Boolean)
|
||||
Dim AllList As New Dictionary(Of IntPtr, Boolean)
|
||||
EnumWindows(Sub(hwnd As IntPtr, lParam As Integer)
|
||||
'检查类名
|
||||
Dim str As New StringBuilder(512)
|
||||
GetClassName(hwnd, str, str.Capacity)
|
||||
Dim ClassName As String = str.ToString
|
||||
If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Exit Sub
|
||||
'检查窗口标题名
|
||||
str = New StringBuilder(512)
|
||||
GetWindowText(hwnd, str, str.Capacity)
|
||||
Dim WindowText As String = str.ToString
|
||||
If CanUseFml AndAlso WindowText.StartsWith("FML") Then
|
||||
AllList.Add(hwnd, False)
|
||||
ElseIf Not (WindowText.StartsWith("GLFW") OrElse WindowText = "PopupMessageWindow") Then
|
||||
'有的 Mod 可以修改窗口标题，不能检测是否为 Minecraft 打头
|
||||
'部分版本会搞个 GLFW message window 出来所以得反选
|
||||
AllList.Add(hwnd, True)
|
||||
End If
|
||||
'If WindowText.StartsWith("Minecraft") Then
|
||||
' AllList.Add(hwnd, True)
|
||||
'ElseIf CanUseFml AndAlso WindowText.StartsWith("FML") Then
|
||||
' AllList.Add(hwnd, False)
|
||||
'End If
|
||||
End Sub, 0)
|
||||
Return AllList
|
||||
End Function
|
||||
Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer)
|
||||
Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean
|
||||
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer
|
||||
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer
|
||||
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (hWnd As Integer, str As String) As Boolean
|
||||
Private Declare Function ShowWindow Lib "user32" (hWnd As IntPtr, cmdWindow As UInteger) As Boolean
|
||||
|
||||
'崩溃处理
|
||||
Private Sub Crashed()
|
||||
If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Exit Sub
|
||||
State = MinecraftState.Crashed
|
||||
'崩溃分析
|
||||
WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析")
|
||||
Hint("检测到 Minecraft 出现错误，错误分析已开始……")
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json",
|
||||
Path & "PCL\Log1.txt",
|
||||
Path & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
End Sub
|
||||
|
||||
'强制关闭
|
||||
Public Sub Kill()
|
||||
State = MinecraftState.Ended
|
||||
WatcherLog("尝试强制结束 Minecraft 进程")
|
||||
Try
|
||||
If Not GameProcess.HasExited Then GameProcess.Kill()
|
||||
WatcherLog("已强制结束 Minecraft 进程")
|
||||
Catch ex As Exception
|
||||
Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
End Module
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user