Merge branch 'main' into main
This commit is contained in:
龙腾猫跃
@@ -5,13 +5,10 @@
|
||||
<httpWebRequest useUnsafeHeaderParsing="true"/>
|
||||
</settings>
|
||||
</system.net>
|
||||
<startup>
|
||||
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
|
||||
<startup>
|
||||
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
|
||||
</startup>
|
||||
<runtime>
|
||||
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
|
||||
<AppContextSwitchOverrides value="Switch.System.Windows.DoNotScaleForDpiChanges=false"/> <!-- #5337 -->
|
||||
<AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" /> <!-- 长路径支持 -->
|
||||
<generatePublisherEvidence enabled="false"/>
|
||||
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
|
||||
<dependentAssembly>
|
||||
@@ -26,10 +23,10 @@
|
||||
<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>
|
||||
<dependentAssembly>
|
||||
<assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/>
|
||||
<bindingRedirect oldVersion="0.0.0.0-6.0.0.0" newVersion="13.0.0.0"/>
|
||||
</dependentAssembly>
|
||||
</assemblyBinding>
|
||||
</runtime>
|
||||
</configuration>
|
||||
|
||||
@@ -1,24 +1,21 @@
|
||||
<Application x:Class="Application"
|
||||
<Application x:Class="Application"
|
||||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
|
||||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
|
||||
xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors"
|
||||
xmlns:local="clr-namespace:PCL"
|
||||
xmlns:core="clr-namespace:MeloongCore;assembly=MeloongCore"
|
||||
xmlns:corewpf="clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"
|
||||
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>
|
||||
|
||||
<!-- Converter -->
|
||||
<local:AdditionConverter x:Key="AdditionConverter"/>
|
||||
<local:MultiplicationConverter x:Key="MultiplicationConverter"/>
|
||||
<local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
|
||||
<local:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
|
||||
<corewpf:AdditionConverter x:Key="AdditionConverter"/>
|
||||
<corewpf:MultiplicationConverter x:Key="MultiplicationConverter"/>
|
||||
<corewpf:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
|
||||
<corewpf:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
|
||||
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
|
||||
|
||||
<!-- 颜色表 -->
|
||||
@@ -66,7 +63,7 @@
|
||||
<SolidColorBrush x:Key="ColorBrushWhite" Color="#ffffff" />
|
||||
<SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
|
||||
<SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
|
||||
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
|
||||
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#F1FFFFFF" />
|
||||
|
||||
<!-- Window -->
|
||||
<Style TargetType="{x:Type Window}" x:Key="MyWindow">
|
||||
@@ -229,7 +226,7 @@
|
||||
</Setter.Value>
|
||||
</Setter>
|
||||
</Style>
|
||||
<Style TargetType="local:PageComp" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
|
||||
<Style TargetType="local:PageResource" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
|
||||
<Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
|
||||
<Setter Property="OverridesDefaultStyle" Value="True" />
|
||||
<Setter Property="CanContentScroll" Value="False" />
|
||||
@@ -294,7 +291,7 @@
|
||||
<Setter Property="Template">
|
||||
<Setter.Value>
|
||||
<ControlTemplate TargetType="local:MyTextBox">
|
||||
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
|
||||
<Grid SnapsToDevicePixels="True">
|
||||
<Grid.RowDefinitions>
|
||||
<RowDefinition MinHeight="28" />
|
||||
<RowDefinition Height="Auto" />
|
||||
@@ -312,6 +309,7 @@
|
||||
</ControlTemplate>
|
||||
</Setter.Value>
|
||||
</Setter>
|
||||
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
|
||||
</Style>
|
||||
<Style TargetType="PasswordBox">
|
||||
<Setter Property="FontSize" Value="13" />
|
||||
@@ -353,6 +351,7 @@
|
||||
</ControlTemplate>
|
||||
</Setter.Value>
|
||||
</Setter>
|
||||
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
|
||||
</Style>
|
||||
|
||||
<!-- ComboBox -->
|
||||
@@ -372,7 +371,7 @@
|
||||
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
|
||||
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
|
||||
<Setter Property="FontSize" Value="13" />
|
||||
<Setter Property="MaxDropDownHeight" Value="160" />
|
||||
<Setter Property="MaxDropDownHeight" Value="320" />
|
||||
<Setter Property="Template">
|
||||
<Setter.Value>
|
||||
<ControlTemplate TargetType="ComboBox">
|
||||
@@ -478,11 +477,6 @@
|
||||
</Style>
|
||||
<Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
|
||||
<Setter Property="OverridesDefaultStyle" Value="True" />
|
||||
<Setter Property="ToolTipService.Placement" Value="Relative" />
|
||||
<Setter Property="ToolTipService.VerticalOffset" Value="-2" />
|
||||
<Setter Property="ToolTipService.HorizontalOffset" Value="200" />
|
||||
<Setter Property="ToolTipService.InitialShowDelay" Value="150" />
|
||||
<Setter Property="ToolTipService.BetweenShowDelay" Value="150" />
|
||||
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
|
||||
<Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" />
|
||||
<Setter Property="Template">
|
||||
|
||||
@@ -1,25 +1,41 @@
|
||||
Imports System.Reflection
|
||||
Imports System.Reflection
|
||||
Imports System.Windows.Threading
|
||||
Imports Microsoft.Win32
|
||||
|
||||
Public Class Application
|
||||
|
||||
#If DEBUG Then
|
||||
''' <summary>
|
||||
''' 用于开始程序时的一些测试。
|
||||
''' </summary>
|
||||
Private Sub Test()
|
||||
Try
|
||||
ModDevelop.Start()
|
||||
Catch ex As Exception
|
||||
Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub
|
||||
#End If
|
||||
|
||||
'开始
|
||||
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
|
||||
Try
|
||||
SecretOnApplicationStart()
|
||||
'核心初始化
|
||||
MeloongCore.Main.Init("PCL")
|
||||
MeloongCore.Wpf.Main.Init()
|
||||
Logger.Instance = New PclLogger With {.logFolder = Paths.BaseThenName, .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)}
|
||||
'提升主线程优先级
|
||||
Thread.CurrentThread.Priority = ThreadPriority.Highest
|
||||
'执行开发版测试
|
||||
If BuildType = BuildTypes.Debug Then
|
||||
Try
|
||||
ModDevelop.Start()
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "开发者模式测试出错", LogBehavior.Alert)
|
||||
End Try
|
||||
End If
|
||||
'检查 .NET Framework 版本
|
||||
Try
|
||||
Using ndpKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\")
|
||||
If ndpKey?.GetValue("Release") IsNot Nothing AndAlso CInt(ndpKey.GetValue("Release")) < 528040 Then OldEnvironmentAssert()
|
||||
End Using
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "检查 .NET Framework 版本失败")
|
||||
End Try
|
||||
'修复 WPF 字体加载（#3467）
|
||||
Try
|
||||
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
Catch ex As UriFormatException
|
||||
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
|
||||
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
End Try
|
||||
'检查参数调用
|
||||
If e.Args.Length > 0 Then
|
||||
If e.Args(0) = "--update" Then
|
||||
@@ -48,232 +64,219 @@ Public Class Application
|
||||
Else
|
||||
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量（K）
|
||||
End If
|
||||
#If DEBUG Then
|
||||
'制作更新包
|
||||
ElseIf e.Args(0) = "--edit1" Then
|
||||
ExeEdit(e.Args(1), True)
|
||||
Environment.Exit(ProcessReturnValues.TaskDone)
|
||||
ElseIf e.Args(0) = "--edit2" Then
|
||||
ExeEdit(e.Args(1), False)
|
||||
Environment.Exit(ProcessReturnValues.TaskDone)
|
||||
#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("PCL 没有对 " & PathTemp & " 的访问权限")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Pictures\")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
|
||||
CheckPermissionWithException(Paths.Base & "PCL\")
|
||||
Catch ex As Exception
|
||||
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
|
||||
MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & "错误原因：" & GetExceptionDetail(ex), "缓存文件夹不可用")
|
||||
MsgBox($"PCL 没有对当前文件夹的权限（{Paths.Base}PCL\），请尝试：" & vbCrLf &
|
||||
"1. 将 PCL 移动到其他文件夹" & If(Paths.Base.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
|
||||
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
|
||||
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
|
||||
MsgBoxStyle.Critical, "运行环境错误")
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End Try
|
||||
RetryCacheCheck:
|
||||
Try
|
||||
DirectoryUtils.Create(PathTemp)
|
||||
CheckPermissionWithException(PathTemp)
|
||||
Catch ex As Exception
|
||||
If PathTemp = Path.GetTempPath() & "PCL\" Then
|
||||
MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
|
||||
Else
|
||||
MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetExceptionDetail(ex), "缓存文件夹不可用")
|
||||
Setup.Set("SystemSystemCache", "")
|
||||
PathTemp = IO.Path.GetTempPath() & "PCL\"
|
||||
MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
|
||||
Settings.Set("SystemSystemCache", "")
|
||||
PathTemp = Path.GetTempPath() & "PCL\"
|
||||
GoTo RetryCacheCheck
|
||||
End If
|
||||
End Try
|
||||
Directory.CreateDirectory(PathTemp & "Cache")
|
||||
Directory.CreateDirectory(PathTemp & "Download")
|
||||
Directory.CreateDirectory(PathAppdata)
|
||||
'检测单例
|
||||
#If Not DEBUG Then
|
||||
Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
|
||||
Dim WaitRetryCount As Integer = 0
|
||||
WaitRetry:
|
||||
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
|
||||
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
|
||||
If WindowHwnd <> IntPtr.Zero Then
|
||||
If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
|
||||
WaitRetryCount += 1
|
||||
Thread.Sleep(500)
|
||||
GoTo WaitRetry
|
||||
End If
|
||||
'将已有的 PCL 窗口拖出来
|
||||
ShowWindowToTop(WindowHwnd)
|
||||
'播放提示音并退出
|
||||
Beep()
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End If
|
||||
#End If
|
||||
DirectoryUtils.Create(PathTemp & "Cache\")
|
||||
DirectoryUtils.Create(Paths.AppDataThenName)
|
||||
'要求单例
|
||||
WaitingMutex(e)
|
||||
'设置 ToolTipService 默认值
|
||||
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300))
|
||||
ToolTipService.BetweenShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(400))
|
||||
ToolTipService.ShowDurationProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(9999999))
|
||||
ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
|
||||
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
|
||||
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
|
||||
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(100))
|
||||
'设置网络配置默认值
|
||||
ServicePointManager.Expect100Continue = False
|
||||
ServicePointManager.DefaultConnectionLimit = 10000
|
||||
ServicePointManager.UseNagleAlgorithm = False
|
||||
ServicePointManager.EnableDnsRoundRobin = True
|
||||
ServicePointManager.ReusePort = True
|
||||
If Environment.OSVersion.Version < New Version(6, 2) Then 'Windows 7 回退（#8519）
|
||||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
|
||||
End If
|
||||
'设置初始窗口
|
||||
If Setup.Get("UiLauncherLogo") Then
|
||||
If Settings.Get(Of Boolean)("UiLauncherLogo") 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}{If(CommitHash = "", "", $"，#{CommitHash}")})")
|
||||
#If RELEASE Then
|
||||
Log($"[Start] 识别码：{UniqueAddress}{If(ThemeCheckOne(9), "，正式版", "")}")
|
||||
#Else
|
||||
Log($"[Start] 识别码：{UniqueAddress}{If(ThemeCheckOne(9), "，已解锁反馈主题", "")}")
|
||||
#End If
|
||||
Log($"[Start] 程序路径：{PathWithName}")
|
||||
Log($"[Start] 系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
|
||||
Log($"[Start] 管理员权限：{IsAdmin()}")
|
||||
'基础信息
|
||||
Logger.Info($"程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
|
||||
If BuildType = BuildTypes.Snapshot Then
|
||||
Logger.Info($"识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}")
|
||||
Else
|
||||
Logger.Info($"识别码：{Identify}")
|
||||
End If
|
||||
Logger.Info($"程序路径：{PathExe}")
|
||||
Logger.Info($"系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
|
||||
Logger.Info($"管理员权限：{WindowsUtils.HasAdminRole()}")
|
||||
'检测异常环境
|
||||
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
|
||||
MyMsgBox("请将 PCL 从压缩包中解压之后再使用！" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置，部分功能也可能无法使用！", "环境警告", "我知道了", IsWarn:=True)
|
||||
If Paths.Base.Contains(Path.GetTempPath()) OrElse Paths.Base.Contains("AppData\Local\Temp\") Then
|
||||
MyMsgBox("请将 PCL 从压缩包中解压后再使用！" & vbCrLf & "如果不会解压，可以在网上寻找教程。", "需要解压！", "我知道了", IsWarn:=True, ForceWait:=True)
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
|
||||
End If
|
||||
If Is32BitSystem Then
|
||||
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True)
|
||||
If Not Environment.Is64BitOperatingSystem Then
|
||||
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，请重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True, ForceWait:=True)
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
|
||||
End If
|
||||
'设置初始化
|
||||
Setup.Load("SystemDebugMode")
|
||||
Setup.Load("SystemDebugAnim")
|
||||
Setup.Load("ToolDownloadThread")
|
||||
Setup.Load("ToolDownloadCert")
|
||||
Setup.Load("ToolDownloadSpeed")
|
||||
'网络配置初始化
|
||||
ServicePointManager.Expect100Continue = True
|
||||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
|
||||
ServicePointManager.DefaultConnectionLimit = 1024
|
||||
'计时
|
||||
Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms")
|
||||
ApplicationStartTick = GetTimeTick()
|
||||
'执行测试
|
||||
#If DEBUG Then
|
||||
Test()
|
||||
#End If
|
||||
Logger.Info($"第一阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
|
||||
ApplicationStartTick = GetTimeMs()
|
||||
AniControlEnabled += 1
|
||||
Catch ex As Exception
|
||||
Dim FilePath As String = Nothing
|
||||
Try
|
||||
FilePath = PathWithName
|
||||
FilePath = PathExe
|
||||
Catch
|
||||
End Try
|
||||
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
|
||||
MsgBox(ex.GetDisplay(True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Exception)
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 要求程序以单例运行。
|
||||
''' 如果已在运行，则将其窗口拖出来并播放提示音，然后结束当前进程。
|
||||
''' </summary>
|
||||
Private Shared Sub WaitingMutex(e As StartupEventArgs)
|
||||
If BuildType = BuildTypes.Debug Then Return
|
||||
Try
|
||||
Dim MutexCreatedNew As Boolean
|
||||
PclMutex = New Mutex(True, "PCL_SingletonMutex", MutexCreatedNew)
|
||||
If MutexCreatedNew Then Return
|
||||
Logger.Warn("已有一个 PCL 实例正在运行")
|
||||
'等待已有的 PCL 退出
|
||||
If e.Args.Length > 0 AndAlso e.Args(0) = "--wait" Then
|
||||
Try
|
||||
If PclMutex.WaitOne(10000) Then Return '等待至多 10 秒
|
||||
Catch Ignored As AbandonedMutexException
|
||||
Return '已有实例异常退出，继续启动
|
||||
End Try
|
||||
End If
|
||||
'将已有的 PCL 窗口拖出来
|
||||
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
|
||||
If WindowHwnd = IntPtr.Zero Then WindowHwnd = FindWindow(Nothing, "Plain Craft Launcher 2 ")
|
||||
If WindowHwnd <> IntPtr.Zero Then ShowWindowToTop(WindowHwnd)
|
||||
'播放提示音并退出
|
||||
Beep()
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "单例检查失败")
|
||||
End Try
|
||||
End Sub
|
||||
Private Shared PclMutex As Mutex
|
||||
|
||||
'结束
|
||||
Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
|
||||
FrmMain.EndProgram(False)
|
||||
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(ProcessReturnValues.Exception)
|
||||
Exit Sub
|
||||
'触发页面的 Dispatcher
|
||||
If FrmMain?.PageLeft IsNot Nothing AndAlso TypeOf FrmMain.PageLeft Is IDispatcherUnhandledException Then
|
||||
CType(FrmMain.PageLeft, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
|
||||
If e.Handled Then Return
|
||||
End If
|
||||
IsCritErrored = True
|
||||
Dim ExceptionString As String = GetExceptionDetail(e.Exception, 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(ProcessReturnValues.Cancel)
|
||||
If FrmMain?.PageRight IsNot Nothing AndAlso TypeOf FrmMain.PageRight Is IDispatcherUnhandledException Then
|
||||
CType(FrmMain.PageRight, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
|
||||
If e.Handled Then Return
|
||||
End If
|
||||
'正常处理
|
||||
e.Handled = True
|
||||
If IsProgramEnding Then Return
|
||||
FeedbackInfo()
|
||||
Dim Detail As String = e.Exception.GetDisplay(True)
|
||||
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
|
||||
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
|
||||
OldEnvironmentAssert(e.Exception)
|
||||
Else
|
||||
FeedbackInfo()
|
||||
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
|
||||
Logger.Error(e.Exception, "程序出现未知错误", LogBehavior.AlertThenCrash)
|
||||
End If
|
||||
End Sub
|
||||
Private Shared Sub OldEnvironmentAssert(Optional ex As Exception = Nothing)
|
||||
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net48-offline-installer")
|
||||
If ex Is Nothing Then
|
||||
Logger.Error($"你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.8！{vbCrLf}若安装失败，可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
|
||||
Else
|
||||
Logger.Error(ex, $"你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.8！{vbCrLf}若安装失败，可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'动态 DLL 调用
|
||||
Private Shared AssemblyNAudio As Assembly
|
||||
Private Shared AssemblyJson As Assembly
|
||||
Private Shared AssemblyDialog As Assembly
|
||||
Private Shared AssemblyImazenWebp As Assembly
|
||||
Private Shared ReadOnly AssemblyNAudioLock As New Object
|
||||
Private Shared ReadOnly AssemblyJsonLock As New Object
|
||||
Private Shared ReadOnly AssemblyDialogLock As New Object
|
||||
Private Shared ReadOnly AssemblyImazenWebpLock As New Object
|
||||
'动态 DLL 加载
|
||||
Private Sub New() '这里必须尽早调用，且不能使用任何库，否则加载 MeloongCore 就会导致崩溃
|
||||
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "ThrottleDebounce", "System.Net.Http.Formatting", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
|
||||
Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
|
||||
AddHandler AppDomain.CurrentDomain.AssemblyResolve,
|
||||
Function(sender As Object, Args As ResolveEventArgs) As Assembly
|
||||
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal))
|
||||
If Prefix Is Nothing Then Return Nothing
|
||||
Dim LazyAssembly = LoadedAssemblies.GetOrAdd(Prefix, Function(p) New Lazy(Of Assembly)(
|
||||
Function()
|
||||
Dim LoadedAssembly = Assembly.Load(DirectCast(My.Resources.ResourceManager.GetObject(p), Byte()))
|
||||
If p = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
|
||||
Return LoadedAssembly
|
||||
End Function, LazyThreadSafetyMode.ExecutionAndPublication))
|
||||
Return LazyAssembly.Value
|
||||
End Function
|
||||
End Sub
|
||||
Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase，进而调用 MeloongCore，所以不能放在 New 里
|
||||
SetDllDirectory(PathPure.TrimEnd("\"c))
|
||||
Try
|
||||
ExtractResources(PathPure & "libwebp.dll", "libwebp64")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃
|
||||
End Try
|
||||
End Sub
|
||||
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
|
||||
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
|
||||
If args.Name.StartsWithF("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.StartsWithF("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.StartsWithF("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.StartsWithF("Imazen.WebP") Then
|
||||
SyncLock AssemblyImazenWebpLock
|
||||
If AssemblyImazenWebp Is Nothing Then
|
||||
Log("[Start] 加载 DLL：Imazen.WebP")
|
||||
AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
|
||||
SetDllDirectory(PathPure.TrimEnd("\"))
|
||||
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
|
||||
End If
|
||||
Return AssemblyImazenWebp
|
||||
End SyncLock
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
|
||||
'切换窗口
|
||||
|
||||
'控件模板事件
|
||||
Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
|
||||
Select Case Setup.Get("LoginType")
|
||||
Select Case Settings.Get(Of McLoginType)("LoginType")
|
||||
Case McLoginType.Ms
|
||||
'微软
|
||||
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
|
||||
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
|
||||
MsJson.Remove(sender.Tag)
|
||||
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
|
||||
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
|
||||
Case McLoginType.Legacy
|
||||
'离线
|
||||
Dim Names As New List(Of String)
|
||||
Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
|
||||
Names.AddRange(Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨"))
|
||||
Names.Remove(sender.Tag)
|
||||
Setup.Set("LoginLegacyName", Join(Names, "¨"))
|
||||
Settings.Set("LoginLegacyName", Names.Join("¨"c))
|
||||
FrmLoginLegacy.ComboName.ItemsSource = Names
|
||||
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
|
||||
Case Else
|
||||
'第三方
|
||||
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
|
||||
Dim Token As String = Settings.Get(Of McLoginType)("LoginType").ToString()
|
||||
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("¨"))
|
||||
If Not Settings.Get(Of String)("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get(Of String)("Login" & Token & "Email").Split("¨"))
|
||||
If Not Settings.Get(Of String)("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get(Of String)("Login" & Token & "Pass").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, "¨"))
|
||||
Setup.Set("Login" & Token & "Pass", Join(Dict.Values, "¨"))
|
||||
Settings.Set("Login" & Token & "Email", Dict.Keys.Join("¨"c))
|
||||
Settings.Set("Login" & Token & "Pass", Dict.Values.Join("¨"c))
|
||||
Select Case Token
|
||||
Case "Nide"
|
||||
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
|
||||
|
||||
@@ -0,0 +1,199 @@
|
||||
' Author: uye (owner of the MaaAssistantArknights team)
|
||||
' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
|
||||
' License: Apache License 2.0 (this file only)
|
||||
'
|
||||
' This file is originally developed for MaaAssistantArknights and licensed under AGPL v3.0.
|
||||
' As the original author and copyright holder,
|
||||
' I hereby re-license this file under the Apache License 2.0 for use in the Plain Craft Launcher project.
|
||||
'
|
||||
' This file is contributed under the spirit of good faith and open cooperation.
|
||||
' It does not implement any core launcher functions of PCL.
|
||||
'
|
||||
' Description:
|
||||
' Provides a WPF clipboard handling fix to avoid OpenClipboard exceptions
|
||||
' in TextBox, RichTextBox, and DataGrid under Windows focus issues or clipboard hooks.
|
||||
'
|
||||
' Date: 2025-07-03
|
||||
|
||||
Namespace Controls.Behaviors
|
||||
Public NotInheritable Class ClipboardInterceptor
|
||||
Private Sub New()
|
||||
End Sub
|
||||
|
||||
Public Shared ReadOnly EnableSafeClipboardProperty As DependencyProperty =
|
||||
DependencyProperty.RegisterAttached("EnableSafeClipboard", GetType(Boolean), GetType(ClipboardInterceptor),
|
||||
New PropertyMetadata(False, AddressOf OnEnableSafeClipboardChanged))
|
||||
|
||||
Public Shared Sub SetEnableSafeClipboard(element As DependencyObject, value As Boolean)
|
||||
element.SetValue(EnableSafeClipboardProperty, value)
|
||||
End Sub
|
||||
|
||||
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
|
||||
Return element.GetValue(EnableSafeClipboardProperty)
|
||||
End Function
|
||||
|
||||
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
|
||||
If TypeOf d Is TextBox AndAlso CBool(e.NewValue) Then
|
||||
AddCommandBindingsToTextBox(DirectCast(d, TextBox))
|
||||
ElseIf TypeOf d Is RichTextBox AndAlso CBool(e.NewValue) Then
|
||||
AddCommandBindingsToRichTextBox(DirectCast(d, RichTextBox))
|
||||
ElseIf TypeOf d Is DataGrid AndAlso CBool(e.NewValue) Then
|
||||
AddCommandBindingsToDataGrid(DirectCast(d, DataGrid))
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Shared Sub AddCommandBindingsToTextBox(tb As TextBox)
|
||||
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyTextBox))
|
||||
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutTextBox))
|
||||
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteTextBox))
|
||||
End Sub
|
||||
|
||||
Private Shared Sub AddCommandBindingsToRichTextBox(rtb As RichTextBox)
|
||||
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyRichTextBox))
|
||||
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutRichTextBox))
|
||||
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteRichTextBox))
|
||||
End Sub
|
||||
|
||||
Private Shared Sub AddCommandBindingsToDataGrid(dg As DataGrid)
|
||||
dg.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyDataGrid))
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnCopyTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim tb = TryCast(sender, TextBox)
|
||||
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
|
||||
|
||||
Try
|
||||
Forms.Clipboard.Clear()
|
||||
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnCutTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim tb = TryCast(sender, TextBox)
|
||||
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
|
||||
|
||||
Try
|
||||
Forms.Clipboard.Clear()
|
||||
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
tb.SelectedText = String.Empty
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnPasteTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim tb = TryCast(sender, TextBox)
|
||||
If tb Is Nothing Then Return
|
||||
|
||||
Try
|
||||
If Forms.Clipboard.ContainsText() Then
|
||||
Dim pasteText = Forms.Clipboard.GetText()
|
||||
|
||||
'将换行符替换为空格（#7825）
|
||||
If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
|
||||
|
||||
Dim start = tb.SelectionStart
|
||||
|
||||
tb.SelectedText = pasteText
|
||||
tb.CaretIndex = start + pasteText.Length
|
||||
tb.SelectionLength = 0
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnCopyRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim rtb = TryCast(sender, RichTextBox)
|
||||
If rtb Is Nothing Then Return
|
||||
|
||||
Dim textRange = New TextRange(rtb.Selection.Start, rtb.Selection.End)
|
||||
If String.IsNullOrEmpty(textRange.Text) Then Return
|
||||
|
||||
Try
|
||||
Forms.Clipboard.Clear()
|
||||
Forms.Clipboard.SetDataObject(textRange.Text, True)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnCutRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim rtb = TryCast(sender, RichTextBox)
|
||||
If rtb Is Nothing Then Return
|
||||
|
||||
Dim selection = New TextRange(rtb.Selection.Start, rtb.Selection.End)
|
||||
If String.IsNullOrEmpty(selection.Text) Then Return
|
||||
|
||||
Try
|
||||
Forms.Clipboard.Clear()
|
||||
Forms.Clipboard.SetDataObject(selection.Text, True)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
selection.Text = String.Empty
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnPasteRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim rtb = TryCast(sender, RichTextBox)
|
||||
If rtb Is Nothing Then Return
|
||||
|
||||
Try
|
||||
If Not Forms.Clipboard.ContainsText() Then Return
|
||||
|
||||
Dim pasteText = Forms.Clipboard.GetText()
|
||||
Dim selection = rtb.Selection
|
||||
|
||||
selection.Text = pasteText
|
||||
|
||||
Dim caretPos = selection.End
|
||||
rtb.CaretPosition = caretPos
|
||||
rtb.Selection.Select(caretPos, caretPos)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
Private Shared Sub OnCopyDataGrid(sender As Object, e As ExecutedRoutedEventArgs)
|
||||
Dim dg = TryCast(sender, DataGrid)
|
||||
If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return
|
||||
|
||||
Dim sb = New StringBuilder
|
||||
Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item)
|
||||
|
||||
For Each row In rowGroups
|
||||
Dim rowText = String.Join(vbTab, row.Select(
|
||||
Function(cell)
|
||||
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
|
||||
Return If(tb IsNot Nothing, tb.Text, "")
|
||||
End Function))
|
||||
sb.AppendLine(rowText)
|
||||
Next
|
||||
|
||||
Dim sbStr = sb.ToString().TrimEnd(ControlChars.Cr, ControlChars.Lf)
|
||||
|
||||
Try
|
||||
Forms.Clipboard.Clear()
|
||||
Forms.Clipboard.SetDataObject(sbStr, True)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
|
||||
End Try
|
||||
|
||||
e.Handled = True
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -0,0 +1,23 @@
|
||||
Imports System.Windows.Threading
|
||||
|
||||
''' <summary>
|
||||
''' 指示页面可以通过按下 F5 或以其他方式刷新。
|
||||
''' </summary>
|
||||
Public Interface IRefreshable
|
||||
Sub Refresh()
|
||||
End Interface
|
||||
|
||||
''' <summary>
|
||||
''' 指示页面可以处理未捕获的异常。
|
||||
''' </summary>
|
||||
Public Interface IDispatcherUnhandledException
|
||||
Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
|
||||
End Interface
|
||||
|
||||
''' <summary>
|
||||
''' 指示该控件是可勾选的。
|
||||
''' </summary>
|
||||
Public Interface IMyRadio
|
||||
Event Check(sender As Object, e As RouteEventArgs)
|
||||
Event Changed(sender As Object, e As RouteEventArgs)
|
||||
End Interface
|
||||
@@ -0,0 +1,46 @@
|
||||
Public Class LazyLoadBehavior
|
||||
|
||||
''' <summary>
|
||||
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
|
||||
''' </summary>
|
||||
Public Shared Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
|
||||
obj.SetValue(IsInViewportProperty, value)
|
||||
End Sub
|
||||
|
||||
Private Shared ReadOnly IsInViewportProperty As DependencyProperty =
|
||||
DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
|
||||
New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
|
||||
|
||||
Private Shared Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
|
||||
Dim Element = TryCast(d, FrameworkElement)
|
||||
If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
|
||||
|
||||
Dim Handled As Boolean = False
|
||||
Dim Handler As EventHandler =
|
||||
Sub()
|
||||
If Handled Then Return
|
||||
'判断元素是否可见
|
||||
If Element.RenderSize.Width < Double.Epsilon Then Return
|
||||
If Not Element.IsVisible Then Return
|
||||
'判断是否在 ScrollViewer 的可视区域内
|
||||
Dim Scroll = FindParentScrollViewer(Element)
|
||||
If Scroll Is Nothing Then Return
|
||||
If Not New Rect(0, 0, Scroll.ViewportWidth, Scroll.ViewportHeight).IntersectsWith(
|
||||
Element.TransformToAncestor(Scroll).TransformBounds(New Rect(New Point(0, 0), Element.RenderSize))) Then Return
|
||||
'执行
|
||||
Handled = True
|
||||
CType(e.NewValue, Action).Invoke()
|
||||
RemoveHandler Element.LayoutUpdated, Handler
|
||||
End Sub
|
||||
AddHandler Element.LayoutUpdated, Handler
|
||||
End Sub
|
||||
|
||||
Private Shared Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
|
||||
While d IsNot Nothing
|
||||
If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
|
||||
d = VisualTreeHelper.GetParent(d)
|
||||
End While
|
||||
Return Nothing
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -1,4 +0,0 @@
|
||||
Public Interface IMyRadio
|
||||
Event Check(sender As Object, e As RouteEventArgs)
|
||||
Event Changed(sender As Object, e As RouteEventArgs)
|
||||
End Interface
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Class="MyButton"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyButton
|
||||
@@ -136,43 +136,18 @@ Public Class MyButton
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新按钮颜色出错")
|
||||
Logger.Warn(ex, "刷新按钮颜色出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'实现自定义事件
|
||||
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Exit Sub
|
||||
Log("[Control] 按下按钮：" & Text)
|
||||
RaiseEvent Click(sender, e)
|
||||
If Not String.IsNullOrEmpty(Tag) Then
|
||||
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
|
||||
Hint("主页自定义按钮语法已更新，且不再兼容老版本语法，请查看新的自定义示例！")
|
||||
End If
|
||||
End If
|
||||
ModEvent.TryStartEvent(EventType, EventData)
|
||||
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(MyButton), 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(MyButton), New PropertyMetadata(Nothing))
|
||||
|
||||
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
|
||||
Private IsMouseDown As Boolean = False
|
||||
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Return
|
||||
Logger.Info($"按下按钮：{Text}")
|
||||
RaiseEvent Click(sender, e)
|
||||
RaiseCustomEvent() '自定义事件
|
||||
End Sub
|
||||
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
|
||||
IsMouseDown = True
|
||||
Focus()
|
||||
@@ -185,7 +160,7 @@ Public Class MyButton
|
||||
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush7"), AnimationColorIn), "MyButton Background " & Uuid)
|
||||
End Sub
|
||||
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Exit Sub
|
||||
If Not IsMouseDown Then Return
|
||||
IsMouseDown = False
|
||||
AniStart({
|
||||
AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle))
|
||||
@@ -193,7 +168,7 @@ Public Class MyButton
|
||||
End Sub
|
||||
Private Sub Button_MouseLeave() Handles Me.MouseLeave
|
||||
AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid)
|
||||
If Not IsMouseDown Then Exit Sub
|
||||
If Not IsMouseDown Then Return
|
||||
IsMouseDown = False
|
||||
AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid)
|
||||
End Sub
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
Public Class MyCard
|
||||
Public Class MyCard
|
||||
|
||||
'控件
|
||||
Inherits Grid
|
||||
Private ReadOnly MainGrid As Grid
|
||||
Public ReadOnly Property MainChrome As SystemDropShadowChrome
|
||||
Public ReadOnly Property MainChrome As MyDropShadow
|
||||
Private ReadOnly MainBorder As Border
|
||||
Public Property BorderChild As UIElement
|
||||
Get
|
||||
@@ -63,17 +63,18 @@
|
||||
|
||||
'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")
|
||||
MainChrome = New MyDropShadow With {
|
||||
.Margin = New Thickness(-3, -3, -3, -3 - GetWPFSize(1)), .ShadowRadius = 3, .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius(5)}
|
||||
MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1")
|
||||
Children.Insert(0, MainChrome)
|
||||
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
|
||||
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(245, 255, 255, 255)), .CornerRadius = New CornerRadius(5), .IsHitTestVisible = False}
|
||||
Children.Insert(1, MainBorder)
|
||||
MainGrid = New Grid
|
||||
Children.Add(MainGrid)
|
||||
End Sub
|
||||
Private IsLoad As Boolean = False
|
||||
Private Sub Init() Handles Me.Loaded
|
||||
If IsLoad Then Exit Sub
|
||||
If IsLoad Then Return
|
||||
IsLoad = True
|
||||
'初次加载限定
|
||||
If MainTextBlock Is Nothing Then
|
||||
@@ -89,8 +90,9 @@
|
||||
MainGrid.Children.Add(MainSwap)
|
||||
End If
|
||||
'改变默认的折叠
|
||||
If IsSwaped AndAlso SwapControl IsNot Nothing Then
|
||||
If IsSwapped AndAlso SwapControl IsNot Nothing Then
|
||||
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
|
||||
SwapControl.Visibility = Visibility.Collapsed
|
||||
'取消由于高度变化被迫触发的高度动画
|
||||
Dim RawUseAnimation As Boolean = UseAnimation
|
||||
UseAnimation = False
|
||||
@@ -108,68 +110,51 @@
|
||||
'这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎
|
||||
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
|
||||
'别骂了别骂了.jpg
|
||||
If IsNothing(Stack.Tag) Then Exit Sub
|
||||
If Stack.Tag Is Nothing Then Return
|
||||
'排序
|
||||
Dim HasDuplicates As Boolean = False
|
||||
Select Case Type
|
||||
Case 3
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.DisplayName, b.DisplayName))
|
||||
Case 4, 10
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.Inherit, b.Inherit))
|
||||
Case 6
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version)
|
||||
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
|
||||
Case 8, 9
|
||||
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
|
||||
Stack.Tag = CType(Stack.Tag, List(Of ResourceVersion)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
|
||||
HasDuplicates =
|
||||
CType(Stack.Tag, List(Of ResourceVersion)).DistinctBy(Function(a) a.Display).Count <>
|
||||
CType(Stack.Tag, List(Of ResourceVersion)).Count
|
||||
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
|
||||
CompFilesCardPreload(Stack, Stack.Tag)
|
||||
PageDownloadResourceDetail.ResourceFilesCardPreload(Stack, Stack.Tag)
|
||||
End Select
|
||||
'实现控件虚拟化
|
||||
For Each Data As Object In Stack.Tag
|
||||
Select Case Type
|
||||
Case 0
|
||||
Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
|
||||
Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
|
||||
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
|
||||
'不能使用 AddressOf，这导致了 #535，原因完全不明，疑似是编译器 Bug
|
||||
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
|
||||
Case 8
|
||||
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
|
||||
CType(Stack.Tag, List(Of CompFile)).Count Then
|
||||
'存在重复的名称（#1344）
|
||||
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
|
||||
Else
|
||||
'不存在重复的名称，正常加载
|
||||
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
|
||||
End If
|
||||
'若存在重复的版本名，则显示文件名而非版本名（#1344）
|
||||
Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
|
||||
AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
|
||||
Case 9
|
||||
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
|
||||
CType(Stack.Tag, List(Of CompFile)).Count Then
|
||||
'存在重复的名称（#1344）
|
||||
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
|
||||
Else
|
||||
'不存在重复的名称，正常加载
|
||||
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
|
||||
End If
|
||||
'若存在重复的版本名，则显示文件名而非版本名（#1344）
|
||||
Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
|
||||
AddressOf FrmDownloadResourceDetail.Install_Click, AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
|
||||
Case 10
|
||||
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
|
||||
Case 11
|
||||
@@ -179,36 +164,36 @@
|
||||
Case 13
|
||||
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
|
||||
Case Else
|
||||
Log("未知的虚拟化种类：" & Type, LogLevel.Feedback)
|
||||
Logger.Error($"未知的虚拟化种类：{Type}")
|
||||
End Select
|
||||
Next
|
||||
Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠
|
||||
Stack.Tag = Nothing
|
||||
End Sub
|
||||
|
||||
'事件
|
||||
'动画
|
||||
Private Const DropShadowIdleOpacity As Double = 0.07
|
||||
Private Const DropShadowHoverOpacity As Double = 0.4
|
||||
Public Property HasMouseAnimation As Boolean = True
|
||||
Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
|
||||
If Not HasMouseAnimation Then Exit Sub
|
||||
If Not HasMouseAnimation Then Return
|
||||
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))
|
||||
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 90))
|
||||
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 90))
|
||||
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)
|
||||
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4", 90),
|
||||
AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90)
|
||||
})
|
||||
AniStart(AniList, "MyCard Mouse " & Uuid)
|
||||
End Sub
|
||||
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
|
||||
If Not HasMouseAnimation Then Exit Sub
|
||||
If Not HasMouseAnimation Then Return
|
||||
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))
|
||||
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 90))
|
||||
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 90))
|
||||
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)
|
||||
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1", 90),
|
||||
AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90)
|
||||
})
|
||||
AniStart(AniList, "MyCard Mouse " & Uuid)
|
||||
End Sub
|
||||
@@ -222,46 +207,64 @@
|
||||
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 Not UseAnimation Then Return
|
||||
Dim DeltaHeight As Double = If(IsSwapped, 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
|
||||
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
|
||||
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 设计器出错
|
||||
Private Sub StartHeightAnimation(Delta As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
|
||||
If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
|
||||
|
||||
Dim AnimList As New List(Of AniData)
|
||||
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片，高度减小时的弹跳会吞掉按钮下边框
|
||||
'高度增加较大，使用弹起动画
|
||||
Dim Delta As Double = MathClamp(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))
|
||||
})
|
||||
Dim AbsDelta = Math.Abs(Delta)
|
||||
|
||||
If AbsDelta <= 800 Then
|
||||
'短距离，直接使用 150ms 的缓动动画
|
||||
AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
|
||||
Else
|
||||
'普通的改变就行啦
|
||||
AnimList.AddRange({
|
||||
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
|
||||
})
|
||||
Dim EaseLength As Integer, EaseTime As Integer
|
||||
Dim InitSpeed As Integer '到达缓动区前的初速度
|
||||
If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0.1 Then
|
||||
'收回距离过长 (>0.1s)，强制以 100ms 完成匀速段，然后让减速段更长
|
||||
EaseLength = 200
|
||||
EaseTime = 150
|
||||
InitSpeed = (AbsDelta - EaseLength) / 0.1
|
||||
ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0.6 Then
|
||||
'展开距离过长 (>0.6s)，以 5000 速度展示 300ms 匀速段，剩下的距离全部归入减速段
|
||||
InitSpeed = 5000
|
||||
EaseLength = AbsDelta - InitSpeed * 0.3
|
||||
EaseTime = 400
|
||||
Else
|
||||
'中程，匀速地快速展开（或收回）
|
||||
EaseLength = 150
|
||||
EaseTime = 200
|
||||
InitSpeed = 4000
|
||||
End If
|
||||
'匀速段
|
||||
AnimList.Add(AaHeight(Me, (AbsDelta - EaseLength) * Math.Sign(Delta),
|
||||
(AbsDelta - EaseLength) / InitSpeed * 1000))
|
||||
'减速段
|
||||
AnimList.Add(AaHeight(Me, EaseLength * Math.Sign(Delta),
|
||||
EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000, EaseLength), True))
|
||||
End If
|
||||
|
||||
AnimList.Add(AaCode(
|
||||
Sub()
|
||||
IsHeightAnimating = False
|
||||
Height = ActualUsedHeight
|
||||
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
|
||||
If IsSwapped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
|
||||
End Sub,, True))
|
||||
AniStart(AnimList, "MyCard Height " & Uuid)
|
||||
|
||||
IsHeightAnimating = True
|
||||
ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
|
||||
ActualUsedHeight = If(IsSwapped, SwapedHeight, Height)
|
||||
Height = PreviousHeight
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 通知 MyCard，控件内容已改变，需要中断动画并更新高度。
|
||||
''' 通知 MyCard，控件内容已改变，需要中断动画并瞬间更新高度。
|
||||
''' </summary>
|
||||
Public Sub TriggerForceResize()
|
||||
Height = If(IsSwaped, SwapedHeight, Double.NaN)
|
||||
Height = If(IsSwapped, SwapedHeight, Double.NaN)
|
||||
AniStop("MyCard Height " & Uuid)
|
||||
IsHeightAnimating = False
|
||||
End Sub
|
||||
@@ -272,7 +275,7 @@
|
||||
|
||||
'若设置了 CanSwap，或 SwapControl 不为空，则判定为会进行折叠
|
||||
'这是因为不能直接在 XAML 中设置 SwapControl
|
||||
Public SwapControl As Object
|
||||
Public SwapControl As FrameworkElement
|
||||
Public Property CanSwap As Boolean = False
|
||||
''' <summary>
|
||||
''' 被折叠的种类，用于控件虚拟化。
|
||||
@@ -281,59 +284,85 @@
|
||||
''' <summary>
|
||||
''' 是否已被折叠。
|
||||
''' </summary>
|
||||
Public Property IsSwaped As Boolean
|
||||
Public Property IsSwapped As Boolean
|
||||
Get
|
||||
Return _IsSwaped
|
||||
Return _IsSwapped
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
If _IsSwaped = value Then Exit Property
|
||||
_IsSwaped = value
|
||||
If SwapControl Is Nothing Then Exit Property
|
||||
If _IsSwapped = value Then Return
|
||||
_IsSwapped = value
|
||||
If SwapControl Is Nothing Then Return
|
||||
'展开
|
||||
If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
|
||||
If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
|
||||
'若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
|
||||
If Not IsLoaded Then Exit Property
|
||||
'更新高度
|
||||
If Not IsLoaded Then Return
|
||||
'更新样式
|
||||
SwapControl.Visibility = Visibility.Visible
|
||||
TriggerForceResize()
|
||||
UpdateCursorStyle()
|
||||
'改变箭头
|
||||
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "MyCard Swap " & Uuid, True)
|
||||
AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
|
||||
End Set
|
||||
End Property
|
||||
Private _IsSwaped As Boolean = False
|
||||
Private _IsSwapped As Boolean = False
|
||||
<Obsolete("IsSwaped 存在拼写错误，请换用 IsSwapped 属性。")>
|
||||
Public Property IsSwaped As Boolean
|
||||
Get
|
||||
Return GetValue(IsSwapedProperty)
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
SetValue(IsSwapedProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
|
||||
Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
|
||||
|
||||
Public Property SwapLogoRight As Boolean = False
|
||||
Private IsMouseDown As Boolean = False
|
||||
Private IsSwapMouseDown As Boolean = False '用于触发卡片展开/折叠的 MouseDown
|
||||
Private IsCustomMouseDown As Boolean = False '用于触发自定义事件的 MouseDown
|
||||
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
|
||||
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
|
||||
IsMouseDown = True
|
||||
If Not IsSwapped AndAlso
|
||||
(Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return
|
||||
IsCustomMouseDown = True
|
||||
If Not IsSwapped AndAlso
|
||||
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置；或已经不在可视树上的误判
|
||||
IsSwapMouseDown = True
|
||||
End Sub
|
||||
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Return
|
||||
IsMouseDown = False
|
||||
Private Sub MyCard_MouseLeftButtonUp() Handles Me.MouseLeftButtonUp
|
||||
If Not IsCustomMouseDown Then Return
|
||||
IsCustomMouseDown = False
|
||||
RaiseCustomEvent() '触发自定义事件
|
||||
|
||||
If Not IsSwapMouseDown Then Return
|
||||
IsSwapMouseDown = False
|
||||
|
||||
Dim Pos As Double = Mouse.GetPosition(Me).Y
|
||||
If Not IsSwaped AndAlso
|
||||
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
|
||||
If Not IsSwapped AndAlso
|
||||
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置；或已经不在可视树上的误判
|
||||
|
||||
Dim ee = New RouteEventArgs(True)
|
||||
RaiseEvent PreviewSwap(Me, ee)
|
||||
If ee.Handled Then
|
||||
IsMouseDown = False
|
||||
Dim e = New RouteEventArgs(True)
|
||||
RaiseEvent PreviewSwap(Me, e)
|
||||
If e.Handled Then
|
||||
IsSwapMouseDown = False
|
||||
Return
|
||||
End If
|
||||
|
||||
IsSwaped = Not IsSwaped
|
||||
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title))
|
||||
RaiseEvent Swap(Me, ee)
|
||||
IsSwapped = Not IsSwapped
|
||||
Logger.Info($"{If(IsSwapped, "折叠卡片", "展开卡片")}{If(Title Is Nothing, "", "：" & Title)}")
|
||||
RaiseEvent Swap(Me, e)
|
||||
End Sub
|
||||
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
|
||||
IsMouseDown = False
|
||||
IsSwapMouseDown = False
|
||||
End Sub
|
||||
Private Sub UpdateCursorStyle() Handles Me.MouseMove
|
||||
If _MainSwap Is Nothing Then Cursor = Nothing : Return
|
||||
Dim Pos As Double = Mouse.GetPosition(Me).Y
|
||||
Cursor = If(MainSwap.Visibility = Visibility.Visible AndAlso (IsSwapped OrElse (Pos <= SwapedHeight - 6 AndAlso Not (Pos = 0 AndAlso Not IsMouseDirectlyOver))),
|
||||
Cursors.Hand, Nothing)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -350,7 +379,7 @@ Partial Public Module ModAnimation
|
||||
AaCode(
|
||||
Sub()
|
||||
If RemoveFromChildren Then
|
||||
If Control.Parent Is Nothing Then Exit Sub
|
||||
If Control.Parent Is Nothing Then Return
|
||||
CType(Control.Parent, Object).Children.Remove(Control)
|
||||
Else
|
||||
Control.Visibility = Visibility.Collapsed
|
||||
@@ -360,7 +389,7 @@ Partial Public Module ModAnimation
|
||||
}, "MyCard Dispose " & Control.Uuid)
|
||||
Else
|
||||
If RemoveFromChildren Then
|
||||
If Control.Parent Is Nothing Then Exit Sub
|
||||
If Control.Parent Is Nothing Then Return
|
||||
CType(Control.Parent, Object).Children.Remove(Control)
|
||||
Else
|
||||
Control.Visibility = Visibility.Collapsed
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid
|
||||
<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"
|
||||
|
||||
@@ -1,7 +1,8 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyCheckBox
|
||||
Implements ISettingControl
|
||||
|
||||
'基础
|
||||
|
||||
@@ -12,9 +13,6 @@ Public Class MyCheckBox
|
||||
''' <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 事件
|
||||
|
||||
'自定义属性
|
||||
Public Property Checked As Boolean
|
||||
@@ -40,7 +38,7 @@ Public Class MyCheckBox
|
||||
''' <param name="user">是否由用户引发。</param>
|
||||
Public Sub SetChecked(value As Boolean, user As Boolean)
|
||||
Try
|
||||
If value = Checked Then Exit Sub
|
||||
If value = Checked Then Return
|
||||
|
||||
'Preview 事件
|
||||
If value AndAlso user Then
|
||||
@@ -50,7 +48,7 @@ Public Class MyCheckBox
|
||||
MouseDowned = True
|
||||
Checkbox_MouseLeave()
|
||||
MouseDowned = False
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -59,8 +57,9 @@ Public Class MyCheckBox
|
||||
|
||||
'更改动画
|
||||
SyncUI()
|
||||
RaiseCustomEvent()
|
||||
Catch ex As Exception
|
||||
Log(ex, "设置 Checked 失败")
|
||||
Logger.Warn(ex, "设置 Checked 失败")
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub SyncUI()
|
||||
@@ -74,7 +73,7 @@ Public Class MyCheckBox
|
||||
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)
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray5"), AnimationTimeOfCheck)
|
||||
}, "MyCheckBox BorderColor " & Uuid)
|
||||
AniStart({
|
||||
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
|
||||
@@ -87,7 +86,7 @@ Public Class MyCheckBox
|
||||
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)
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfCheck)
|
||||
}, "MyCheckBox BorderColor " & Uuid)
|
||||
AniStart({
|
||||
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
|
||||
@@ -101,11 +100,11 @@ Public Class MyCheckBox
|
||||
If Checked Then
|
||||
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
|
||||
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
|
||||
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
|
||||
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
|
||||
Else
|
||||
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
|
||||
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
|
||||
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
|
||||
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
@@ -133,14 +132,14 @@ Public Class MyCheckBox
|
||||
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)
|
||||
If Not MouseDowned Then Return
|
||||
Logger.Info($"按下复选框（{(Not Checked)}）：{Text}")
|
||||
MouseDowned = False
|
||||
SetChecked(Not Checked, 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
|
||||
If Not AllowMouseDown Then Return
|
||||
MouseDowned = True
|
||||
Focus()
|
||||
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
|
||||
@@ -154,7 +153,7 @@ Public Class MyCheckBox
|
||||
End If
|
||||
End Sub
|
||||
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
|
||||
If Not MouseDowned Then Exit Sub
|
||||
If Not MouseDowned Then Return
|
||||
MouseDowned = False
|
||||
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
|
||||
If Checked Then
|
||||
@@ -180,18 +179,18 @@ Public Class MyCheckBox
|
||||
Else
|
||||
'不可用
|
||||
AniStart({
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray5 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
|
||||
}, "MyCheckBox BorderColor " & Uuid)
|
||||
AniStart({
|
||||
AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut)
|
||||
AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - 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"))
|
||||
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
|
||||
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
|
||||
End If
|
||||
End Sub
|
||||
Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter
|
||||
@@ -203,13 +202,29 @@ Public Class MyCheckBox
|
||||
}, "MyCheckBox BorderColor " & Uuid)
|
||||
End Sub
|
||||
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
|
||||
If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行，所以如果自定义事件修改了 IsEnabled，将导致显示错误
|
||||
If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行，所以如果自定义事件修改了 IsEnabled，将导致显示错误
|
||||
AniStart({
|
||||
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut)
|
||||
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut)
|
||||
}, "MyCheckBox TextColor " & Uuid)
|
||||
AniStart({
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut)
|
||||
AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut)
|
||||
}, "MyCheckBox BorderColor " & Uuid)
|
||||
End Sub
|
||||
|
||||
#Region "设置"
|
||||
|
||||
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
|
||||
Checked = Boolean.Parse(NewValue)
|
||||
End Sub
|
||||
|
||||
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
|
||||
Return Checked.ToString
|
||||
End Function
|
||||
|
||||
Private Sub SaveSetting() Handles Me.Change
|
||||
SettingService.SaveSetting(Me)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
Public Class MyComboBox
|
||||
Public Class MyComboBox
|
||||
Inherits ComboBox
|
||||
Implements ISettingControl
|
||||
Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
|
||||
|
||||
'基础
|
||||
@@ -8,7 +9,7 @@
|
||||
Public Property HintText As String = ""
|
||||
Public Overrides Sub OnApplyTemplate()
|
||||
MyBase.OnApplyTemplate()
|
||||
If Not IsEditable Then Exit Sub
|
||||
If Not IsEditable Then Return
|
||||
Try
|
||||
TextBox = Template.FindName("PART_EditableTextBox", Me)
|
||||
TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor))
|
||||
@@ -21,7 +22,7 @@
|
||||
End If
|
||||
If HintText.Length > 0 Then TextBox.HintText = HintText
|
||||
Catch ex As Exception
|
||||
Log(ex, "初始化可编辑文本框失败（" & If(Name, "") & "）", LogLevel.Feedback)
|
||||
Logger.Error(ex, $"初始化可编辑文本框失败（{If(Name, "")}）")
|
||||
End Try
|
||||
End Sub
|
||||
Private _Text As String = SelectedItem
|
||||
@@ -103,10 +104,11 @@
|
||||
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)
|
||||
Logger.Error(ex, "设置下拉框透明度失败")
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
|
||||
@@ -116,16 +118,15 @@
|
||||
'修复 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
|
||||
If IsTextChanging OrElse Not IsEditable Then Return
|
||||
If SelectedItem Is Nothing OrElse Text = SelectedItem.ToString Then Return
|
||||
Dim RawText As String = Text
|
||||
Dim RawSelectionStart As Integer = TextBox.SelectionStart
|
||||
IsTextChanging = True
|
||||
SelectedItem = Nothing
|
||||
Text = RawText
|
||||
TextBox.SelectionStart = RawSelectionStart
|
||||
IsTextChanging = False
|
||||
End Sub
|
||||
|
||||
Public ReadOnly Property ContentPresenter As ContentPresenter
|
||||
@@ -134,4 +135,39 @@
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Private Sub MyComboBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles Me.SelectionChanged
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent()
|
||||
End Sub
|
||||
|
||||
#Region "设置"
|
||||
|
||||
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
|
||||
Dim TargetItem = Items.OfType(Of DependencyObject)().FirstOrDefault(Function(i) Val(If(SettingService.GetValue(i), -1)) = NewValue)
|
||||
If TargetItem IsNot Nothing Then
|
||||
SelectedItem = TargetItem
|
||||
ElseIf Items.Count > NewValue Then
|
||||
SelectedIndex = NewValue
|
||||
Else
|
||||
Logger.Warn($"尝试显示设置 {SettingService.GetKey(Me)}，但没有找到设置值 {NewValue} 的对应项")
|
||||
SelectedIndex = -1
|
||||
SelectedItem = Nothing
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
|
||||
If SelectedItem Is Nothing Then Return Nothing
|
||||
If TypeOf SelectedItem Is DependencyObject Then
|
||||
Return If(SettingService.GetValue(SelectedItem), SelectedIndex)
|
||||
Else
|
||||
Return SelectedIndex
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Sub SaveSetting() Handles Me.SelectionChanged
|
||||
If SelectedItem Is Nothing Then Return
|
||||
SettingService.SaveSetting(Me)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyComboBoxItem
|
||||
Public Class MyComboBoxItem
|
||||
Inherits ComboBoxItem
|
||||
|
||||
'基础
|
||||
@@ -35,7 +35,7 @@
|
||||
NewFontOpacity = 0.4
|
||||
Time = AnimationTimeOut
|
||||
End If
|
||||
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub
|
||||
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Return
|
||||
BackColorName = NewBackColorName
|
||||
FontOpacity = NewFontOpacity
|
||||
'触发颜色动画
|
||||
@@ -61,7 +61,7 @@
|
||||
End Operator
|
||||
|
||||
Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
Log("[Control] 选择下拉列表项：" & Tostring())
|
||||
Logger.Info($"选择下拉列表项：{Tostring()}")
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
+66
-41
@@ -1,65 +1,89 @@
|
||||
Public NotInheritable Class SystemDropShadowChrome
|
||||
Public Class MyDropShadow
|
||||
Inherits Decorator
|
||||
|
||||
'源码来源于：https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
|
||||
|
||||
Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
|
||||
''' <summary>
|
||||
''' 阴影颜色。
|
||||
''' </summary>
|
||||
Public Property Color As Color
|
||||
Get
|
||||
Return CType(GetValue(ColorProperty), Color)
|
||||
Return GetValue(ColorProperty)
|
||||
End Get
|
||||
Set(value As Color)
|
||||
SetValue(ColorProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(MyDropShadow),
|
||||
New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
|
||||
|
||||
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
|
||||
''' <summary>
|
||||
''' 阴影模糊半径。
|
||||
''' </summary>
|
||||
Public Property ShadowRadius As Double
|
||||
Get
|
||||
Return GetValue(ShadowRadiusProperty)
|
||||
End Get
|
||||
Set(value As Double)
|
||||
SetValue(ShadowRadiusProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly ShadowRadiusProperty As DependencyProperty = DependencyProperty.Register("ShadowRadius", GetType(Double), GetType(MyDropShadow),
|
||||
New FrameworkPropertyMetadata(CDbl(5), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
|
||||
|
||||
''' <summary>
|
||||
''' 圆角大小。
|
||||
''' </summary>
|
||||
Public Property CornerRadius As CornerRadius
|
||||
Get
|
||||
Return CType(GetValue(CornerRadiusProperty), CornerRadius)
|
||||
Return GetValue(CornerRadiusProperty)
|
||||
End Get
|
||||
Set(value As CornerRadius)
|
||||
SetValue(CornerRadiusProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Private Shared Function IsCornerRadiusValid(value As Object) As Boolean
|
||||
Dim cr As CornerRadius = CType(value, CornerRadius)
|
||||
Dim cr As CornerRadius = value
|
||||
Return Not (cr.TopLeft < 0.0 OrElse cr.TopRight < 0.0 OrElse cr.BottomLeft < 0.0 OrElse cr.BottomRight < 0.0 OrElse Double.IsNaN(cr.TopLeft) OrElse Double.IsNaN(cr.TopRight) OrElse Double.IsNaN(cr.BottomLeft) OrElse Double.IsNaN(cr.BottomRight) OrElse Double.IsInfinity(cr.TopLeft) OrElse Double.IsInfinity(cr.TopRight) OrElse Double.IsInfinity(cr.BottomLeft) OrElse Double.IsInfinity(cr.BottomRight))
|
||||
End Function
|
||||
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyDropShadow),
|
||||
New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
|
||||
|
||||
|
||||
' =======================================
|
||||
' 渲染
|
||||
' =======================================
|
||||
|
||||
Private Const ShadowDepth As Double = 5
|
||||
|
||||
Protected Overrides Sub OnRender(drawingContext As DrawingContext)
|
||||
Dim cornerRadius As CornerRadius = Me.CornerRadius
|
||||
Dim shadowBounds As New Rect(New Point(ShadowDepth, ShadowDepth), New Size(RenderSize.Width, RenderSize.Height))
|
||||
Dim shadowBounds As New Rect(0, 0, RenderSize.Width, RenderSize.Height)
|
||||
Dim color As Color = Me.Color
|
||||
|
||||
If shadowBounds.Width > 0 AndAlso shadowBounds.Height > 0 AndAlso color.A > 0 Then
|
||||
Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowDepth
|
||||
Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowDepth
|
||||
Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowRadius
|
||||
Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowRadius
|
||||
Dim maxRadius As Double = Math.Min(centerWidth * 0.5, centerHeight * 0.5)
|
||||
cornerRadius.TopLeft = Math.Min(cornerRadius.TopLeft, maxRadius)
|
||||
cornerRadius.TopRight = Math.Min(cornerRadius.TopRight, maxRadius)
|
||||
cornerRadius.BottomLeft = Math.Min(cornerRadius.BottomLeft, maxRadius)
|
||||
cornerRadius.BottomRight = Math.Min(cornerRadius.BottomRight, maxRadius)
|
||||
Dim brushes As Brush() = GetBrushes(color, cornerRadius)
|
||||
Dim centerTop As Double = shadowBounds.Top + ShadowDepth
|
||||
Dim centerLeft As Double = shadowBounds.Left + ShadowDepth
|
||||
Dim centerRight As Double = shadowBounds.Right - ShadowDepth
|
||||
Dim centerBottom As Double = shadowBounds.Bottom - ShadowDepth
|
||||
Dim centerTop As Double = shadowBounds.Top + ShadowRadius
|
||||
Dim centerLeft As Double = shadowBounds.Left + ShadowRadius
|
||||
Dim centerRight As Double = shadowBounds.Right - ShadowRadius
|
||||
Dim centerBottom As Double = shadowBounds.Bottom - ShadowRadius
|
||||
Dim guidelineSetX As Double() = New Double() {centerLeft, centerLeft + cornerRadius.TopLeft, centerRight - cornerRadius.TopRight, centerLeft + cornerRadius.BottomLeft, centerRight - cornerRadius.BottomRight, centerRight}
|
||||
Dim guidelineSetY As Double() = New Double() {centerTop, centerTop + cornerRadius.TopLeft, centerTop + cornerRadius.TopRight, centerBottom - cornerRadius.BottomLeft, centerBottom - cornerRadius.BottomRight, centerBottom}
|
||||
drawingContext.PushGuidelineSet(New GuidelineSet(guidelineSetX, guidelineSetY))
|
||||
cornerRadius.TopLeft += ShadowDepth
|
||||
cornerRadius.TopRight += ShadowDepth
|
||||
cornerRadius.BottomLeft += ShadowDepth
|
||||
cornerRadius.BottomRight += ShadowDepth
|
||||
cornerRadius.TopLeft += ShadowRadius
|
||||
cornerRadius.TopRight += ShadowRadius
|
||||
cornerRadius.BottomLeft += ShadowRadius
|
||||
cornerRadius.BottomRight += ShadowRadius
|
||||
Dim topLeft As New Rect(shadowBounds.Left, shadowBounds.Top, cornerRadius.TopLeft, cornerRadius.TopLeft)
|
||||
drawingContext.DrawRectangle(brushes(Placement.TopLeft), Nothing, topLeft)
|
||||
Dim topWidth As Double = guidelineSetX(2) - guidelineSetX(1)
|
||||
|
||||
If topWidth > 0 Then
|
||||
Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowDepth)
|
||||
Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowRadius)
|
||||
drawingContext.DrawRectangle(brushes(Placement.Top), Nothing, top)
|
||||
End If
|
||||
|
||||
@@ -68,14 +92,14 @@
|
||||
Dim leftHeight As Double = guidelineSetY(3) - guidelineSetY(1)
|
||||
|
||||
If leftHeight > 0 Then
|
||||
Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowDepth, leftHeight)
|
||||
Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowRadius, leftHeight)
|
||||
drawingContext.DrawRectangle(brushes(Placement.Left), Nothing, left)
|
||||
End If
|
||||
|
||||
Dim rightHeight As Double = guidelineSetY(4) - guidelineSetY(2)
|
||||
|
||||
If rightHeight > 0 Then
|
||||
Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowDepth, rightHeight)
|
||||
Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowRadius, rightHeight)
|
||||
drawingContext.DrawRectangle(brushes(Placement.Right), Nothing, right)
|
||||
End If
|
||||
|
||||
@@ -84,20 +108,20 @@
|
||||
Dim bottomWidth As Double = guidelineSetX(4) - guidelineSetX(3)
|
||||
|
||||
If bottomWidth > 0 Then
|
||||
Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowDepth)
|
||||
Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowRadius)
|
||||
drawingContext.DrawRectangle(brushes(Placement.Bottom), Nothing, bottom)
|
||||
End If
|
||||
|
||||
Dim bottomRight As New Rect(guidelineSetX(4), guidelineSetY(4), cornerRadius.BottomRight, cornerRadius.BottomRight)
|
||||
drawingContext.DrawRectangle(brushes(Placement.BottomRight), Nothing, bottomRight)
|
||||
|
||||
If cornerRadius.TopLeft = ShadowDepth AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
|
||||
If cornerRadius.TopLeft = ShadowRadius AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
|
||||
Dim center As New Rect(guidelineSetX(0), guidelineSetY(0), centerWidth, centerHeight)
|
||||
drawingContext.DrawRectangle(brushes(Placement.Center), Nothing, center)
|
||||
Else
|
||||
Dim figure As New PathFigure()
|
||||
|
||||
If cornerRadius.TopLeft > ShadowDepth Then
|
||||
If cornerRadius.TopLeft > ShadowRadius Then
|
||||
figure.StartPoint = New Point(guidelineSetX(1), guidelineSetY(0))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(1), guidelineSetY(1)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(1)), True))
|
||||
@@ -105,7 +129,7 @@
|
||||
figure.StartPoint = New Point(guidelineSetX(0), guidelineSetY(0))
|
||||
End If
|
||||
|
||||
If cornerRadius.BottomLeft > ShadowDepth Then
|
||||
If cornerRadius.BottomLeft > ShadowRadius Then
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(3)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(3)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(5)), True))
|
||||
@@ -113,7 +137,7 @@
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(5)), True))
|
||||
End If
|
||||
|
||||
If cornerRadius.BottomRight > ShadowDepth Then
|
||||
If cornerRadius.BottomRight > ShadowRadius Then
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(5)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(4)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(4)), True))
|
||||
@@ -121,7 +145,7 @@
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(5)), True))
|
||||
End If
|
||||
|
||||
If cornerRadius.TopRight > ShadowDepth Then
|
||||
If cornerRadius.TopRight > ShadowRadius Then
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(2)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(2)), True))
|
||||
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(0)), True))
|
||||
@@ -158,28 +182,27 @@
|
||||
Private _brushes As Brush()
|
||||
|
||||
Private Shared Sub ClearBrushes(o As DependencyObject, e As DependencyPropertyChangedEventArgs)
|
||||
CType(o, SystemDropShadowChrome)._brushes = Nothing
|
||||
CType(o, MyDropShadow)._brushes = Nothing
|
||||
End Sub
|
||||
Private Shared Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
|
||||
Dim gradientScale As Double = 1 / (cornerRadius + ShadowDepth)
|
||||
Dim gsc As New GradientStopCollection From {
|
||||
New GradientStop(c, (0.5 + cornerRadius) * gradientScale)
|
||||
}
|
||||
Private Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
|
||||
Dim gradientScale As Double = 1 / (ShadowRadius + cornerRadius)
|
||||
Dim gsc As New GradientStopCollection
|
||||
Dim stopColor As Color = c
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.1 + cornerRadius) * gradientScale))
|
||||
stopColor.A = CByte(0.74336 * c.A)
|
||||
gsc.Add(New GradientStop(stopColor, (1.5 + cornerRadius) * gradientScale))
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.3 + cornerRadius) * gradientScale))
|
||||
stopColor.A = CByte(0.38053 * c.A)
|
||||
gsc.Add(New GradientStop(stopColor, (2.5 + cornerRadius) * gradientScale))
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.5 + cornerRadius) * gradientScale))
|
||||
stopColor.A = CByte(0.12389 * c.A)
|
||||
gsc.Add(New GradientStop(stopColor, (3.5 + cornerRadius) * gradientScale))
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.7 + cornerRadius) * gradientScale))
|
||||
stopColor.A = CByte(0.02654 * c.A)
|
||||
gsc.Add(New GradientStop(stopColor, (4.5 + cornerRadius) * gradientScale))
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.9 + cornerRadius) * gradientScale))
|
||||
stopColor.A = 0
|
||||
gsc.Add(New GradientStop(stopColor, (5 + cornerRadius) * gradientScale))
|
||||
gsc.Add(New GradientStop(stopColor, (ShadowRadius + cornerRadius) * gradientScale))
|
||||
gsc.Freeze()
|
||||
Return gsc
|
||||
End Function
|
||||
Private Shared Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
|
||||
Private Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
|
||||
Dim brushes As Brush() = New Brush(8) {}
|
||||
brushes(Placement.Center) = New SolidColorBrush(c)
|
||||
brushes(Placement.Center).Freeze()
|
||||
@@ -297,3 +320,5 @@
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
'参考自：https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
|
||||
@@ -1,8 +1,8 @@
|
||||
<Grid
|
||||
<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.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="0">
|
||||
Width="40" RenderTransformOrigin="0.5,0.5" Height="0">
|
||||
<Grid.RenderTransform>
|
||||
<ScaleTransform ScaleX="0" ScaleY="0" />
|
||||
</Grid.RenderTransform>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyExtraButton
|
||||
Public Class MyExtraButton
|
||||
|
||||
'声明
|
||||
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
|
||||
@@ -11,7 +11,7 @@
|
||||
Return _Progress
|
||||
End Get
|
||||
Set(value As Double)
|
||||
If _Progress = value Then Exit Property
|
||||
If _Progress = value Then Return
|
||||
_Progress = value
|
||||
If value < 0.0001 Then
|
||||
PanProgress.Visibility = Visibility.Collapsed
|
||||
@@ -30,7 +30,7 @@
|
||||
Return _Logo
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value = _Logo Then Exit Property
|
||||
If value = _Logo Then Return
|
||||
_Logo = value
|
||||
Path.Data = (New GeometryConverter).ConvertFromString(value)
|
||||
End Set
|
||||
@@ -51,27 +51,28 @@
|
||||
Return _Show
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
If _Show = value Then Exit Property
|
||||
If _Show = value Then Return
|
||||
_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)
|
||||
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
|
||||
@@ -83,7 +84,7 @@
|
||||
'触发点击事件
|
||||
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
|
||||
If IsLeftMouseHeld Then
|
||||
Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
|
||||
Logger.Info($"按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
|
||||
RaiseEvent Click(sender, e)
|
||||
e.Handled = True
|
||||
Button_LeftMouseUp()
|
||||
@@ -91,7 +92,7 @@
|
||||
End Sub
|
||||
Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp
|
||||
If IsRightMouseHeld Then
|
||||
Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
|
||||
Logger.Info($"右键按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
|
||||
RaiseEvent RightClick(sender, e)
|
||||
e.Handled = True
|
||||
Button_RightMouseUp()
|
||||
@@ -121,7 +122,7 @@
|
||||
Focus()
|
||||
End Sub
|
||||
Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
|
||||
If Not CanRightClick Then Exit Sub
|
||||
If Not CanRightClick Then Return
|
||||
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
|
||||
AniStart({
|
||||
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
|
||||
@@ -137,11 +138,12 @@
|
||||
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
|
||||
}, "MyExtraButton Scale " & Uuid)
|
||||
End If
|
||||
If IsLeftMouseHeld Then RaiseCustomEvent()
|
||||
IsLeftMouseHeld = False
|
||||
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
|
||||
End Sub
|
||||
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
|
||||
If Not CanRightClick Then Exit Sub
|
||||
If Not CanRightClick Then Return
|
||||
If Not IsLeftMouseHeld Then
|
||||
AniStart({
|
||||
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
|
||||
@@ -191,7 +193,7 @@
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新图标按钮颜色出错")
|
||||
Logger.Warn(ex, "刷新图标按钮颜色出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -199,16 +201,17 @@
|
||||
''' 发出一圈波浪效果提示。
|
||||
''' </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)
|
||||
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
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
<Grid
|
||||
<Grid
|
||||
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"
|
||||
x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton"
|
||||
RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" Height="52" Margin="20">
|
||||
RenderTransformOrigin="0.5,0.5" Height="52" Margin="20" Cursor="Hand">
|
||||
<Grid.RenderTransform>
|
||||
<ScaleTransform ScaleX="0" ScaleY="0" />
|
||||
</Grid.RenderTransform>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyExtraTextButton
|
||||
@@ -14,7 +14,7 @@ Public Class MyExtraTextButton
|
||||
Return _Logo
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value = _Logo Then Exit Property
|
||||
If value = _Logo Then Return
|
||||
_Logo = value
|
||||
Path.Data = (New GeometryConverter).ConvertFromString(value)
|
||||
End Set
|
||||
@@ -55,7 +55,7 @@ Public Class MyExtraTextButton
|
||||
Return _Show
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
If _Show = value Then Exit Property
|
||||
If _Show = value Then Return
|
||||
_Show = value
|
||||
RunInUi(
|
||||
Sub()
|
||||
@@ -81,12 +81,12 @@ Public Class MyExtraTextButton
|
||||
|
||||
'触发点击事件
|
||||
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
|
||||
If IsLeftMouseHeld Then
|
||||
Log("[Control] 按下附加图标按钮：" & Text)
|
||||
RaiseEvent Click(sender, e)
|
||||
e.Handled = True
|
||||
Button_LeftMouseUp()
|
||||
End If
|
||||
If Not IsLeftMouseHeld Then Return
|
||||
Logger.Info($"按下附加图标按钮：{Text}")
|
||||
RaiseEvent Click(sender, e)
|
||||
e.Handled = True
|
||||
RaiseCustomEvent()
|
||||
Button_LeftMouseUp()
|
||||
End Sub
|
||||
|
||||
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
|
||||
@@ -156,7 +156,7 @@ Public Class MyExtraTextButton
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新附加图标按钮颜色出错")
|
||||
Logger.Warn(ex, "刷新附加图标按钮颜色出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -1,24 +1,16 @@
|
||||
<Border x:Class="MyHint" x:Name="PanBack"
|
||||
<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>
|
||||
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="3,0,0,0" BorderBrush="#99FF4444" CornerRadius="2">
|
||||
<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" 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" />
|
||||
<TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" />
|
||||
<local:MyIconButton x:Name="BtnClose" Visibility="Collapsed" Theme="Custom" Margin="0,0,8,0" Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" 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"
|
||||
ToolTip="不再提示" />
|
||||
</Grid>
|
||||
</Border>
|
||||
@@ -1,38 +1,74 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyHint
|
||||
|
||||
Public Uuid As Integer = GetUuid()
|
||||
|
||||
Private _IsWarn As Boolean = True
|
||||
Public Property IsWarn As Boolean
|
||||
'边框
|
||||
Public Property HasBorder As Boolean
|
||||
Get
|
||||
Return _IsWarn
|
||||
Return BorderThickness.Top > 0
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
If _IsWarn = value Then Exit Property
|
||||
_IsWarn = value
|
||||
If _IsWarn Then
|
||||
BorderBrush = New MyColor("#CCFF4444")
|
||||
Gradient1.Color = New MyColor("#BBFFBBBB")
|
||||
Gradient2.Color = New MyColor("#BBFF8888")
|
||||
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 ")
|
||||
If value Then
|
||||
BorderThickness = New Thickness(3, GetWPFSize(1), GetWPFSize(1), GetWPFSize(1))
|
||||
Else
|
||||
BorderBrush = New MyColor("#CC4D76FF")
|
||||
Gradient1.Color = New MyColor("#BBB0D0FF")
|
||||
Gradient2.Color = New MyColor("#BB9EBAFF")
|
||||
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")
|
||||
BorderThickness = New Thickness(3, 0, 0, 0)
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
|
||||
'配色
|
||||
Public Enum Themes
|
||||
Blue = 0
|
||||
Red = 1
|
||||
Yellow = 2
|
||||
End Enum
|
||||
Public Property Theme As Themes
|
||||
Get
|
||||
Return _ColorType
|
||||
End Get
|
||||
Set(value As Themes)
|
||||
_ColorType = value
|
||||
UpdateUI()
|
||||
End Set
|
||||
End Property
|
||||
Private _ColorType As Themes = Themes.Red
|
||||
Private Sub UpdateUI() Handles Me.Loaded
|
||||
Select Case Theme
|
||||
Case Themes.Blue
|
||||
Background = New MyColor("#d9ecff")
|
||||
BorderBrush = New MyColor("#1172D4")
|
||||
LabText.Foreground = New MyColor("#0F64B8")
|
||||
BtnClose.Foreground = New MyColor("#0F64B8")
|
||||
Case Themes.Red
|
||||
Background = New MyColor("#ffdddf")
|
||||
BorderBrush = New MyColor("#d82929")
|
||||
LabText.Foreground = New MyColor("#bf0b0b")
|
||||
BtnClose.Foreground = New MyColor("#bf0b0b")
|
||||
Case Themes.Yellow
|
||||
Background = New MyColor("#ffebd7")
|
||||
BorderBrush = New MyColor("#f57a00")
|
||||
LabText.Foreground = New MyColor("#d86c00")
|
||||
BtnClose.Foreground = New MyColor("#d86c00")
|
||||
End Select
|
||||
End Sub
|
||||
<Obsolete("IsWarn 已过时。请换用 Theme 属性。")>
|
||||
Public Property IsWarn As Boolean
|
||||
Get
|
||||
Return Theme = Themes.Red
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
Theme = If(value, Themes.Red, Themes.Blue)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly IsWarnProperty As DependencyProperty =
|
||||
DependencyProperty.Register("IsWarn", GetType(Boolean), GetType(MyHint), New PropertyMetadata(True,
|
||||
Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
|
||||
d.Theme = If(e.NewValue, Themes.Red, Themes.Blue)
|
||||
End Sub))
|
||||
|
||||
'文本
|
||||
Public ReadOnly Property Inlines As InlineCollection
|
||||
Get
|
||||
Return LabText.Inlines
|
||||
@@ -52,6 +88,7 @@ Public Class MyHint
|
||||
d.LabText.Text = e.NewValue
|
||||
End Sub))
|
||||
|
||||
'关闭按钮
|
||||
Public Property CanClose As Boolean
|
||||
Get
|
||||
Return BtnClose.Visibility = Visibility.Visible
|
||||
@@ -60,26 +97,26 @@ Public Class MyHint
|
||||
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property 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
|
||||
If CanClose AndAlso Settings.Get(Of Boolean)(RelativeSetup) Then Visibility = Visibility.Collapsed
|
||||
End Sub
|
||||
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
|
||||
Setup.Set(RelativeSetup, True)
|
||||
Settings.SetSafe(RelativeSetup, True)
|
||||
AniDispose(Me, False)
|
||||
End Sub
|
||||
|
||||
'触发点击事件
|
||||
Public Event Click(sender As Object, e As MouseButtonEventArgs)
|
||||
Private IsMouseDown As Boolean = False
|
||||
Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Return
|
||||
IsMouseDown = False
|
||||
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
|
||||
Logger.Info($"按下提示条{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
|
||||
RaiseEvent Click(sender, e)
|
||||
If e.Handled Then Return
|
||||
e.Handled = True
|
||||
ModEvent.TryStartEvent(EventType, EventData)
|
||||
RaiseCustomEvent() '自定义事件
|
||||
End Sub
|
||||
Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
|
||||
IsMouseDown = True
|
||||
@@ -87,42 +124,25 @@ Public Class MyHint
|
||||
Private Sub MyHint_MouseLeave() Handles Me.MouseLeave
|
||||
IsMouseDown = False
|
||||
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(MyHint), 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(MyHint), New PropertyMetadata(Nothing))
|
||||
|
||||
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
|
||||
If Not Control.IsHitTestVisible Then Return
|
||||
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)
|
||||
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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Class="MyIconButton"
|
||||
<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">
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
Public Class MyIconButton
|
||||
Imports System.Windows.Shapes
|
||||
|
||||
Public Class MyIconButton
|
||||
|
||||
'自定义事件
|
||||
Public Event Click(sender As Object, e As EventArgs)
|
||||
@@ -48,43 +50,27 @@
|
||||
End Set
|
||||
End Property
|
||||
|
||||
'触发点击事件
|
||||
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
|
||||
Private IsMouseDown As Boolean = False
|
||||
Public Property CanClick As Boolean = True
|
||||
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
|
||||
If Not CanClick Then Return
|
||||
If Not IsMouseDown Then Return
|
||||
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
|
||||
Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
|
||||
RaiseEvent Click(sender, e)
|
||||
e.Handled = True
|
||||
Button_MouseUp()
|
||||
ModEvent.TryStartEvent(EventType, EventData)
|
||||
RaiseCustomEvent() '自定义事件
|
||||
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(MyIconButton), 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(MyIconButton), 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
|
||||
If Not CanClick Then Return
|
||||
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 Not CanClick Then Return
|
||||
If IsMouseDown Then
|
||||
IsMouseDown = False
|
||||
AniStart({
|
||||
@@ -95,6 +81,7 @@
|
||||
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
|
||||
End Sub
|
||||
Private Sub Button_MouseLeave() Handles Me.MouseLeave
|
||||
If Not CanClick Then Return
|
||||
IsMouseDown = False
|
||||
AniStart({
|
||||
AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent)
|
||||
@@ -102,14 +89,12 @@
|
||||
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
|
||||
Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded, Me.IsEnabledChanged
|
||||
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 Then
|
||||
Select Case Theme
|
||||
@@ -121,9 +106,10 @@
|
||||
Path.Fill = New MyColor(160, Foreground)
|
||||
End Select
|
||||
End If
|
||||
If IsMouseOver Then
|
||||
'指向
|
||||
Dim AnimList As New List(Of AniData)
|
||||
Dim AnimList As New List(Of AniData)
|
||||
If Not IsEnabled Then
|
||||
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrushGray5", AnimationColorIn))
|
||||
ElseIf IsMouseOver Then '指向
|
||||
Select Case Theme
|
||||
Case Themes.Color
|
||||
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn))
|
||||
@@ -136,10 +122,7 @@
|
||||
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)
|
||||
Else '普通
|
||||
Select Case Theme
|
||||
Case Themes.Color
|
||||
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
|
||||
@@ -157,36 +140,37 @@
|
||||
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
|
||||
|
||||
AniStart(AnimList, "MyIconButton Color " & Uuid)
|
||||
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.Red
|
||||
Path.Fill = New MyColor(160, 255, 76, 76)
|
||||
Case Themes.Black
|
||||
Path.Fill = New MyColor(160, 0, 0, 0)
|
||||
Case Themes.Custom
|
||||
Path.Fill = New MyColor(160, Foreground)
|
||||
End Select
|
||||
If IsEnabled Then
|
||||
Select Case Theme
|
||||
Case Themes.Color
|
||||
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
|
||||
Case Themes.White
|
||||
Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
|
||||
Case Themes.Red
|
||||
Path.Fill = New MyColor(160, 255, 76, 76)
|
||||
Case Themes.Black
|
||||
Path.Fill = New MyColor(160, 0, 0, 0)
|
||||
Case Themes.Custom
|
||||
Path.Fill = New MyColor(160, Foreground)
|
||||
End Select
|
||||
Else
|
||||
Path.SetResourceReference(Shape.FillProperty, "ColorBrushGray5")
|
||||
End If
|
||||
PanBack.Background = New MyColor(0, 255, 255, 255)
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新图标按钮动画状态出错")
|
||||
Logger.Warn(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
|
||||
If Not Control.IsHitTestVisible Then Return
|
||||
Control.IsHitTestVisible = False
|
||||
AniStart({
|
||||
AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent),
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Name="PanBack" x:Class="MyIconTextButton"
|
||||
<Border x:Name="PanBack" x:Class="MyIconTextButton"
|
||||
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">
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyIconTextButton
|
||||
@@ -8,9 +8,6 @@ Public Class MyIconTextButton
|
||||
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 事件
|
||||
|
||||
'自定义属性
|
||||
|
||||
@@ -72,11 +69,11 @@ Public Class MyIconTextButton
|
||||
Public Event Click(sender As Object, e As RouteEventArgs)
|
||||
Private IsMouseDown As Boolean = False
|
||||
Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
|
||||
If Not IsMouseDown Then Exit Sub
|
||||
Log("[Control] 按下带图标按钮：" & Text)
|
||||
If Not IsMouseDown Then Return
|
||||
Logger.Info($"按下带图标按钮：{Text}")
|
||||
IsMouseDown = False
|
||||
RaiseEvent Click(Me, New RouteEventArgs(True))
|
||||
ModEvent.TryStartEvent(EventType, EventData)
|
||||
RaiseCustomEvent() '自定义事件
|
||||
RefreshColor()
|
||||
End Sub
|
||||
Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
|
||||
@@ -87,24 +84,6 @@ Public Class MyIconTextButton
|
||||
IsMouseDown = False
|
||||
RefreshColor()
|
||||
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(MyIconTextButton), 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(MyIconTextButton), New PropertyMetadata(Nothing))
|
||||
|
||||
'动画
|
||||
|
||||
@@ -187,7 +166,7 @@ Public Class MyIconTextButton
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新带图标按钮颜色出错")
|
||||
Logger.Warn(ex, "刷新带图标按钮颜色出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyImage
|
||||
Public Class MyImage
|
||||
Inherits Image
|
||||
|
||||
#Region "公开属性"
|
||||
@@ -25,7 +25,7 @@
|
||||
|
||||
''' <summary>
|
||||
''' 与 Image 的 Source 类似。
|
||||
''' 若输入以 http 开头的字符串，则会尝试下载图片然后显示，图片会保存为本地缓存。
|
||||
''' 若输入以 http 开头的字符串，则会尝试下载图片然后显示；若 EnableCache 设为 True，图片还会保存为本地缓存。
|
||||
''' 支持 WebP 格式的图片。
|
||||
''' </summary>
|
||||
Public Shadows Property Source As String '覆写 Image 的 Source 属性
|
||||
@@ -34,9 +34,9 @@
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value = "" Then value = Nothing
|
||||
If _Source = value Then Exit Property
|
||||
If _Source = value Then Return
|
||||
_Source = value
|
||||
If Not IsInitialized Then Exit Property '属性读取顺序修正：在完成 XAML 属性读取后再触发图片加载（#4868）
|
||||
If Not IsInitialized Then Return '属性读取顺序修正：在完成 XAML 属性读取后再触发图片加载（#4868）
|
||||
Load()
|
||||
End Set
|
||||
End Property
|
||||
@@ -46,7 +46,7 @@
|
||||
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
|
||||
|
||||
''' <summary>
|
||||
''' 当 Source 首次下载失败时，会从该备用地址加载图片。
|
||||
''' 若 Source 是一个网络图片，该地址将作为第二图片源。
|
||||
''' </summary>
|
||||
Public Property FallbackSource As String
|
||||
Get
|
||||
@@ -82,15 +82,15 @@
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value = "" Then value = Nothing
|
||||
If _ActualSource = value Then Exit Property
|
||||
If _ActualSource = value Then Return
|
||||
_ActualSource = value
|
||||
Try
|
||||
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件
|
||||
RunInUiWait(Sub() MyBase.Source = Bitmap)
|
||||
Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件
|
||||
RunInUi(Sub() MyBase.Source = Bitmap)
|
||||
Catch ex As Exception
|
||||
Log(ex, $"加载图片失败（{value}）")
|
||||
Logger.Warn(ex, $"加载图片失败（{value}）")
|
||||
Try
|
||||
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
|
||||
If value.StartsWithF(PathTemp) Then FileUtils.Delete(value)
|
||||
Catch
|
||||
End Try
|
||||
End Try
|
||||
@@ -103,87 +103,54 @@
|
||||
'空
|
||||
If Source Is Nothing Then
|
||||
ActualSource = Nothing
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
'本地图片
|
||||
If Not Source.StartsWithF("http") Then
|
||||
ActualSource = Source
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
'从缓存加载网络图片
|
||||
Dim Url As String = Source
|
||||
Dim Retried As Boolean = False
|
||||
Dim TempPath As String = GetTempPath(Url)
|
||||
Dim TempFile As New FileInfo(TempPath)
|
||||
Dim EnableCache As Boolean = Me.EnableCache
|
||||
Dim TempPath As String = $"{PathTemp}MyImage\{Source.GetStableHashCode()}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串，避免冲突
|
||||
Dim TempFile = FileUtils.GetInfo(TempPath)
|
||||
If EnableCache AndAlso TempFile.Exists Then
|
||||
ActualSource = TempPath
|
||||
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
|
||||
ActualSource = TempPath '显示缓存的图片
|
||||
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
|
||||
Else
|
||||
ActualSource = LoadingSource '显示加载中图片
|
||||
End If
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Dim TempDownloadingPath As String = Nothing
|
||||
Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
|
||||
Try
|
||||
RetryStart:
|
||||
'下载
|
||||
ActualSource = LoadingSource '显示加载中图片
|
||||
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
|
||||
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载，以避免携带 Header（#5072）
|
||||
Using Client As New Net.WebClient
|
||||
Client.DownloadFile(Url, TempDownloadingPath)
|
||||
End Using
|
||||
If Url <> Source AndAlso Url <> FallbackSource Then
|
||||
'已经更换了地址
|
||||
File.Delete(TempDownloadingPath)
|
||||
ElseIf EnableCache Then
|
||||
'保存缓存并显示
|
||||
If File.Exists(TempPath) Then File.Delete(TempPath)
|
||||
FileSystem.Rename(TempDownloadingPath, TempPath)
|
||||
RunInUi(Sub() ActualSource = TempPath)
|
||||
Else
|
||||
'直接显示
|
||||
RunInUiWait(Sub() ActualSource = TempDownloadingPath)
|
||||
File.Delete(TempDownloadingPath)
|
||||
End If
|
||||
NetDownloadByLoader(
|
||||
If(FallbackSource IsNot Nothing AndAlso FallbackSource.StartsWithF("http") AndAlso Source <> FallbackSource,
|
||||
{Source, FallbackSource}, {Source}),
|
||||
TempPath, SimulateBrowserHeaders:=True)
|
||||
ActualSource = TempPath
|
||||
If Not EnableCache Then FileUtils.Delete(TempPath)
|
||||
Catch ex As Exception
|
||||
Try
|
||||
If TempPath IsNot Nothing Then File.Delete(TempPath)
|
||||
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
|
||||
If TempPath IsNot Nothing Then FileUtils.Delete(TempPath)
|
||||
Catch
|
||||
End Try
|
||||
If Not Retried Then
|
||||
'更换备用地址
|
||||
Log(ex, $"下载图片可重试地失败（{Url}）", LogLevel.Developer)
|
||||
Retried = True
|
||||
Url = If(FallbackSource, Source)
|
||||
'空
|
||||
If Url Is Nothing Then
|
||||
ActualSource = Nothing
|
||||
Exit Sub
|
||||
End If
|
||||
'本地图片
|
||||
If Not Url.StartsWithF("http") Then
|
||||
ActualSource = Url
|
||||
Exit Sub
|
||||
End If
|
||||
'从缓存加载网络图片
|
||||
TempPath = GetTempPath(Url)
|
||||
TempFile = New FileInfo(TempPath)
|
||||
If EnableCache AndAlso TempFile.Exists() Then
|
||||
ActualSource = TempPath
|
||||
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
|
||||
End If
|
||||
'下载
|
||||
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
|
||||
GoTo RetryStart
|
||||
'加载本地备用图片
|
||||
If IsLocalFallback Then
|
||||
Try
|
||||
ActualSource = FallbackSource
|
||||
Logger.Warn(ex, $"下载图片失败，使用本地备用图片（{Source}）")
|
||||
Return
|
||||
Catch exx As Exception
|
||||
Logger.Error(ex, $"下载图片失败（{Source}）", LogBehavior.Toast)
|
||||
Logger.Error(exx, $"加载备用图片失败（{FallbackSource}）", LogBehavior.Toast)
|
||||
End Try
|
||||
Else
|
||||
Log(ex, $"下载图片失败（{Url}）", LogLevel.Hint)
|
||||
Logger.Error(ex, $"下载图片失败（{Source}，备用：{FallbackSource}）", LogBehavior.Toast)
|
||||
End If
|
||||
End Try
|
||||
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
|
||||
End Sub
|
||||
Public Shared Function GetTempPath(Url As String) As String
|
||||
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid x:Class="MyListItem"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyListItem
|
||||
@@ -174,7 +174,7 @@ Public Class MyListItem
|
||||
Return GetValue(TitleProperty)
|
||||
End Get
|
||||
Set(value As String)
|
||||
SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, ""))
|
||||
SetValue(TitleProperty, value.ReplaceLineEndings(""))
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
|
||||
@@ -197,8 +197,8 @@ Public Class MyListItem
|
||||
Return _Info
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Info = value Then Exit Property
|
||||
value = value.Replace(vbCr, "").Replace(vbLf, "")
|
||||
If _Info = value Then Return
|
||||
value = value.ReplaceLineEndings("")
|
||||
_Info = value
|
||||
LabInfo.Text = value
|
||||
LabInfo.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
|
||||
@@ -212,7 +212,7 @@ Public Class MyListItem
|
||||
Return _Logo
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Logo = value Then Exit Property
|
||||
If _Logo = value Then Return
|
||||
_Logo = value
|
||||
'删除旧 Logo
|
||||
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
|
||||
@@ -297,7 +297,7 @@ Public Class MyListItem
|
||||
Return _Type
|
||||
End Get
|
||||
Set(value As CheckType)
|
||||
If _Type = value Then Exit Property
|
||||
If _Type = value Then Return
|
||||
_Type = value
|
||||
'切换左栏大小
|
||||
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
|
||||
@@ -312,7 +312,8 @@ Public Class MyListItem
|
||||
Else
|
||||
'添加竖条控件
|
||||
If IsNothing(RectCheck) Then
|
||||
RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
|
||||
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))}
|
||||
@@ -367,35 +368,36 @@ Public Class MyListItem
|
||||
RaiseEvent Changed(Me, ChangedEventArgs)
|
||||
If ChangedEventArgs.Handled Then
|
||||
_Checked = RawValue
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
End If
|
||||
_Checked = value
|
||||
Else
|
||||
If value = _Checked Then Exit Sub
|
||||
If value = _Checked Then Return
|
||||
_Checked = value
|
||||
If IsInitialized Then
|
||||
RaiseEvent Changed(Me, ChangedEventArgs)
|
||||
If ChangedEventArgs.Handled Then
|
||||
_Checked = RawValue
|
||||
Exit Sub
|
||||
Return
|
||||
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
|
||||
If CheckEventArgs.Handled Then Return
|
||||
End If
|
||||
|
||||
'保证只有一个单选 ListItem 选中
|
||||
|
||||
If Type = CheckType.RadioBox Then
|
||||
If IsNothing(Parent) Then Exit Sub
|
||||
If IsNothing(Parent) Then Return
|
||||
Dim RadioboxList As New List(Of MyListItem)
|
||||
Dim CheckedCount As Integer = 0
|
||||
'收集控件列表与选中个数
|
||||
For Each Control In CType(Parent, Object).Children
|
||||
Control = MyVirtualizingElement.TryInit(Control)
|
||||
If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
|
||||
RadioboxList.Add(Control)
|
||||
If Control.Checked Then CheckedCount += 1
|
||||
@@ -478,7 +480,7 @@ Public Class MyListItem
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "设置 Checked 失败")
|
||||
Logger.Warn(ex, "设置 Checked 失败")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -502,24 +504,24 @@ Public Class MyListItem
|
||||
|
||||
'触发点击事件
|
||||
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
|
||||
If Not IsMouseDown Then Exit Sub
|
||||
If Not IsMouseDown Then Return
|
||||
RaiseEvent Click(sender, e)
|
||||
If e.Handled Then Exit Sub
|
||||
If e.Handled Then Return
|
||||
'触发自定义事件
|
||||
If Not String.IsNullOrEmpty(EventType) Then
|
||||
ModEvent.TryStartEvent(EventType, EventData)
|
||||
If CustomEventService.GetEventType(sender) <> CustomEvent.EventType.None Then
|
||||
RaiseCustomEvent()
|
||||
e.Handled = True
|
||||
End If
|
||||
If e.Handled Then Exit Sub
|
||||
If e.Handled Then Return
|
||||
'实际的单击处理
|
||||
Select Case Type
|
||||
Case CheckType.Clickable
|
||||
Log("[Control] 按下单击列表项：" & Title)
|
||||
Logger.Info($"按下单击列表项：{Title}")
|
||||
Case CheckType.RadioBox
|
||||
Log("[Control] 按下单选列表项：" & Title)
|
||||
Logger.Info($"按下单选列表项：{Title}")
|
||||
If Not Checked Then SetChecked(True, True, True)
|
||||
Case CheckType.CheckBox
|
||||
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
|
||||
Logger.Info($"按下复选列表项（{Not Checked}）：{Title}")
|
||||
SetChecked(Not Checked, True, True)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -537,34 +539,14 @@ Public Class MyListItem
|
||||
If ButtonStack IsNot Nothing 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
|
||||
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp
|
||||
'菜单虚拟化检测
|
||||
If ContentHandler IsNot Nothing Then
|
||||
ContentHandler(sender, e)
|
||||
ContentHandler(Me, e)
|
||||
ContentHandler = Nothing
|
||||
End If
|
||||
'判断当前颜色
|
||||
@@ -581,7 +563,7 @@ Public Class MyListItem
|
||||
Time = 180
|
||||
End If
|
||||
End If
|
||||
If StateLast = StateNew Then Exit Sub
|
||||
If StateLast = StateNew Then Return
|
||||
StateLast = StateNew
|
||||
'触发颜色动画
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
|
||||
@@ -657,13 +639,14 @@ Public Class MyListItem
|
||||
SetResourceReference(ForegroundProperty, "ColorBrush1")
|
||||
End If
|
||||
ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
|
||||
If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
|
||||
If CustomEventService.GetEventType(Me) = CustomEvent.EventType.打开帮助 AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
|
||||
Try
|
||||
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
|
||||
Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
|
||||
Entry.SetToListItem(Me)
|
||||
Catch ex As Exception
|
||||
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
|
||||
EventType = Nothing
|
||||
EventData = Nothing
|
||||
Logger.Error(ex, "设置帮助 MyListItem 失败", LogBehavior.Alert)
|
||||
CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
|
||||
CustomEventService.SetEventData(Me, "")
|
||||
End Try
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid
|
||||
<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}">
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports PCL.MyLoading
|
||||
Imports PCL.MyLoading
|
||||
|
||||
Public Class MyLoading
|
||||
|
||||
@@ -35,7 +35,7 @@ Public Class MyLoading
|
||||
Return _ShowProgress
|
||||
End Get
|
||||
Set(value As Boolean)
|
||||
If _ShowProgress = value Then Exit Property
|
||||
If _ShowProgress = value Then Return
|
||||
_ShowProgress = value
|
||||
RefreshText()
|
||||
End Set
|
||||
@@ -76,14 +76,8 @@ Public Class MyLoading
|
||||
If Ex Is Nothing Then
|
||||
LabText.Text = "未知错误"
|
||||
Else
|
||||
Do While Ex.InnerException IsNot Nothing
|
||||
Ex = Ex.InnerException
|
||||
Loop
|
||||
LabText.Text = StrTrim(Ex.Message)
|
||||
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
|
||||
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
|
||||
LabText.Text = "网络环境不佳，请重试或尝试使用 VPN"
|
||||
End If
|
||||
Ex = Ex.RootException()
|
||||
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
|
||||
End If
|
||||
Else
|
||||
LabText.Text = TextError
|
||||
@@ -142,7 +136,7 @@ Public Class MyLoading
|
||||
Return _OuterState
|
||||
End Get
|
||||
Set(value As MyLoadingState)
|
||||
If _OuterState = value Then Exit Property
|
||||
If _OuterState = value Then Return
|
||||
Dim OldValue = _OuterState
|
||||
_OuterState = value
|
||||
'引发事件
|
||||
@@ -159,7 +153,7 @@ Public Class MyLoading
|
||||
Return _InnerState
|
||||
End Get
|
||||
Set(value As MyLoadingState)
|
||||
If _InnerState = value Then Exit Property
|
||||
If _InnerState = value Then Return
|
||||
Dim OldValue = _InnerState
|
||||
_InnerState = value
|
||||
'引发事件
|
||||
@@ -183,34 +177,33 @@ Public Class MyLoading
|
||||
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
|
||||
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Return
|
||||
IsLooping = True
|
||||
ErrorAnimationWaiting = True
|
||||
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())
|
||||
If ShowProgress Then
|
||||
|
||||
End If
|
||||
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 Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -271,7 +264,7 @@ Public Class MyLoadingStateSimulator
|
||||
Return _LoadingState
|
||||
End Get
|
||||
Set(value As MyLoadingState)
|
||||
If _LoadingState = value Then Exit Property
|
||||
If _LoadingState = value Then Return
|
||||
Dim OldState = _LoadingState
|
||||
_LoadingState = value
|
||||
RaiseEvent LoadingStateChanged(value, OldState)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyMenuItem
|
||||
Public Class MyMenuItem
|
||||
Inherits MenuItem
|
||||
|
||||
Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
|
||||
@@ -7,7 +7,9 @@
|
||||
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
|
||||
End If
|
||||
'对父级设置透明度
|
||||
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4
|
||||
If TypeOf Parent Is ContextMenu Then
|
||||
CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'基础
|
||||
@@ -37,7 +39,7 @@
|
||||
Time = AnimationTimeOut
|
||||
End If
|
||||
'重复性验证
|
||||
If ColorName = BackName Then Exit Sub
|
||||
If ColorName = BackName Then Return
|
||||
ColorName = BackName
|
||||
'触发颜色动画
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
|
||||
@@ -54,4 +56,7 @@
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub MyMenuItem_Click(sender As Object, e As RoutedEventArgs) Handles Me.Click
|
||||
RaiseCustomEvent()
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid x:Class="MyMsgInput"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyMsgInput
|
||||
Public Class MyMsgInput
|
||||
|
||||
Private ReadOnly MyConverter As MyMsgBoxConverter
|
||||
Private ReadOnly Uuid As Integer = GetUuid()
|
||||
@@ -26,7 +26,7 @@
|
||||
ShapeLine.StrokeThickness = GetWPFSize(1)
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "输入弹窗初始化失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "输入弹窗初始化失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -46,10 +46,10 @@
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
|
||||
}, "MyMsgBox " & Uuid)
|
||||
'记录日志
|
||||
Log("[Control] 输入弹窗：" & LabTitle.Text)
|
||||
Logger.Info($"输入弹窗：{LabTitle.Text}")
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "输入弹窗加载失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "输入弹窗加载失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub Close()
|
||||
@@ -73,13 +73,13 @@
|
||||
|
||||
Public Sub Btn1_Click() Handles Btn1.Click
|
||||
TextArea.Validate() '#5773
|
||||
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub
|
||||
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Return
|
||||
MyConverter.IsExited = True
|
||||
MyConverter.Result = TextArea.Text
|
||||
Close()
|
||||
End Sub
|
||||
Public Sub Btn2_Click() Handles Btn2.Click
|
||||
If MyConverter.IsExited Then Exit Sub
|
||||
If MyConverter.IsExited Then Return
|
||||
MyConverter.IsExited = True
|
||||
MyConverter.Result = Nothing
|
||||
Close()
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid x:Class="MyMsgSelect"
|
||||
<Grid 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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyMsgSelect
|
||||
Public Class MyMsgSelect
|
||||
|
||||
Private ReadOnly MyConverter As MyMsgBoxConverter
|
||||
Private ReadOnly Uuid As Integer = GetUuid()
|
||||
@@ -21,7 +21,9 @@
|
||||
ShapeLine.StrokeThickness = GetWPFSize(1)
|
||||
'添加选择控件
|
||||
Btn1.IsEnabled = False
|
||||
For Each Selection As IMyRadio In Converter.Content
|
||||
For Each Content In Converter.Content
|
||||
Content = MyVirtualizingElement.TryInit(Content)
|
||||
Dim Selection As IMyRadio = Content
|
||||
PanSelection.Children.Add(Selection)
|
||||
AddHandler Selection.Check, AddressOf OnChecked
|
||||
If TypeOf Selection Is MyListItem Then
|
||||
@@ -33,7 +35,7 @@
|
||||
Next
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "选择弹窗初始化失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "选择弹窗初始化失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -51,10 +53,10 @@
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
|
||||
}, "MyMsgBox " & Uuid)
|
||||
'记录日志
|
||||
Log("[Control] 选择弹窗：" & LabTitle.Text)
|
||||
Logger.Info($"选择弹窗：{LabTitle.Text}")
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "选择弹窗加载失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "选择弹窗加载失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub Close()
|
||||
@@ -77,13 +79,13 @@
|
||||
End Sub
|
||||
|
||||
Public Sub Btn1_Click() Handles Btn1.Click
|
||||
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub
|
||||
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Return
|
||||
MyConverter.IsExited = True
|
||||
MyConverter.Result = SelectedIndex
|
||||
Close()
|
||||
End Sub
|
||||
Public Sub Btn2_Click() Handles Btn2.Click
|
||||
If MyConverter.IsExited Then Exit Sub
|
||||
If MyConverter.IsExited Then Return
|
||||
MyConverter.IsExited = True
|
||||
MyConverter.Result = Nothing
|
||||
Close()
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid x:Class="MyMsgText"
|
||||
<Grid 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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyMsgText
|
||||
Public Class MyMsgText
|
||||
|
||||
Private ReadOnly MyConverter As MyMsgBoxConverter
|
||||
Private ReadOnly Uuid As Integer = GetUuid()
|
||||
@@ -25,7 +25,7 @@
|
||||
ShapeLine.StrokeThickness = GetWPFSize(1)
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "普通弹窗初始化失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "普通弹窗初始化失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -44,10 +44,10 @@
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
|
||||
}, "MyMsgBox " & Uuid)
|
||||
'记录日志
|
||||
Log("[Control] 普通弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text)
|
||||
Logger.Info($"普通弹窗：{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "普通弹窗加载失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "普通弹窗加载失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub Close()
|
||||
@@ -70,7 +70,7 @@
|
||||
End Sub
|
||||
|
||||
Public Sub Btn1_Click() Handles Btn1.Click
|
||||
If MyConverter.IsExited Then Exit Sub
|
||||
If MyConverter.IsExited Then Return
|
||||
If MyConverter.Button1Action IsNot Nothing Then
|
||||
MyConverter.Button1Action()
|
||||
Else
|
||||
@@ -80,7 +80,7 @@
|
||||
End If
|
||||
End Sub
|
||||
Public Sub Btn2_Click() Handles Btn2.Click
|
||||
If MyConverter.IsExited Then Exit Sub
|
||||
If MyConverter.IsExited Then Return
|
||||
If MyConverter.Button2Action IsNot Nothing Then
|
||||
MyConverter.Button2Action()
|
||||
Else
|
||||
@@ -90,7 +90,7 @@
|
||||
End If
|
||||
End Sub
|
||||
Public Sub Btn3_Click() Handles Btn3.Click
|
||||
If MyConverter.IsExited Then Exit Sub
|
||||
If MyConverter.IsExited Then Return
|
||||
If MyConverter.Button3Action IsNot Nothing Then
|
||||
MyConverter.Button3Action()
|
||||
Else
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
Public Class MyPageLeft
|
||||
Public Class MyPageLeft
|
||||
Inherits Grid
|
||||
Private Uuid As Integer = GetUuid()
|
||||
|
||||
'执行逐个进入动画的控件
|
||||
Public Property AnimatedControl As FrameworkElement
|
||||
Public Property AnimatedControl As String '需要在 Loaded 之后才能获取到控件，所以不能用 Binding 直接绑定（#6664）
|
||||
Get
|
||||
Return GetValue(AnimatedControlProperty)
|
||||
End Get
|
||||
Set(value As FrameworkElement)
|
||||
Set(value As String)
|
||||
SetValue(AnimatedControlProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing))
|
||||
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing))
|
||||
|
||||
Public Sub TriggerShowAnimation()
|
||||
If AnimatedControl Is Nothing Then
|
||||
@@ -30,6 +30,7 @@
|
||||
Dim AniList As New List(Of AniData)
|
||||
Dim Id As Integer = 0, Delay As Integer = 0
|
||||
For Each Element As FrameworkElement In GetAllAnimControls(True)
|
||||
Element = MyVirtualizingElement.TryInit(Element)
|
||||
If Element.Visibility = Visibility.Collapsed Then
|
||||
'还原之前的隐藏动画可能导致的改变（#2436）
|
||||
Element.Opacity = 1
|
||||
@@ -39,16 +40,17 @@
|
||||
Element.Opacity = 0
|
||||
Element.RenderTransform = New TranslateTransform(-25, 0)
|
||||
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
|
||||
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 100, 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))
|
||||
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
|
||||
Delay += Math.Max(15 - Id, 7) * 2
|
||||
Id += 1
|
||||
End If
|
||||
Next
|
||||
@@ -63,8 +65,8 @@
|
||||
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)
|
||||
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 110,, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
AaOpacity(Me, -Opacity, 80, 30)
|
||||
}, "PageLeft PageChange " & Uuid)
|
||||
Else
|
||||
'逐个退出动画
|
||||
@@ -72,8 +74,8 @@
|
||||
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))
|
||||
AniList.Add(AaOpacity(Element, -Element.Opacity, 50, 70 / Controls.Count * Id))
|
||||
AniList.Add(AaTranslateX(Element, -6, 50, 70 / Controls.Count * Id))
|
||||
Id += 1
|
||||
Next
|
||||
AniStart(AniList, "PageLeft PageChange " & Uuid)
|
||||
@@ -83,11 +85,11 @@
|
||||
'遍历获取所有需要生成动画的控件
|
||||
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
|
||||
Dim AllControls As New List(Of FrameworkElement)
|
||||
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
|
||||
GetAllAnimControls(FindName(AnimatedControl), 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 Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
|
||||
If TypeOf Element Is MyTextButton Then
|
||||
AllControls.Add(Element)
|
||||
ElseIf TypeOf Element Is MyListItem Then
|
||||
@@ -104,7 +106,3 @@
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
Public Interface IRefreshable
|
||||
Sub Refresh()
|
||||
End Interface
|
||||
@@ -1,18 +1,18 @@
|
||||
Public Class MyPageRight
|
||||
Public Class MyPageRight
|
||||
Inherits AdornerDecorator
|
||||
Public PageUuid As Integer = GetUuid()
|
||||
|
||||
'“返回顶部” 按钮检测的滚动区域
|
||||
Public Property PanScroll As MyScrollViewer
|
||||
Public Property PanScroll As String '需要在 Loaded 之后才能获取到控件，所以不能用 Binding 直接绑定（#6664）
|
||||
Get
|
||||
Return GetValue(PanScrollProperty)
|
||||
End Get
|
||||
Set(value As MyScrollViewer)
|
||||
Set(value As String)
|
||||
SetValue(PanScrollProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Private Shared ReadOnly PanScrollProperty =
|
||||
DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing))
|
||||
DependencyProperty.Register("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing))
|
||||
|
||||
'当前状态
|
||||
Public Enum PageStates
|
||||
@@ -33,9 +33,9 @@
|
||||
Return _PageState
|
||||
End Get
|
||||
Set(value As PageStates)
|
||||
If _PageState = value Then Exit Property
|
||||
If _PageState = value Then Return
|
||||
_PageState = value
|
||||
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
|
||||
Logger.Trace($"页面状态切换为 {value}")
|
||||
End Set
|
||||
End Property
|
||||
|
||||
@@ -59,9 +59,9 @@
|
||||
''' <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,
|
||||
Optional FinishedInvoke As Action(Of LoaderBase) = Nothing, Optional InputInvoke As Func(Of Object) = Nothing,
|
||||
Public Sub PageLoaderInit(Of TIn, TOut)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
|
||||
RealLoader As LoaderTask(Of TIn, TOut),
|
||||
Optional FinishedInvoke As Action(Of LoaderTask(Of TIn, TOut)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
|
||||
Optional AutoRun As Boolean = True)
|
||||
'初始化参数
|
||||
Me.PanLoader = PanLoader
|
||||
@@ -89,13 +89,59 @@
|
||||
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
|
||||
'初次运行加载器
|
||||
If PageLoaderAutoRun Then
|
||||
If PageLoader.GetType.Name.StartsWithF("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
|
||||
'上下两个重载只有这里不一样
|
||||
PageLoader.Start(RealLoader.StartGetInput(Nothing, PageLoaderInputInvoke))
|
||||
End If
|
||||
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
|
||||
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
|
||||
End If
|
||||
'设置加载环
|
||||
PageLoaderUi.State = RealLoader
|
||||
AddHandler PageLoaderUi.Click, Sub() If RealLoader.State = LoadState.Failed Then PageLoaderRestart() '点击重试事件
|
||||
End Sub
|
||||
''' <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(Of TIn)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
|
||||
RealLoader As LoaderCombo(Of TIn),
|
||||
Optional FinishedInvoke As Action(Of LoaderCombo(Of TIn)) = Nothing, Optional InputInvoke As Func(Of TIn) = 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
|
||||
If FinishedInvoke IsNot Nothing Then
|
||||
AddHandler RealLoader.PreviewFinish,
|
||||
Sub()
|
||||
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
|
||||
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作，避免退出动画被重置
|
||||
Loop
|
||||
RunInUiWait(Sub() FinishedInvoke(RealLoader))
|
||||
Thread.Sleep(20) '由于大量初始化控件会导致掉帧，延迟触发 State 改变事件
|
||||
End Sub
|
||||
End If
|
||||
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
|
||||
'上下两个重载只有这里不一样
|
||||
Dim Input = Nothing
|
||||
If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
|
||||
PageLoader.Start(Input)
|
||||
End If
|
||||
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
|
||||
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
|
||||
@@ -106,8 +152,8 @@
|
||||
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.StartsWithF("LoaderTask") Then
|
||||
If Not PageLoaderAutoRun Then Return
|
||||
If GeneralUtils.IsGenericInstanceOf(PageLoader, GetType(LoaderTask(Of ,))) OrElse TypeOf PageLoader Is LoaderWorker Then
|
||||
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
|
||||
Else
|
||||
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
|
||||
@@ -125,36 +171,37 @@
|
||||
''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。
|
||||
''' </summary>
|
||||
Public Sub PageOnEnter()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnEnter")
|
||||
Logger.Trace("已触发 PageOnEnter")
|
||||
RaiseEvent PageEnter()
|
||||
Select Case PageState
|
||||
Case PageStates.Empty
|
||||
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then
|
||||
'如果加载器在进入页面时不启动（例如 HiPer 联机），那么在此时就会有 State = Waiting
|
||||
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Canceled Then
|
||||
'如果加载器在进入页面时不启动（例如联机），那么在此时就会有 State = Waiting
|
||||
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)
|
||||
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
|
||||
Else 'PageLoader.State = LoadState.Failed
|
||||
PageState = PageStates.LoaderEnter
|
||||
TriggerEnterAnimation(PanAlways, PanLoader)
|
||||
End If
|
||||
Case PageStates.ContentExit
|
||||
'和上面的一样，但是不管 PanAlways
|
||||
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then
|
||||
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Canceled Then
|
||||
PageState = PageStates.ContentEnter
|
||||
TriggerEnterAnimation(If(PanContent, Child))
|
||||
ElseIf PageLoader.State = LoadState.Loading Then
|
||||
PageState = PageStates.LoaderWait
|
||||
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
|
||||
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
|
||||
Else 'PageLoader.State = LoadState.Failed
|
||||
PageState = PageStates.LoaderEnter
|
||||
TriggerEnterAnimation(PanLoader)
|
||||
End If
|
||||
Case PageStates.ContentEnter '重复调用 PageOnEnter，直接忽略
|
||||
Case PageStates.ContentEnter
|
||||
'重复调用 PageOnEnter，直接忽略
|
||||
Case Else
|
||||
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
|
||||
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnter 事件。")
|
||||
End Select
|
||||
End Sub
|
||||
Public Event PageEnter()
|
||||
@@ -163,7 +210,7 @@
|
||||
''' 需要立即切换至 PageExit 或 Empty。
|
||||
''' </summary>
|
||||
Public Sub PageOnExit()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnExit")
|
||||
Logger.Trace("已触发 PageOnExit")
|
||||
RaiseEvent PageExit()
|
||||
Select Case PageState
|
||||
Case PageStates.ContentEnter, PageStates.ContentStay
|
||||
@@ -187,8 +234,8 @@
|
||||
''' 需要立即切换至 Empty。
|
||||
''' </summary>
|
||||
Public Sub PageOnForceExit()
|
||||
If PageState = PageStates.Empty Then Exit Sub
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
|
||||
If PageState = PageStates.Empty Then Return
|
||||
Logger.Trace("已触发 PageOnForceExit")
|
||||
PageState = PageStates.Empty
|
||||
AniStop("PageRight PageChange " & PageUuid)
|
||||
'由于动画会被强制中止，所以需要手动进行隐藏
|
||||
@@ -205,10 +252,10 @@
|
||||
''' 需要在 PageEnter 事件确认要显示的子页面有哪些。
|
||||
''' </summary>
|
||||
Public Sub PageOnContentExit()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
|
||||
Logger.Trace("已触发 PageOnContentExit")
|
||||
If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
|
||||
Throw New Exception("在调用 PageOnContentExit 时，加载器不能为 Loading 状态")
|
||||
'Loading 的加载器可能触发进一步变化，难以预测会触发子页面的动画还是加载器完成的动画
|
||||
Throw New Exception("在调用 PageOnContentExit 时，加载器不能为 Loading 状态")
|
||||
End If
|
||||
Select Case PageState
|
||||
Case PageStates.ContentEnter, PageStates.ContentStay
|
||||
@@ -219,8 +266,12 @@
|
||||
Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay
|
||||
PageState = PageStates.ContentExit
|
||||
TriggerExitAnimation(PanLoader)
|
||||
Case PageStates.LoaderWait, PageStates.Empty
|
||||
Case PageStates.LoaderWait
|
||||
PageOnEnter()
|
||||
Case PageStates.Empty
|
||||
'可能是在离开页面后，其他后台线程调用了本函数，此时不应触发 PageOnEnter()
|
||||
'例如：在加入联机房间后，切换到其他页面，然后联机房间被解散
|
||||
If IsLoaded Then PageOnEnter()
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
@@ -230,7 +281,7 @@
|
||||
''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。
|
||||
''' </summary>
|
||||
Private Sub PageOnEnterAnimationFinished()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished")
|
||||
Logger.Trace("已触发 PageOnEnterAnimationFinished")
|
||||
Select Case PageState
|
||||
Case PageStates.ContentEnter
|
||||
PageState = PageStates.ContentStay
|
||||
@@ -238,7 +289,7 @@
|
||||
PageState = PageStates.LoaderStayForce
|
||||
AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid)
|
||||
Case Else
|
||||
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。")
|
||||
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnterAnimationFinished 事件。")
|
||||
End Select
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -246,7 +297,7 @@
|
||||
''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。
|
||||
''' </summary>
|
||||
Private Sub PageOnExitAnimationFinished()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished")
|
||||
Logger.Trace("已触发 PageOnExitAnimationFinished")
|
||||
Select Case PageState
|
||||
Case PageStates.PageExit
|
||||
PageState = PageStates.Empty
|
||||
@@ -256,7 +307,7 @@
|
||||
PageState = PageStates.ContentEnter
|
||||
TriggerEnterAnimation(PanContent)
|
||||
Case Else
|
||||
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。")
|
||||
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnExitAnimationFinished 事件。")
|
||||
End Select
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -264,7 +315,7 @@
|
||||
''' 需要从 LoaderWait 切换到 LoaderEnter。
|
||||
''' </summary>
|
||||
Private Sub PageOnLoaderWaitFinished()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished")
|
||||
Logger.Trace("已触发 PageOnLoaderWaitFinished")
|
||||
Select Case PageState
|
||||
Case PageStates.LoaderWait
|
||||
PageState = PageStates.LoaderEnter
|
||||
@@ -274,7 +325,7 @@
|
||||
TriggerEnterAnimation(PanLoader)
|
||||
End If
|
||||
Case Else
|
||||
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
|
||||
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
|
||||
End Select
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -282,7 +333,7 @@
|
||||
''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。
|
||||
''' </summary>
|
||||
Private Sub PageOnLoaderStayFinished()
|
||||
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished")
|
||||
Logger.Trace("已触发 PageOnLoaderStayFinished")
|
||||
Select Case PageState
|
||||
Case PageStates.LoaderStayForce
|
||||
If PageLoader.State = LoadState.Finished Then
|
||||
@@ -292,7 +343,7 @@
|
||||
PageState = PageStates.LoaderStay
|
||||
End If
|
||||
Case Else
|
||||
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
|
||||
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
@@ -302,8 +353,8 @@
|
||||
Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState)
|
||||
Select Case NewState
|
||||
Case LoadState.Failed, LoadState.Loading
|
||||
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Exit Sub
|
||||
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
|
||||
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
|
||||
Logger.Trace("已触发 PageLoaderState (Start/Refresh)")
|
||||
'（重新）开始运行
|
||||
'需要从部分状态切换到 ReloadExit
|
||||
Select Case PageState
|
||||
@@ -313,9 +364,9 @@
|
||||
Case PageStates.LoaderExit
|
||||
PageState = PageStates.ContentExit
|
||||
End Select
|
||||
Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting
|
||||
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Exit Sub
|
||||
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
|
||||
Case LoadState.Finished, LoadState.Canceled, LoadState.Waiting
|
||||
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
|
||||
Logger.Trace("已触发 PageLoaderState (Stop/Canceled)")
|
||||
'运行结束
|
||||
'需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit
|
||||
Select Case PageState
|
||||
@@ -358,10 +409,10 @@
|
||||
Else
|
||||
Control.Opacity = 0
|
||||
Control.RenderTransform = New TranslateTransform(0, -16)
|
||||
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
AniList.Add(AaOpacity(Control, 1, 100, 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
|
||||
Delay += 25
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
@@ -373,7 +424,7 @@
|
||||
End If
|
||||
'结束
|
||||
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
|
||||
AniStart(AniList, "PageRight PageChange " & PageUuid)
|
||||
AniStart(AniList, "PageRight PageChange " & PageUuid, True)
|
||||
End Sub
|
||||
|
||||
'逐个退出动画
|
||||
@@ -387,9 +438,9 @@
|
||||
CType(Control, MyExtraTextButton).Show = False
|
||||
Else
|
||||
Control.IsHitTestVisible = False
|
||||
AniList.Add(AaOpacity(Control, -1, 90, Delay))
|
||||
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
|
||||
Delay += 20
|
||||
AniList.Add(AaOpacity(Control, -1, 70, Delay))
|
||||
AniList.Add(AaTranslateY(Control, -6, 70, Delay))
|
||||
Delay += 15
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
@@ -423,7 +474,7 @@
|
||||
Return AllControls.Except(DisabledPageAnimControls)
|
||||
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 Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
|
||||
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
|
||||
AllControls.Add(Element)
|
||||
ElseIf TypeOf Element Is ContentControl Then
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Grid x:Class="MyRadioBox"
|
||||
<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}"
|
||||
|
||||
@@ -1,8 +1,9 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Shapes
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyRadioBox
|
||||
Implements IMyRadio
|
||||
Implements IMyRadio, ISettingControl
|
||||
|
||||
'基础
|
||||
|
||||
@@ -41,20 +42,20 @@ Public Class MyRadioBox
|
||||
RaiseEvent PreviewCheck(Me, e)
|
||||
If e.Handled Then
|
||||
Radiobox_MouseLeave()
|
||||
Exit Sub
|
||||
Return
|
||||
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
|
||||
If value <> Checked Then
|
||||
SetValue(CheckedProperty, value)
|
||||
IsChanged = True
|
||||
End If
|
||||
|
||||
'保证只有一个单选框选中
|
||||
If Parent Is Nothing Then Exit Sub
|
||||
'保证最多只有一个单选框选中
|
||||
If Parent Is Nothing Then Return
|
||||
Dim RadioboxList As New List(Of MyRadioBox)
|
||||
Dim CheckedCount As Integer = 0
|
||||
For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
|
||||
@@ -63,42 +64,38 @@ Public Class MyRadioBox
|
||||
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
|
||||
If CheckedCount > 1 Then
|
||||
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
|
||||
Next
|
||||
End If
|
||||
End Select
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
|
||||
'触发事件
|
||||
If IsChanged Then
|
||||
'触发事件
|
||||
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
|
||||
RaiseEvent Changed(Me, New RouteEventArgs(user))
|
||||
RaiseCustomEvent()
|
||||
'更改动画
|
||||
SyncUI()
|
||||
End If
|
||||
|
||||
'更改动画
|
||||
SyncUI()
|
||||
Catch ex As Exception
|
||||
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
|
||||
Logger.Error(ex, "单选框勾选改变错误", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub SyncUI()
|
||||
@@ -115,7 +112,7 @@ Public Class MyRadioBox
|
||||
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)
|
||||
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray5")), AnimationTimeOfCheck)
|
||||
}, "MyRadioBox BorderColor " & Uuid)
|
||||
Else
|
||||
'由有变无
|
||||
@@ -127,7 +124,7 @@ Public Class MyRadioBox
|
||||
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)
|
||||
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray5")), AnimationTimeOfCheck)
|
||||
}, "MyRadioBox BorderColor " & Uuid)
|
||||
End If
|
||||
Else
|
||||
@@ -140,13 +137,13 @@ Public Class MyRadioBox
|
||||
ShapeDot.Height = 9
|
||||
ShapeDot.Opacity = 1
|
||||
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
|
||||
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"))
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
@@ -172,8 +169,8 @@ Public Class MyRadioBox
|
||||
Private MouseDowned As Boolean = False
|
||||
Private AllowMouseDown As Boolean = True
|
||||
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
|
||||
If Not MouseDowned Then Exit Sub
|
||||
Log("[Control] 按下单选框：" & Text)
|
||||
If Not MouseDowned Then Return
|
||||
Logger.Info($"按下单选框：{Text}")
|
||||
SetChecked(True, True)
|
||||
MouseDowned = False
|
||||
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
|
||||
@@ -187,7 +184,7 @@ Public Class MyRadioBox
|
||||
End If
|
||||
End Sub
|
||||
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
|
||||
If Not MouseDowned Then Exit Sub
|
||||
If Not MouseDowned Then Return
|
||||
MouseDowned = False
|
||||
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
|
||||
If Not Checked Then
|
||||
@@ -208,15 +205,15 @@ Public Class MyRadioBox
|
||||
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)
|
||||
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray5 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
|
||||
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - 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"))
|
||||
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
|
||||
End If
|
||||
End Sub
|
||||
Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter
|
||||
@@ -224,16 +221,32 @@ Public Class MyRadioBox
|
||||
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 Not Me.IsEnabled Then Return '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)
|
||||
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
|
||||
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
|
||||
Else
|
||||
AniStop("MyRadioBox BorderColor " & Uuid)
|
||||
AniStop("MyRadioBox TextColor " & Uuid)
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
|
||||
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
|
||||
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
|
||||
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
|
||||
End If
|
||||
End Sub
|
||||
|
||||
#Region "设置"
|
||||
|
||||
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
|
||||
Checked = NewValue = SettingService.GetValue(Me)
|
||||
End Sub
|
||||
|
||||
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
|
||||
Return If(Checked, SettingService.GetValue(Me), Nothing)
|
||||
End Function
|
||||
|
||||
Private Sub SaveSetting() Handles Me.Check
|
||||
SettingService.SaveSetting(Me)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Name="PanBack" x:Class="MyRadioButton"
|
||||
<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">
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Windows.Markup
|
||||
Imports System.Windows.Markup
|
||||
|
||||
<ContentProperty("Inlines")>
|
||||
Public Class MyRadioButton
|
||||
@@ -7,10 +7,6 @@ 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 事件
|
||||
|
||||
'自定义属性
|
||||
|
||||
@@ -46,23 +42,22 @@ Public Class MyRadioButton
|
||||
''' 手动设置 Checked 属性。
|
||||
''' </summary>
|
||||
''' <param name="value">新的 Checked 属性。</param>
|
||||
''' <param name="user">是否由用户引发。</param>
|
||||
''' <param name="raiseByMouse">是否由用户引发。</param>
|
||||
''' <param name="anime">是否执行动画。</param>
|
||||
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
|
||||
Public Sub SetChecked(value As Boolean, raiseByMouse 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
|
||||
If _Checked <> value Then
|
||||
_Checked = value
|
||||
IsChanged = True
|
||||
End If
|
||||
|
||||
'保证只有一个单选框选中
|
||||
|
||||
If IsNothing(Parent) Then Exit Sub
|
||||
If Parent Is Nothing Then Return
|
||||
Dim RadioboxList As New List(Of MyRadioButton)
|
||||
Dim CheckedCount As Integer = 0
|
||||
'收集控件列表与选中个数
|
||||
@@ -101,14 +96,15 @@ Public Class MyRadioButton
|
||||
|
||||
'更改动画
|
||||
|
||||
If Not IsChanged Then Exit Sub
|
||||
If Not IsChanged Then Return
|
||||
RefreshColor(Nothing, anime)
|
||||
|
||||
'触发事件
|
||||
If Checked Then RaiseEvent Check(Me, user)
|
||||
If Checked Then RaiseEvent Check(Me, raiseByMouse)
|
||||
RaiseCustomEvent()
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
|
||||
Logger.Error(ex, "单选按钮勾选改变错误", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -147,17 +143,17 @@ Public Class MyRadioButton
|
||||
Public Event PreviewClick(sender As Object, e As RouteEventArgs)
|
||||
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)
|
||||
If Checked Then Return
|
||||
If Not IsMouseDown Then Return
|
||||
Logger.Info($"按下单选按钮：{Text}")
|
||||
IsMouseDown = False
|
||||
Dim e As New RouteEventArgs(True)
|
||||
RaiseEvent PreviewClick(Me, e)
|
||||
If e.Handled Then Exit Sub
|
||||
If e.Handled Then Return
|
||||
SetChecked(True, True, True)
|
||||
End Sub
|
||||
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
|
||||
If Checked Then Exit Sub
|
||||
If Checked Then Return
|
||||
IsMouseDown = True
|
||||
RefreshColor()
|
||||
End Sub
|
||||
@@ -259,7 +255,7 @@ Public Class MyRadioButton
|
||||
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新单选按钮颜色出错")
|
||||
Logger.Warn(ex, "刷新单选按钮颜色出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Windows.Interop
|
||||
Imports System.Windows.Threading
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyScrollBar
|
||||
Public Class MyScrollBar
|
||||
Inherits Primitives.ScrollBar
|
||||
|
||||
'基础
|
||||
@@ -44,7 +44,7 @@
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "滚动条颜色改变出错")
|
||||
Logger.Warn(ex, "滚动条颜色改变出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -1,20 +1,20 @@
|
||||
Public Class MyScrollViewer
|
||||
Public Class MyScrollViewer
|
||||
Inherits ScrollViewer
|
||||
|
||||
Public Property DeltaMult 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
|
||||
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
|
||||
Dim SourceType = e.Source.GetType
|
||||
If Content.TemplatedParent Is Nothing AndAlso (
|
||||
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
|
||||
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
|
||||
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
|
||||
TypeOf e.Source Is CheckBox) Then
|
||||
(TypeOf e.Source Is Visual AndAlso
|
||||
PresentationSource.FromVisual(e.Source)?.RootVisual?.GetType().FullName = "System.Windows.Controls.Primitives.PopupRoot")) Then
|
||||
'如果当前是在对有滚动条的下拉框或文本框执行，则不接管操作
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
e.Handled = True
|
||||
PerformVerticalOffsetDelta(-e.Delta)
|
||||
@@ -26,7 +26,7 @@
|
||||
AniStart(
|
||||
AaDouble(
|
||||
Sub(AnimDelta As Double)
|
||||
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
|
||||
RealOffset = (RealOffset + AnimDelta).Clamp(0, ExtentHeight - ActualHeight)
|
||||
ScrollToVerticalOffset(RealOffset)
|
||||
End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
|
||||
End Sub
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<local:MyCard x:Class="MySearchBox"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Class MySearchBox
|
||||
Class MySearchBox
|
||||
Inherits MyCard
|
||||
|
||||
Public Event TextChanged(sender As Object, e As EventArgs)
|
||||
@@ -39,4 +39,7 @@
|
||||
TextBox.Focus()
|
||||
End Sub
|
||||
|
||||
Private Sub MySearchBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
|
||||
If e.Key = Key.Enter Then RaiseCustomEvent()
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Class="MySlider"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,7 @@
|
||||
Public Class MySlider
|
||||
Imports System.Windows.Shapes
|
||||
|
||||
Public Class MySlider
|
||||
Implements ISettingControl
|
||||
|
||||
'基础
|
||||
|
||||
@@ -14,7 +17,7 @@
|
||||
Return _MaxValue
|
||||
End Get
|
||||
Set(value As Integer)
|
||||
If value = _MaxValue Then Exit Property
|
||||
If value = _MaxValue Then Return
|
||||
_MaxValue = value
|
||||
RefreshWidth(Nothing, Nothing)
|
||||
End Set
|
||||
@@ -28,8 +31,8 @@
|
||||
Set(newValue As Integer)
|
||||
Try
|
||||
|
||||
newValue = MathClamp(newValue, 0, MaxValue)
|
||||
If _Value = newValue Then Exit Property
|
||||
newValue = newValue.Clamp(0, MaxValue)
|
||||
If _Value = newValue Then Return
|
||||
|
||||
'触发 Preview 事件，修改新值
|
||||
Dim OldValue = _Value
|
||||
@@ -40,12 +43,12 @@
|
||||
If e.Handled Then
|
||||
_Value = OldValue
|
||||
DragStop()
|
||||
Exit Property
|
||||
Return
|
||||
End If
|
||||
End If
|
||||
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then
|
||||
If ActualWidth < ShapeDot.Width Then Exit Property
|
||||
If ActualWidth < ShapeDot.Width Then Return
|
||||
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
|
||||
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
|
||||
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
|
||||
@@ -60,7 +63,7 @@
|
||||
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
|
||||
Logger.Error(ex, "滑动条进度改变出错", LogBehavior.Toast)
|
||||
End Try
|
||||
End Set
|
||||
End Property
|
||||
@@ -70,7 +73,7 @@
|
||||
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
|
||||
LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
|
||||
LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
|
||||
SetLeft(ShapeDot, NewWidth)
|
||||
ShapeDot.Margin = New Thickness(NewWidth, ShapeDot.Margin.Top, ShapeDot.Margin.Right, ShapeDot.Margin.Bottom)
|
||||
End Sub
|
||||
|
||||
'拖动
|
||||
@@ -88,7 +91,7 @@
|
||||
AniStop("MySlider KeyPopup " & Uuid)
|
||||
End Sub
|
||||
Public Sub DragDoing()
|
||||
Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
|
||||
Dim Percent As Double = ((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width)).Clamp(0, 1)
|
||||
Dim NewValue As Integer = Percent * MaxValue
|
||||
If Not NewValue = Value Then
|
||||
Value = NewValue
|
||||
@@ -103,7 +106,7 @@
|
||||
Popup.IsOpen = False
|
||||
End Sub
|
||||
Public Sub RefreshPopup()
|
||||
If GetHintText Is Nothing Then Exit Sub
|
||||
If GetHintText Is Nothing Then Return
|
||||
Popup.IsOpen = True
|
||||
TextHint.Text = GetHintText.DynamicInvoke(Value)
|
||||
Dim typeface As New Typeface(TextHint.FontFamily, TextHint.FontStyle, TextHint.FontWeight, TextHint.FontStretch)
|
||||
@@ -153,7 +156,7 @@
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "滑动条颜色改变出错")
|
||||
Logger.Warn(ex, "滑动条颜色改变出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -165,7 +168,7 @@
|
||||
End Sub
|
||||
Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
|
||||
'拒绝一边拖动一边用按键改变
|
||||
If ReferenceEquals(Me, DragControl) Then Exit Sub
|
||||
If ReferenceEquals(Me, DragControl) Then Return
|
||||
'改变值
|
||||
If e.Key = Key.Left Then
|
||||
ChangeByKey = True
|
||||
@@ -178,7 +181,7 @@
|
||||
ChangeByKey = False
|
||||
e.Handled = True
|
||||
Else
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
'更新 Popup
|
||||
If GetHintText IsNot Nothing Then
|
||||
@@ -188,4 +191,20 @@
|
||||
End If
|
||||
End Sub
|
||||
|
||||
#Region "设置"
|
||||
|
||||
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
|
||||
Value = Val(NewValue)
|
||||
End Sub
|
||||
|
||||
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
|
||||
Return Value
|
||||
End Function
|
||||
|
||||
Private Sub SaveSetting() Handles Me.Change
|
||||
SettingService.SaveSetting(Me)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
@@ -1,4 +1,4 @@
|
||||
<Border x:Class="MySliderDot"
|
||||
<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"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MySliderDot
|
||||
Public Class MySliderDot
|
||||
|
||||
'基础
|
||||
|
||||
@@ -59,7 +59,7 @@
|
||||
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
|
||||
Logger.Warning(ex, "滑动条进度改变出错", LogLevel.Hint)
|
||||
End Try
|
||||
End Set
|
||||
End Property
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
Public Class MyTextBox
|
||||
Public Class MyTextBox
|
||||
Inherits TextBox
|
||||
Implements ISettingControl
|
||||
|
||||
'自定义属性
|
||||
|
||||
@@ -36,7 +37,7 @@
|
||||
End Property
|
||||
Public Overrides Sub OnApplyTemplate()
|
||||
MyBase.OnApplyTemplate()
|
||||
If HintText = "" OrElse labHint.Text <> "" Then Exit Sub
|
||||
If HintText = "" OrElse labHint.Text <> "" Then Return
|
||||
labHint.Text = If(Text = "", HintText, "")
|
||||
End Sub
|
||||
|
||||
@@ -44,7 +45,13 @@
|
||||
|
||||
Public Uuid As Integer = GetUuid()
|
||||
Public Shared Event ValidateChanged(sender As Object, e As EventArgs)
|
||||
Public ChangedEventList As New List(Of RoutedEventHandler)
|
||||
Private _ChangedEventList As List(Of RoutedEventHandler)
|
||||
Public ReadOnly Property ChangedEventList As List(Of RoutedEventHandler)
|
||||
Get
|
||||
If _ChangedEventList Is Nothing Then _ChangedEventList = New List(Of RoutedEventHandler)
|
||||
Return _ChangedEventList
|
||||
End Get
|
||||
End Property
|
||||
Public Custom Event ValidatedTextChanged As RoutedEventHandler
|
||||
AddHandler(value As RoutedEventHandler)
|
||||
ChangedEventList.Add(value)
|
||||
@@ -217,11 +224,11 @@
|
||||
IsTextChanged = IsLoaded
|
||||
'进行输入验证
|
||||
Validate()
|
||||
If Not IsValidated Then Exit Sub
|
||||
If Not IsValidated Then Return
|
||||
'改变文本
|
||||
RaiseEvent ValidatedTextChanged(sender, e)
|
||||
Catch ex As Exception
|
||||
Log(ex, "进行输入验证时出错", LogLevel.Assert)
|
||||
Logger.Error(ex, "进行输入验证时出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -230,7 +237,7 @@
|
||||
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
|
||||
Try
|
||||
'不对 ComboBox 从属进行动画
|
||||
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
|
||||
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Return
|
||||
'判断当前颜色
|
||||
Dim ForeColorName As String, BackColorName As String
|
||||
Dim AnimationTime As Integer
|
||||
@@ -264,7 +271,7 @@
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
|
||||
'有动画
|
||||
AniStart({
|
||||
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime)，
|
||||
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
|
||||
AaColor(Me, BackgroundProperty, BackColorName, AnimationTime)
|
||||
}, "MyTextBox Color " & Uuid)
|
||||
Else
|
||||
@@ -275,12 +282,12 @@
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "文本框颜色改变出错")
|
||||
Logger.Warn(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 CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Return
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then
|
||||
'有动画
|
||||
AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid)
|
||||
@@ -291,4 +298,25 @@
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'在按下回车时触发自定义事件
|
||||
Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
|
||||
If e.Key = Key.Enter Then RaiseCustomEvent()
|
||||
End Sub
|
||||
|
||||
#Region "设置"
|
||||
|
||||
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
|
||||
Text = NewValue
|
||||
End Sub
|
||||
|
||||
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
|
||||
Return Text
|
||||
End Function
|
||||
|
||||
Private Sub SaveSetting() Handles Me.ValidatedTextChanged
|
||||
SettingService.SaveSetting(Me)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class MyTextButton
|
||||
Public Class MyTextButton
|
||||
Inherits Label
|
||||
|
||||
Public Event Click(sender As Object, e As EventArgs)
|
||||
@@ -22,15 +22,15 @@
|
||||
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))
|
||||
DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("",
|
||||
Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
|
||||
If e.OldValue = e.NewValue Then Return
|
||||
AniStart({
|
||||
AaOpacity(sender, -sender.Opacity, 50),
|
||||
AaCode(Sub() sender.Content = e.NewValue,, True),
|
||||
AaOpacity(sender, 1, 170)
|
||||
}, "MyTextButton Text " & sender.Uuid)
|
||||
End Sub))
|
||||
|
||||
'鼠标事件
|
||||
|
||||
@@ -43,13 +43,12 @@
|
||||
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
|
||||
If Not IsMouseDown Then Return
|
||||
IsMouseDown = False
|
||||
Logger.Info($"按下文本按钮：{Text}")
|
||||
RaiseEvent Click(Me, Nothing)
|
||||
RaiseCustomEvent()
|
||||
e.Handled = True
|
||||
End Sub
|
||||
|
||||
'指向动画
|
||||
@@ -57,7 +56,7 @@
|
||||
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
|
||||
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
|
||||
'判断当前颜色
|
||||
Dim ForeName As String
|
||||
Dim Time As Integer
|
||||
@@ -72,7 +71,7 @@
|
||||
Time = AnimationTimeOut
|
||||
End If
|
||||
'重复性验证
|
||||
If ColorName = ForeName Then Exit Sub
|
||||
If ColorName = ForeName Then Return
|
||||
ColorName = ForeName
|
||||
'触发颜色动画
|
||||
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
|
||||
@@ -85,26 +84,4 @@
|
||||
End If
|
||||
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(MyTextButton), 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(MyTextButton), New PropertyMetadata(Nothing))
|
||||
|
||||
End Class
|
||||
|
||||
@@ -0,0 +1,70 @@
|
||||
Public Class MyVirtualizingElement(Of T As FrameworkElement)
|
||||
Inherits FrameworkElement
|
||||
|
||||
Private Initializer As Func(Of T)
|
||||
Public Sub New(Initializer As Func(Of T))
|
||||
Me.Initializer = Initializer
|
||||
LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 实例化此控件。
|
||||
''' </summary>
|
||||
Public Function Init() As T
|
||||
Dim Element As T = Initializer()
|
||||
If Parent IsNot Nothing Then
|
||||
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
|
||||
Dim ParentPanel As Panel = Parent
|
||||
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
|
||||
ParentPanel.Children.RemoveAt(CurrentIndex)
|
||||
ParentPanel.Children.Insert(CurrentIndex, Element)
|
||||
End If
|
||||
Return Element
|
||||
End Function
|
||||
Public Shared Widening Operator CType(Virtualized As MyVirtualizingElement(Of T)) As T
|
||||
Return Virtualized.Init()
|
||||
End Operator
|
||||
|
||||
End Class
|
||||
|
||||
'非泛型形式
|
||||
Public Class MyVirtualizingElement
|
||||
Inherits FrameworkElement
|
||||
|
||||
Private Initializer As Func(Of FrameworkElement)
|
||||
Public Sub New(Initializer As Func(Of FrameworkElement))
|
||||
Me.Initializer = Initializer
|
||||
LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 实例化此控件。
|
||||
''' </summary>
|
||||
Public Function Init() As FrameworkElement
|
||||
Dim Element As FrameworkElement = Initializer()
|
||||
If Parent IsNot Nothing Then
|
||||
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
|
||||
Dim ParentPanel As Panel = Parent
|
||||
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
|
||||
ParentPanel.Children.RemoveAt(CurrentIndex)
|
||||
ParentPanel.Children.Insert(CurrentIndex, Element)
|
||||
End If
|
||||
Return Element
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 获取实例化后的控件。
|
||||
''' 如果该控件没有实例化，则会立即实例化。
|
||||
''' 如果类型错误，则返回原值。
|
||||
''' </summary>
|
||||
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
|
||||
If GeneralUtils.IsGenericInstanceOf(Element, GetType(MyVirtualizingElement(Of ))) Then
|
||||
Return CType(Element, Object).Init()
|
||||
ElseIf TypeOf Element Is MyVirtualizingElement Then
|
||||
Return CType(Element, MyVirtualizingElement).Init()
|
||||
Else
|
||||
Return Element
|
||||
End If
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -1,4 +1,4 @@
|
||||
<Window
|
||||
<Window
|
||||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
|
||||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
|
||||
xmlns:local="clr-namespace:PCL"
|
||||
@@ -95,13 +95,12 @@
|
||||
<RowDefinition Height="Auto" />
|
||||
<RowDefinition />
|
||||
</Grid.RowDefinitions>
|
||||
<Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality" />
|
||||
<Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality"
|
||||
HorizontalAlignment="Stretch" VerticalAlignment="Stretch" />
|
||||
<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"/>
|
||||
<GradientStop Color="{StaticResource ColorObject4}" Offset="0"/>
|
||||
</LinearGradientBrush>
|
||||
</Grid.Background>
|
||||
<local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
|
||||
@@ -115,19 +114,19 @@
|
||||
<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" />
|
||||
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h6 a7,7 180 0 1 0,14 h-6 M62.5,6.5 a10,11.5 180 1 0 0,18 M71,2.5 v24.5 h13.5" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="2.2" Width="39" />
|
||||
<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" />
|
||||
<local:MyImage 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"
|
||||
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="启动" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
|
||||
LogoScale="0.9" Logo="M52.1,164.5c-1.4,0-3.1-0.5-4.2-1.3c-2.6-1.7-4-4.2-4-7V43.8c0-2.9,1.6-5.8,4.1-7c1.2-0.8,2.7-1.2,4.1-1.2c1.5,0,2.9,0.4,4.2,1.2L153.1,93c0,0,0.1,0,0.1,0.1c2.6,1.7,4,4.2,4,7c0,3-1.7,5.8-4.2,7.1l-96.8,56.2C55.1,164,53.5,164.5,52.1,164.5z M60.4,142.1l72.1-42.1L60.4,58.2V142.1z" />
|
||||
<local:MyRadioButton x:Name="BtnTitleSelect1" Text="下载" Tag="1" Margin="5,0" Padding="2,0"
|
||||
LogoScale="0.9" Logo="M955 610h-59c-15 0-29 13-29 29v196c0 15-13 29-29 29h-649c-15 0-29-13-29-29v-196c0-15-13-29-29-29h-59c-15 0-29 13-29 29V905c0 43 35 78 78 78h787c43 0 78-35 78-78V640c0-15-13-29-29-29zM492 740c11 11 29 11 41 0l265-265c11-11 11-29 0-41l-41-41c-11-11-29-11-41 0l-110 110c-11 11-33 3-33-13V68C571 53 555 39 541 39h-59c-15 0-29 13-29 29v417c0 17-21 25-33 13l-110-110c-11-11-29-11-41 0L226 433c-11 11-11 29 0 41L492 740z" />
|
||||
<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"
|
||||
<local:MyRadioButton x:Name="BtnTitleSelect3" Text="设置" 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"
|
||||
<local:MyRadioButton x:Name="BtnTitleSelect4" Text="更多" Tag="4" Margin="5,0" Padding="2,0"
|
||||
LogoScale="0.93" Logo="M364 0h-273C40 0 0 40 0 91v273C0 414 40 455 91 455h273C414 455 455 414 455 364V91C455 40 414 0 364 0zM341 341H113V113h227v227zM933 0h-273C609 0 568 40 568 91v273c0 50 40 91 91 91h273C983 455 1024 414 1024 364V91c0-50-40-91-90-91zM910 341h-227V113h227v227zM364 568h-273C40 568 0 609 0 659v273c0 50 40 91 91 91h273C414 1024 455 983 455 932v-273C455 609 414 568 364 568zM341 910H113v-227h227v227zM933 568h-273c-50 0-91 40-91 91v273c0 50 40 91 91 91h273c50 0 90-40 90-91v-273c0-50-40-90-90-90zM910 910h-227v-227h227v227z"/>
|
||||
</StackPanel>
|
||||
</Grid>
|
||||
@@ -145,7 +144,7 @@
|
||||
<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">
|
||||
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.04">
|
||||
<GradientStop Color="#000000" Offset="0"/>
|
||||
<GradientStop Color="#00000000" Offset="1"/>
|
||||
</LinearGradientBrush>
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
' This file is used by Code Analysis to maintain SuppressMessage
|
||||
' 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.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 8.4 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 2.2 KiB |
|
Before Width: | Height: | Size: 963 B After Width: | Height: | Size: 963 B |
|
Before Width: | Height: | Size: 2.1 KiB After Width: | Height: | Size: 2.1 KiB |
|
Before Width: | Height: | Size: 951 B After Width: | Height: | Size: 951 B |
@@ -1,6 +1,8 @@
|
||||
'动画引擎模块
|
||||
'动画引擎模块
|
||||
'使用 Ani 作为方法或属性的开头，使用 Aa 作为单个动画对象的开头（便于自动补全）
|
||||
|
||||
Imports System.Windows.Media.Effects
|
||||
|
||||
Public Module ModAnimation
|
||||
|
||||
#Region "声明"
|
||||
@@ -8,7 +10,12 @@ Public Module ModAnimation
|
||||
''' <summary>
|
||||
''' 动画速度。最大为 200。
|
||||
''' </summary>
|
||||
Public AniSpeed As Double = 1
|
||||
Public ReadOnly Property AniSpeed As Double
|
||||
Get
|
||||
Dim Setting As Integer = Settings.Get(Of Integer)("SystemDebugAnim")
|
||||
Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3))
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 动画组列表。
|
||||
''' </summary>
|
||||
@@ -107,7 +114,7 @@ Public Module ModAnimation
|
||||
Public ValueLast As Object
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return GetStringFromEnum(TypeMain) & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
|
||||
Return TypeMain.ToString() & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
|
||||
End Function
|
||||
|
||||
End Structure
|
||||
@@ -467,7 +474,7 @@ Public Module ModAnimation
|
||||
''' 按照 WPF 方式旋转控件的动画。
|
||||
''' </summary>
|
||||
''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param>
|
||||
''' <param name="Value">大小改变的百分比（如-0.6）。</param>
|
||||
''' <param name="Value">旋转角度（度）。</param>
|
||||
''' <param name="Time">动画长度（毫秒）。</param>
|
||||
''' <param name="Delay">动画延迟执行的时间（毫秒）。</param>
|
||||
''' <param name="Ease">插值器类型。</param>
|
||||
@@ -514,13 +521,14 @@ Public Module ModAnimation
|
||||
''' </summary>
|
||||
''' <remarks></remarks>
|
||||
Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData)
|
||||
AaStack = New List(Of AniData)
|
||||
Dim Result = New List(Of AniData)
|
||||
Dim AniDelay As Integer = 0
|
||||
For Each Item In Stack.Children
|
||||
Item.Opacity = 0
|
||||
AaStack.Add(AaOpacity(Item, 1, Time, AniDelay))
|
||||
Result.Add(AaOpacity(Item, 1, Time, AniDelay))
|
||||
AniDelay += Delay
|
||||
Next
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
@@ -577,10 +585,10 @@ Public Module ModAnimation
|
||||
Public Class AniEaseLinear
|
||||
Inherits AniEase
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
Return MathClamp(t, 0, 1)
|
||||
Return t.Clamp(0, 1)
|
||||
End Function
|
||||
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
|
||||
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
|
||||
Return t1.Clamp(0, 1) - t0.Clamp(0, 1)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
@@ -595,7 +603,7 @@ Public Module ModAnimation
|
||||
p = Power
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
Return MathClamp(t, 0, 1) ^ p
|
||||
Return t.Clamp(0, 1) ^ p
|
||||
End Function
|
||||
End Class
|
||||
''' <summary>
|
||||
@@ -608,7 +616,7 @@ Public Module ModAnimation
|
||||
p = Power
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
Return 1 - MathClamp(1 - t, 0, 1) ^ p
|
||||
Return 1 - (1 - t).Clamp(0, 1) ^ p
|
||||
End Function
|
||||
End Class
|
||||
''' <summary>
|
||||
@@ -624,6 +632,26 @@ Public Module ModAnimation
|
||||
Return Ease.GetValue(t)
|
||||
End Function
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 以特定速度开始的平滑结束。
|
||||
''' </summary>
|
||||
Public Class AniEaseOutFluentWithInitial
|
||||
Inherits AniEase
|
||||
Private ReadOnly alpha As Double '(初速度 / 平均速度) – 1
|
||||
''' <param name="InitialPixelPerSecond">初速度，px/s</param>
|
||||
''' <param name="TotalSecond">总时长，s</param>
|
||||
''' <param name="TotalDistance">总路程，px</param>
|
||||
Public Sub New(InitialPixelPerSecond As Double, TotalSecond As Double, TotalDistance As Double)
|
||||
Dim v0_norm As Double = InitialPixelPerSecond * TotalSecond / TotalDistance '归一化初速度
|
||||
alpha = v0_norm - 1.0
|
||||
If alpha < 0 Then alpha = 0 '初速度小于平均速度时，退化为线性
|
||||
End Sub
|
||||
Public Overrides Function GetValue(percent As Double) As Double
|
||||
Dim p As Double = percent.Clamp(0, 1)
|
||||
If alpha = 0 Then Return p '退化到线性
|
||||
Return (alpha + 1) * p / (1 + alpha * p)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
'Back / 回弹
|
||||
''' <summary>
|
||||
@@ -636,7 +664,7 @@ Public Module ModAnimation
|
||||
p = 3 - Power * 0.5
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
t = MathClamp(t, 0, 1)
|
||||
t = t.Clamp(0, 1)
|
||||
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
|
||||
End Function
|
||||
End Class
|
||||
@@ -650,7 +678,7 @@ Public Module ModAnimation
|
||||
p = 3 - Power * 0.5
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
t = MathClamp(t, 0, 1)
|
||||
t = t.Clamp(0, 1)
|
||||
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
|
||||
End Function
|
||||
End Class
|
||||
@@ -694,7 +722,7 @@ Public Module ModAnimation
|
||||
p = Power + 4
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
t = MathClamp(t, 0, 1)
|
||||
t = t.Clamp(0, 1)
|
||||
Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
|
||||
End Function
|
||||
End Class
|
||||
@@ -708,7 +736,7 @@ Public Module ModAnimation
|
||||
p = Power + 4
|
||||
End Sub
|
||||
Public Overrides Function GetValue(t As Double) As Double
|
||||
t = 1 - MathClamp(t, 0, 1)
|
||||
t = 1 - t.Clamp(0, 1)
|
||||
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
|
||||
End Function
|
||||
End Class
|
||||
@@ -723,9 +751,17 @@ Public Module ModAnimation
|
||||
''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param>
|
||||
''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param>
|
||||
Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
|
||||
If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟，导致动画突然结束
|
||||
If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟，导致动画突然结束
|
||||
'添加到正在执行的动画组
|
||||
Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()}
|
||||
Dim AllAnis = New List(Of AniData)
|
||||
For Each Element In AniGroup
|
||||
If TypeOf Element Is ICollection Then
|
||||
AllAnis.AddRange(Element)
|
||||
Else
|
||||
AllAnis.Add(Element)
|
||||
End If
|
||||
Next
|
||||
Dim NewEntry As New AniGroupEntry With {.Data = AllAnis, .StartTick = GetTimeMs()}
|
||||
If Name = "" Then
|
||||
Name = NewEntry.Uuid
|
||||
Else
|
||||
@@ -768,48 +804,50 @@ Public Module ModAnimation
|
||||
''' </summary>
|
||||
Public Sub AniStart()
|
||||
'初始化计时器
|
||||
AniLastTick = GetTimeTick()
|
||||
AniLastTick = GetTimeMs()
|
||||
AniFPSTimer = AniLastTick
|
||||
AniRunning = True '标记动画执行开始
|
||||
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Log("[Animation] 动画线程开始")
|
||||
Do While True
|
||||
'两帧之间的间隔时间
|
||||
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
|
||||
If DeltaTime < 3 Then GoTo Sleeper
|
||||
AniLastTick = GetTimeTick()
|
||||
'记录 FPS
|
||||
If ModeDebug Then
|
||||
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
|
||||
AniFPS = AniFPSCounter
|
||||
AniFPSCounter = 0
|
||||
AniFPSTimer = AniLastTick
|
||||
End If
|
||||
AniFPSCounter += 2
|
||||
End If
|
||||
'执行动画
|
||||
RunInUiWait(Sub()
|
||||
AniCount = 0
|
||||
AniTimer(DeltaTime * AniSpeed)
|
||||
'#If DEBUG Then
|
||||
' FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
|
||||
'#Else
|
||||
' If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
|
||||
'#End If
|
||||
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
|
||||
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & GetString(NetManager.Speed) & "/s）")
|
||||
End If
|
||||
End Sub)
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Logger.Info("动画线程开始")
|
||||
Do While True
|
||||
'两帧之间的间隔时间
|
||||
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
|
||||
If DeltaTime < 3 Then GoTo Sleeper
|
||||
AniLastTick = GetTimeMs()
|
||||
'记录 FPS
|
||||
If ModeDebug Then
|
||||
If (AniLastTick - AniFPSTimer).Clamp(0, 100000) >= 500 Then
|
||||
AniFPS = AniFPSCounter
|
||||
AniFPSCounter = 0
|
||||
AniFPSTimer = AniLastTick
|
||||
End If
|
||||
AniFPSCounter += 2
|
||||
End If
|
||||
'执行动画
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
AniCount = 0
|
||||
AniTimer(DeltaTime * AniSpeed)
|
||||
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
|
||||
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{StringUtils.FormatByteSize(NetManager.Speed)}/s）")
|
||||
If NetManager.FileRemain < 5 Then
|
||||
For Each File In NetManager.AllFiles.Values
|
||||
If File.State < NetState.Finished Then Logger.Trace($"- {File.State} {StringUtils.FormatByteSize(File.Speed)}/s {File.LocalPath}")
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End Sub)
|
||||
Sleeper:
|
||||
'控制 FPS
|
||||
Thread.Sleep(1)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Log(ex, "动画帧执行失败", LogLevel.Assert)
|
||||
End Try
|
||||
End Sub, "Animation", ThreadPriority.AboveNormal)
|
||||
'控制 FPS
|
||||
Thread.Sleep(1)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
|
||||
End Try
|
||||
End Sub, "Animation", ThreadPriority.AboveNormal)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -818,7 +856,7 @@ Sleeper:
|
||||
Public Sub AniTimer(DeltaTick As Integer)
|
||||
Try
|
||||
|
||||
If DeltaTick / AniSpeed > 200 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
|
||||
If DeltaTick / AniSpeed > 100 Then Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
|
||||
Dim i As Integer = -1
|
||||
'循环每个动画组
|
||||
Do While i + 1 < AniGroups.Count
|
||||
@@ -883,7 +921,7 @@ NextAni:
|
||||
Loop
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "动画刻执行失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "动画刻执行失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -896,15 +934,39 @@ NextAni:
|
||||
Select Case Ani.TypeMain
|
||||
|
||||
Case AniType.Number
|
||||
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
If Delta <> 0 Then
|
||||
Select Case Ani.TypeSub
|
||||
Case AniTypeSub.X
|
||||
DeltaLeft(Ani.Obj, Delta)
|
||||
If TypeOf Ani.Obj Is Window Then
|
||||
CType(Ani.Obj, Window).Left += Delta
|
||||
Else
|
||||
Select Case Ani.Obj.HorizontalAlignment
|
||||
Case HorizontalAlignment.Left, HorizontalAlignment.Stretch
|
||||
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left + Delta, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
|
||||
Case HorizontalAlignment.Right
|
||||
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right - Delta, Ani.Obj.Margin.Bottom)
|
||||
End Select
|
||||
End If
|
||||
Case AniTypeSub.Y
|
||||
DeltaTop(Ani.Obj, Delta)
|
||||
If TypeOf Ani.Obj Is Window Then
|
||||
CType(Ani.Obj, Window).Top += Delta
|
||||
Else
|
||||
Select Case Ani.Obj.VerticalAlignment
|
||||
Case VerticalAlignment.Top
|
||||
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top + Delta, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
|
||||
Case VerticalAlignment.Bottom
|
||||
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom - Delta)
|
||||
End Select
|
||||
End If
|
||||
Case AniTypeSub.Opacity
|
||||
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
|
||||
If TypeOf Ani.Obj Is UIElement Then
|
||||
Dim Obj As UIElement = Ani.Obj
|
||||
Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
|
||||
ElseIf TypeOf Ani.Obj Is DropShadowEffect Then
|
||||
Dim Obj As DropShadowEffect = Ani.Obj
|
||||
Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
|
||||
End If
|
||||
Case AniTypeSub.Width
|
||||
Dim Obj As FrameworkElement = Ani.Obj
|
||||
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
|
||||
@@ -936,7 +998,7 @@ NextAni:
|
||||
|
||||
Case AniType.Color
|
||||
'利用 Last 记录了余下的小数值
|
||||
Dim Delta As MyColor = MathPercent(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
|
||||
Dim Delta As MyColor = MyColor.Lerp(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
|
||||
Dim Obj As FrameworkElement = Ani.Obj(0)
|
||||
Dim Prop As DependencyProperty = Ani.Obj(1)
|
||||
Dim NewColor As MyColor = New MyColor(Obj.GetValue(Prop)) + Delta
|
||||
@@ -946,21 +1008,22 @@ NextAni:
|
||||
Case AniType.Scale
|
||||
Dim Obj As FrameworkElement = Ani.Obj
|
||||
Dim Delta As Double = Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)
|
||||
Obj.Margin = New Thickness(Obj.Margin.Left + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathPercent(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathPercent(0, Ani.Value.Top, Delta))
|
||||
Obj.Width = Math.Max(Obj.Width + MathPercent(0, Ani.Value.Width, Delta), 0)
|
||||
Obj.Height = Math.Max(Obj.Height + MathPercent(0, Ani.Value.Height, Delta), 0)
|
||||
Obj.Margin = New Thickness(Obj.Margin.Left + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathUtils.Lerp(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathUtils.Lerp(0, Ani.Value.Top, Delta))
|
||||
Obj.Width = Math.Max(Obj.Width + MathUtils.Lerp(0, Ani.Value.Width, Delta), 0)
|
||||
Obj.Height = Math.Max(Obj.Height + MathUtils.Lerp(0, Ani.Value.Height, Delta), 0)
|
||||
|
||||
Case AniType.TextAppear
|
||||
Dim TextCount As Integer = If(Ani.Value(1), Ani.Value(0).ToString.Length, 0) +
|
||||
Math.Round(Ani.Value(0).ToString.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
|
||||
Dim NewText As String = Mid(Ani.Value(0), 1, TextCount)
|
||||
Dim Text As String = Ani.Value(0)
|
||||
Dim TextCount As Integer = If(Ani.Value(1), Text.Length, 0) +
|
||||
Math.Round(Text.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
|
||||
Dim NewText As String = Text.Substring(0, TextCount)
|
||||
'添加乱码
|
||||
If TextCount < Ani.Value(0).ToString.Length Then
|
||||
Dim NextText As String = Mid(Ani.Value(0), TextCount + 1, 1)
|
||||
If TextCount < Text.Length Then
|
||||
Dim NextText As String = Text.Substring(TextCount, 1)
|
||||
If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then
|
||||
NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
|
||||
Else
|
||||
NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray)
|
||||
NewText &= RandomInteger(0, 85).ConvertRadix(86)
|
||||
End If
|
||||
End If
|
||||
'设置文本
|
||||
@@ -976,26 +1039,26 @@ NextAni:
|
||||
Case AniType.ScaleTransform
|
||||
Dim Obj As FrameworkElement = Ani.Obj
|
||||
If TypeOf Obj.RenderTransform IsNot ScaleTransform Then
|
||||
Obj.RenderTransformOrigin = New Point(0.5, 0.5)
|
||||
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
|
||||
Obj.RenderTransform = New ScaleTransform(1, 1)
|
||||
End If
|
||||
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
CType(Obj.RenderTransform, ScaleTransform).ScaleX = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleX + Delta, 0)
|
||||
CType(Obj.RenderTransform, ScaleTransform).ScaleY = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleY + Delta, 0)
|
||||
|
||||
Case AniType.RotateTransform
|
||||
Dim Obj As FrameworkElement = Ani.Obj
|
||||
If TypeOf Obj.RenderTransform IsNot RotateTransform Then
|
||||
Obj.RenderTransformOrigin = New Point(0.5, 0.5)
|
||||
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
|
||||
Obj.RenderTransform = New RotateTransform(0)
|
||||
End If
|
||||
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
|
||||
CType(Obj.RenderTransform, RotateTransform).Angle = CType(Obj.RenderTransform, RotateTransform).Angle + Delta
|
||||
|
||||
End Select
|
||||
Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
|
||||
Catch ex As Exception
|
||||
Log(ex, "执行动画失败：" & Ani.ToString, LogLevel.Hint)
|
||||
Logger.Error(ex, $"执行动画失败：{Ani}", LogBehavior.Toast)
|
||||
End Try
|
||||
Return Ani
|
||||
End Function
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
Public Module ModLoader
|
||||
Public Module ModLoader
|
||||
|
||||
'各类加载器
|
||||
''' <summary>
|
||||
@@ -37,7 +37,7 @@
|
||||
RealParent = RealParent.Parent
|
||||
End While
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取父加载器失败（" & Name & "）", LogLevel.Feedback)
|
||||
Logger.Error(ex, $"获取父加载器失败（{Name}）")
|
||||
Return Nothing
|
||||
End Try
|
||||
End Get
|
||||
@@ -85,11 +85,12 @@
|
||||
Return _State
|
||||
End Get
|
||||
Set(value As LoadState)
|
||||
If _State = value Then Exit Property
|
||||
If _State = value Then Return
|
||||
Dim OldState = _State
|
||||
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
|
||||
If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
|
||||
_State = value
|
||||
Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value))
|
||||
If value = LoadState.Canceled Then CancellationTokenSource?.Cancel()
|
||||
Logger.Log($"加载器 {[GetType].Name} {Name} 状态改变：{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
|
||||
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
|
||||
RunInUi(
|
||||
Sub()
|
||||
@@ -112,7 +113,7 @@
|
||||
Return _LoadingState
|
||||
End Get
|
||||
Set(value As MyLoading.MyLoadingState)
|
||||
If _LoadingState = value Then Exit Property
|
||||
If _LoadingState = value Then Return
|
||||
Dim OldState = _LoadingState
|
||||
_LoadingState = value
|
||||
RaiseEvent LoadingStateChanged(value, OldState)
|
||||
@@ -148,13 +149,13 @@
|
||||
Case LoadState.Waiting
|
||||
Return 0
|
||||
Case LoadState.Loading
|
||||
Return If(_Progress = -1, 0.02, _Progress)
|
||||
Return If(_Progress = -1, 0, _Progress)
|
||||
Case Else
|
||||
Return 1
|
||||
End Select
|
||||
End Get
|
||||
Set(value As Double)
|
||||
If _Progress = value Then Exit Property
|
||||
If _Progress = value Then Return
|
||||
Dim OldValue = _Progress
|
||||
_Progress = value
|
||||
RaiseEvent ProgressChanged(value, OldValue)
|
||||
@@ -163,13 +164,42 @@
|
||||
Private _Progress As Double = -1
|
||||
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
|
||||
''' <summary>
|
||||
''' 创建一个 ProgressProvider，在其进度改变时，并将其进度单向映射到此加载器上。
|
||||
''' 这是 Loader 对新框架的兼容层。
|
||||
''' </summary>
|
||||
Public Function CreateSyncProgressProvider(Optional FromPercentage As Double = 0, Optional ToPercentage As Double = 1) As ProgressProvider
|
||||
Dim Provider As New ProgressProvider
|
||||
AddHandler Provider.ProgressChanged,
|
||||
Sub(ChangedProgress)
|
||||
Dim RawProgress = Provider.GetRaw()
|
||||
Progress = FromPercentage + (RawProgress.actual + RawProgress.skiped) * (ToPercentage - FromPercentage)
|
||||
End Sub
|
||||
Return Provider
|
||||
End Function
|
||||
''' <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 MustOverride Sub Cancel()
|
||||
Public MustOverride Sub Failed(Ex As Exception)
|
||||
Private CancellationTokenSource As CancellationTokenSource
|
||||
''' <summary>
|
||||
''' 创建一个随此加载器取消的取消令牌；令牌取消时也会调用此加载器的 Cancel。
|
||||
''' 这是 Loader 对新框架的兼容层。
|
||||
''' </summary>
|
||||
Public Function CreateCancellationToken() As CancellationToken
|
||||
SyncLock LockState
|
||||
If CancellationTokenSource Is Nothing OrElse CancellationTokenSource.IsCancellationRequested Then
|
||||
CancellationTokenSource = New CancellationTokenSource
|
||||
CancellationTokenSource.Token.Register(AddressOf Cancel)
|
||||
End If
|
||||
If State = LoadState.Canceled Then CancellationTokenSource.Cancel()
|
||||
Return CancellationTokenSource.Token
|
||||
End SyncLock
|
||||
End Function
|
||||
|
||||
'等待结束
|
||||
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
|
||||
@@ -177,16 +207,19 @@
|
||||
''' <summary>
|
||||
''' 无限期地等待加载器完成，直到结束或抛出异常。若加载器尚未开始，则会开始执行。
|
||||
''' </summary>
|
||||
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False,
|
||||
Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
|
||||
Start(Input, IsForceRestart)
|
||||
Do While State = LoadState.Loading
|
||||
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
|
||||
p?.Set(Progress)
|
||||
c.ThrowIfCancellationRequested()
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
If State = LoadState.Finished Then
|
||||
Exit Sub
|
||||
ElseIf State = LoadState.Aborted Then
|
||||
Throw New ThreadInterruptedException("加载器执行已中断。")
|
||||
Return
|
||||
ElseIf State = LoadState.Canceled Then
|
||||
Throw New OperationCanceledException("加载器执行已中断")
|
||||
ElseIf IsNothing([Error]) Then
|
||||
Throw New Exception("未知错误！")
|
||||
Else
|
||||
@@ -207,9 +240,9 @@
|
||||
If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage)
|
||||
Loop
|
||||
If State = LoadState.Finished Then
|
||||
Exit Sub
|
||||
ElseIf State = LoadState.Aborted Then
|
||||
Throw New ThreadInterruptedException("加载器执行已中断。")
|
||||
Return
|
||||
ElseIf State = LoadState.Canceled Then
|
||||
Throw New OperationCanceledException("加载器执行已中断")
|
||||
ElseIf IsNothing([Error]) Then
|
||||
Throw New Exception("未知错误！")
|
||||
Else
|
||||
@@ -227,28 +260,28 @@
|
||||
''' <summary>
|
||||
''' 用于异步执行并监控单一函数的加载器。
|
||||
''' </summary>
|
||||
Public Class LoaderTask(Of InputType, OutputType)
|
||||
Public Class LoaderTask(Of TIn, TOut)
|
||||
Inherits LoaderBase
|
||||
|
||||
'线程设定
|
||||
Protected Friend ThreadPriority As ThreadPriority
|
||||
'执行事件
|
||||
Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType))
|
||||
Protected Friend LoadDelegate As Action(Of LoaderTask(Of TIn, TOut))
|
||||
Protected Friend InputDelegate As Func(Of Object)
|
||||
'状态指示
|
||||
''' <summary>
|
||||
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断，不可跨线程调用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property IsAborted As Boolean
|
||||
Public ReadOnly Property IsCanceled As Boolean
|
||||
Get
|
||||
Return IsAbortedWithThread(Thread.CurrentThread)
|
||||
Return IsCanceledWithThread(Thread.CurrentThread)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 当前执行线程是否应当中断。需要手动提供加载器线程，用于需要跨线程检查的情况。
|
||||
''' </summary>
|
||||
Public Function IsAbortedWithThread(Thread As Thread) As Boolean
|
||||
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted
|
||||
Public Function IsCanceledWithThread(Thread As Thread) As Boolean
|
||||
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Canceled
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 在输入相同时使用原有结果的超时，单位为毫秒。
|
||||
@@ -263,25 +296,25 @@
|
||||
''' </summary>
|
||||
Public LastRunningThread As Thread = Nothing
|
||||
'输入输出
|
||||
Public Input As InputType = Nothing
|
||||
Public Output As OutputType = Nothing
|
||||
Public Input As TIn = Nothing
|
||||
Public Output As TOut = Nothing
|
||||
|
||||
'获取输入
|
||||
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用
|
||||
Public Function StartGetInput(Optional Input As TIn = Nothing, Optional InputDelegate As Func(Of TIn) = Nothing) As TIn 'InputDelegate 参数存在匿名调用
|
||||
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
|
||||
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断
|
||||
Dim NewInput As TIn = 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
|
||||
Public Function ShouldStart(ByRef Input As TIn, 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)
|
||||
Logger.Error(ex, $"加载输入获取失败（{Name}）", LogBehavior.Toast)
|
||||
[Error] = ex
|
||||
SyncLock LockState
|
||||
State = LoadState.Failed
|
||||
@@ -290,75 +323,90 @@
|
||||
'检验输入以确定情况
|
||||
If IsForceRestart Then Return True '强制要求重启
|
||||
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
|
||||
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
|
||||
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
|
||||
Return False '则不重试
|
||||
|
||||
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
|
||||
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
|
||||
LastFinishedTime = 0 OrElse GetTimeMs() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
|
||||
Return False '…则不重试
|
||||
Else
|
||||
Return True '需要开始
|
||||
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()
|
||||
If State = LoadState.Loading Then TriggerThreadInterrupt()
|
||||
Me.Input = Input
|
||||
SyncLock LockState
|
||||
State = LoadState.Loading
|
||||
Progress = -1
|
||||
End SyncLock
|
||||
Else
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
|
||||
LastRunningThread = New Thread(
|
||||
Sub()
|
||||
Try
|
||||
IsForceRestarting = IsForceRestart
|
||||
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
|
||||
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 CancelledException
|
||||
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
|
||||
If Not IsAborted Then State = LoadState.Aborted
|
||||
Catch ex As ThreadInterruptedException
|
||||
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
|
||||
'如果线程是因为判断到 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}) 出错，已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
|
||||
[Error] = ex
|
||||
State = LoadState.Failed
|
||||
End Try
|
||||
End Sub) With {.Name = Name, .Priority = ThreadPriority}
|
||||
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
|
||||
Sub()
|
||||
Try
|
||||
IsForceRestarting = IsForceRestart
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
|
||||
LoadDelegate(Me)
|
||||
If IsCanceled Then
|
||||
Logger.Warn($"加载线程 {Name} 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
|
||||
Return
|
||||
End If
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已完成")
|
||||
RaisePreviewFinish()
|
||||
State = LoadState.Finished
|
||||
LastFinishedTime = GetTimeMs() '未中断，本次输出有效
|
||||
Catch ex As Exception
|
||||
If ex.IsCanceled Then
|
||||
'如果线程是因为判断到 IsCanceled 而提前中止，则代表已有新线程被重启，此时不应当改为 Canceled
|
||||
'如果线程是在没有 IsCanceled 时手动引发了取消异常，则代表没有重启线程，这通常代表用户手动取消，应当改为 Canceled
|
||||
Logger.Trace(ex, $"加载线程 {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
|
||||
If Not IsCanceled Then State = LoadState.Canceled
|
||||
Else
|
||||
Failed(ex)
|
||||
End If
|
||||
End Try
|
||||
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
|
||||
Try
|
||||
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsCanceled
|
||||
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”，则等待后重试
|
||||
Thread.Sleep(500)
|
||||
LastRunningThread.Start()
|
||||
End Try
|
||||
End Sub
|
||||
Public Overrides Sub Abort()
|
||||
If State <> LoadState.Loading Then Exit Sub
|
||||
Public Overrides Sub Failed(ex As Exception)
|
||||
[Error] = ex
|
||||
SyncLock LockState
|
||||
State = LoadState.Aborted
|
||||
If IsCanceled OrElse State >= LoadState.Finished Then Return
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
TriggerThreadAbort()
|
||||
Logger.Warn(ex, $"加载线程 {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
|
||||
TriggerThreadInterrupt()
|
||||
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()
|
||||
Public Overrides Sub Cancel()
|
||||
SyncLock LockState
|
||||
If State <> LoadState.Loading Then Return
|
||||
State = LoadState.Canceled
|
||||
End SyncLock
|
||||
TriggerThreadInterrupt()
|
||||
End Sub
|
||||
Private Sub TriggerThreadInterrupt()
|
||||
If LastRunningThread Is Nothing Then Return
|
||||
If LastRunningThread.IsAlive Then
|
||||
LastRunningThread.Interrupt()
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已中断")
|
||||
End If
|
||||
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)
|
||||
Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of TIn, TOut)), Optional InputDelegate As Func(Of TIn) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
|
||||
Me.Name = Name
|
||||
Me.LoadDelegate = LoadDelegate
|
||||
Me.InputDelegate = InputDelegate
|
||||
@@ -366,6 +414,53 @@
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 新 Worker 对老 Loader 的兼容包装类。
|
||||
''' </summary>
|
||||
Public Class LoaderWorker
|
||||
Inherits LoaderBase
|
||||
Public WithEvents Worker As IWorker
|
||||
Public Sub New(Name As String, Worker As IWorker)
|
||||
Me.Name = Name
|
||||
Me.Worker = Worker
|
||||
AddHandler Worker.Progress.ProgressChanged, Sub(Raw) Progress = Raw.actual + Raw.skiped
|
||||
End Sub
|
||||
|
||||
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
SyncLock LockState
|
||||
State = LoadState.Loading
|
||||
End SyncLock
|
||||
Logger.Trace(Function() $"Worker {Name} 已启动")
|
||||
IsForceRestarting = IsForceRestart
|
||||
Worker.Start()
|
||||
End Sub
|
||||
Private Sub Worker_Succeeded() Handles Worker.Succeeded
|
||||
Logger.Trace(Function() $"Worker {Name} 已完成")
|
||||
RaisePreviewFinish()
|
||||
SyncLock LockState
|
||||
State = LoadState.Finished
|
||||
End SyncLock
|
||||
End Sub
|
||||
Public Overrides Sub Cancel() Handles Worker.Canceled
|
||||
SyncLock LockState
|
||||
If State <> LoadState.Loading Then Return
|
||||
State = LoadState.Canceled
|
||||
End SyncLock
|
||||
Logger.Trace(Function() $"Worker {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
|
||||
Worker.Cancel()
|
||||
End Sub
|
||||
Public Overrides Sub Failed(Ex As Exception) Handles Worker.Failed
|
||||
SyncLock LockState
|
||||
If State >= LoadState.Finished Then Return
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
Logger.Warn(Ex, $"Worker {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
|
||||
[Error] = Ex
|
||||
Worker.Cancel()
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 支持多个加载器连续运作的复合加载器。
|
||||
''' </summary>
|
||||
@@ -419,7 +514,7 @@
|
||||
'改变状态
|
||||
SyncLock LockState
|
||||
If State = LoadState.Loading Then
|
||||
Exit Sub
|
||||
Return
|
||||
Else
|
||||
State = LoadState.Loading
|
||||
End If
|
||||
@@ -433,23 +528,34 @@
|
||||
End If
|
||||
RunInThread(AddressOf Update)
|
||||
End Sub
|
||||
Public Overrides Sub Abort()
|
||||
Public Overrides Sub Cancel()
|
||||
'改变状态
|
||||
SyncLock LockState
|
||||
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
|
||||
State = LoadState.Aborted
|
||||
State = LoadState.Canceled
|
||||
Else
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
End SyncLock
|
||||
RunInThread(
|
||||
Sub()
|
||||
'中断加载器
|
||||
For Each Loader In Loaders
|
||||
Loader.Abort()
|
||||
Loader.Cancel()
|
||||
Next
|
||||
End Sub)
|
||||
End Sub
|
||||
Public Overrides Sub Failed(Ex As Exception)
|
||||
[Error] = Ex '先设置错误再调整状态，防止父加载器获取不到异常
|
||||
SyncLock LockState
|
||||
If State >= LoadState.Finished Then Return
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
For Each Loader In Loaders
|
||||
Loader.Cancel()
|
||||
Next
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 子任务状态变更。
|
||||
@@ -464,38 +570,29 @@
|
||||
Case LoadState.Finished
|
||||
'正常结束，触发刷新
|
||||
Update()
|
||||
Case LoadState.Aborted
|
||||
Case LoadState.Canceled
|
||||
'被中断，这个任务也中断
|
||||
Abort()
|
||||
Case Else
|
||||
Cancel()
|
||||
Case LoadState.Failed
|
||||
'完蛋，出错了
|
||||
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
|
||||
Failed(New Exception(Loader.Name & "失败", Loader.Error))
|
||||
End Select
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 触发一次更新，以启动新加载器或完成。
|
||||
''' </summary>
|
||||
Private Sub Update()
|
||||
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
|
||||
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Canceled Then Return
|
||||
Dim IsFinished As Boolean = True
|
||||
Dim Blocked 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.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
|
||||
'检查 LoaderTask 是否需要重启
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name)
|
||||
Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
|
||||
GoTo Restart
|
||||
End If
|
||||
'更新下一个加载器的输入
|
||||
@@ -504,10 +601,10 @@
|
||||
'如果不让继续启动，且已有加载器正在加载中，就不继续启动
|
||||
If Loader.Block AndAlso Not IsFinished Then Blocked = True
|
||||
Case LoadState.Loading
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
|
||||
'检查 LoaderTask 是否需要重启
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
|
||||
Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
|
||||
GoTo Restart
|
||||
End If
|
||||
End If
|
||||
@@ -521,13 +618,14 @@ Restart:
|
||||
If Blocked Then Continue For
|
||||
If Input IsNot Nothing Then
|
||||
'若输入类型与下一个加载器相同才继续
|
||||
Dim LoaderType As String = Loader.GetType.Name
|
||||
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) OrElse GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderCombo(Of ))) Then
|
||||
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
|
||||
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
|
||||
ElseIf TypeOf Loader Is LoaderWorker Then
|
||||
Loader.Start(IsForceRestart:=IsForceRestarting)
|
||||
ElseIf TypeOf Loader Is LoaderDownload Then
|
||||
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
|
||||
Else
|
||||
Throw New Exception("未知的加载器类型（" & LoaderType & "）")
|
||||
Throw New Exception("未知的加载器类型（" & Loader.GetType.Name & "）")
|
||||
End If
|
||||
Else
|
||||
Loader.Start(IsForceRestart:=IsForceRestarting)
|
||||
@@ -550,7 +648,7 @@ Restart:
|
||||
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.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
|
||||
If GeneralUtils.IsGenericInstanceOf(SubLoader, GetType(LoaderCombo(Of ))) Then GetLoaderList(SubLoader, List)
|
||||
Next
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -571,31 +669,26 @@ Restart:
|
||||
End Class
|
||||
|
||||
'任务栏进度条
|
||||
Public LoaderTaskbar As New SafeList(Of LoaderBase)
|
||||
Public LoaderTaskbar As New ConcurrentList(Of LoaderBase)
|
||||
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
|
||||
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
|
||||
|
||||
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
|
||||
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
|
||||
LoaderTaskbar.Add(Loader)
|
||||
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
|
||||
Logger.Info($"{Loader.Name} 已加入任务列表")
|
||||
End Sub
|
||||
Public Sub LoaderTaskbarProgressRefresh()
|
||||
Try
|
||||
Dim NewState As Shell.TaskbarItemProgressState
|
||||
Dim NewProgress As Double = LoaderTaskbarProgressGet()
|
||||
'检查任务是否完成，若完成则移除
|
||||
'外显任务是否已经全部完成
|
||||
Dim IsAllDownloadTaskCompleted As Boolean = True
|
||||
For Each Loader In LoaderTaskbar.ToList()
|
||||
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
|
||||
Next
|
||||
'若单个任务已中止或全部任务已完成，则刷新并移除
|
||||
For Each Task In LoaderTaskbar.ToList()
|
||||
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
|
||||
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
|
||||
'若单个任务已中止，或全部任务已完成，则刷新并移除
|
||||
For Each Task In LoaderTaskbar
|
||||
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
|
||||
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Canceled) Then
|
||||
FrmSpeedLeft?.TaskRefresh(Task)
|
||||
LoaderTaskbar.Remove(Task)
|
||||
Log($"[Taskbar] {Task.Name} 已移出任务列表")
|
||||
Logger.Info($"{Task.Name} 已移出任务列表")
|
||||
End If
|
||||
Next
|
||||
'更新平滑后的进度
|
||||
@@ -620,15 +713,15 @@ Restart:
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新任务栏进度显示失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "刷新任务栏进度显示失败")
|
||||
End Try
|
||||
End Sub
|
||||
Public Function LoaderTaskbarProgressGet() As Double
|
||||
Try
|
||||
If Not LoaderTaskbar.Where(Function(l) l.Show).Any Then Return 1
|
||||
Return MathClamp(LoaderTaskbar.Where(Function(l) l.Show).Select(Function(l) l.Progress).Average(), 0, 1)
|
||||
If Not LoaderTaskbar.Any Then Return 1
|
||||
Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
|
||||
Logger.Error(ex, "获取任务栏进度出错")
|
||||
Return 0.5
|
||||
End Try
|
||||
End Function
|
||||
@@ -656,11 +749,10 @@ Restart:
|
||||
''' </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)
|
||||
Dim FolderInfo = DirectoryUtils.GetInfo(FolderPath & ExtraPath)
|
||||
Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
|
||||
'如果已经检查过，则跳过
|
||||
If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
|
||||
@@ -672,7 +764,7 @@ Restart:
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "文件夹加载器启动检测出错")
|
||||
Logger.Warn(ex, "文件夹加载器启动检测出错")
|
||||
End Try
|
||||
'写入检查数据
|
||||
LoaderFolderDictionary(Loader) = Value
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
'提供不同的输入验证方法，名称以 Validate 开头
|
||||
'提供不同的输入验证方法，名称以 Validate 开头
|
||||
Public Module ModValidate
|
||||
|
||||
''' <summary>
|
||||
@@ -66,6 +66,20 @@ Public Class ValidateNullOrWhiteSpace
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 自定义的 Validate。
|
||||
''' </summary>
|
||||
Public Class ValidateFunc
|
||||
Inherits Validate
|
||||
Private ReadOnly _func As Func(Of String, String)
|
||||
Public Sub New(F As Func(Of String, String))
|
||||
_func = F
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
Return _func(Str)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 必须满足正则表达式。
|
||||
''' </summary>
|
||||
@@ -80,7 +94,7 @@ Public Class ValidateRegex
|
||||
Me.ErrorDescription = ErrorDescription
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
If Not RegexCheck(Str, Regex) Then Return ErrorDescription
|
||||
If Not Str.RegexCheck(Regex) Then Return ErrorDescription
|
||||
Return ""
|
||||
End Function
|
||||
End Class
|
||||
@@ -94,7 +108,7 @@ Public Class ValidateHttp
|
||||
End Sub '用于 XAML 初始化
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
|
||||
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效！"
|
||||
If Not Str.RegexCheck("^(http[s]?)\://") Then Return "输入的网址无效！"
|
||||
Return ""
|
||||
End Function
|
||||
End Class
|
||||
@@ -114,10 +128,10 @@ Public Class ValidateInteger
|
||||
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 & "！"
|
||||
Dim Valed As Integer
|
||||
If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数！"
|
||||
If Valed > Max Then Return "不可超过 " & Max & "！"
|
||||
If Valed < Min Then Return "不可低于 " & Min & "！"
|
||||
Return ""
|
||||
End Function
|
||||
End Class
|
||||
@@ -148,7 +162,7 @@ End Class
|
||||
''' </summary>
|
||||
Public Class ValidateExcept
|
||||
Inherits Validate
|
||||
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
|
||||
Public Property Excepts As New ObjectModel.Collection(Of String)
|
||||
Public Property ErrorMessage As String
|
||||
Public Sub New()
|
||||
ErrorMessage = "输入内容不能包含 %"
|
||||
@@ -157,12 +171,15 @@ Public Class ValidateExcept
|
||||
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
|
||||
Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
|
||||
Me.New(
|
||||
New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
|
||||
ErrorMessage)
|
||||
End Sub
|
||||
Public Sub New(Excepts As IEnumerable(Of Char), Optional ErrorMessage As String = "输入内容不能包含 %")
|
||||
Me.New(
|
||||
New ObjectModel.Collection(Of String)(Excepts.Select(Function(c) c.ToString).ToList),
|
||||
ErrorMessage)
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
For Each Ch As String In Excepts
|
||||
@@ -181,7 +198,7 @@ End Class
|
||||
''' </summary>
|
||||
Public Class ValidateExceptSame
|
||||
Inherits Validate
|
||||
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
|
||||
Public Property Excepts As New ObjectModel.Collection(Of String)
|
||||
Public Property ErrorMessage As String
|
||||
Public Property IgnoreCase As Boolean = False
|
||||
Public Sub New()
|
||||
@@ -191,19 +208,21 @@ Public Class ValidateExceptSame
|
||||
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
|
||||
Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
|
||||
Me.New(
|
||||
New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
|
||||
ErrorMessage, IgnoreCase)
|
||||
End Sub
|
||||
Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
|
||||
Me.New(
|
||||
New ObjectModel.Collection(Of String) From {Except},
|
||||
ErrorMessage, 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)
|
||||
If Str.Lower = Ch.Lower Then Return ErrorMessage.Replace("%", Ch)
|
||||
Else
|
||||
If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写
|
||||
End If
|
||||
@@ -213,23 +232,44 @@ Public Class ValidateExceptSame
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 必须为特定字符串。
|
||||
''' </summary>
|
||||
Public Class ValidateSame
|
||||
Inherits Validate
|
||||
Public Property Required As String
|
||||
Public Property ErrorMessage As String
|
||||
Public Property IgnoreCase As Boolean = False
|
||||
Public Sub New()
|
||||
End Sub
|
||||
Public Sub New(Required As String, Optional ErrorMessage As String = "输入内容有误", Optional IgnoreCase As Boolean = False)
|
||||
Me.Required = Required
|
||||
Me.ErrorMessage = ErrorMessage
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
Return If(String.Compare(Str, Required, IgnoreCase) = 0, "", ErrorMessage)
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 对文件夹名的粗略的特化检测。
|
||||
''' </summary>
|
||||
Public Class ValidateFolderName
|
||||
Inherits Validate
|
||||
Public Property Path As String
|
||||
Public Property Folder As String
|
||||
Public Property UseMinecraftCharCheck As Boolean = True
|
||||
Public Property IgnoreCase As Boolean = True
|
||||
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
|
||||
Private ReadOnly PathIgnore As IEnumerable(Of String)
|
||||
Public Sub New()
|
||||
End Sub
|
||||
Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
|
||||
Me.Path = Path
|
||||
Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
|
||||
Me.Folder = Folder
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
|
||||
On Error Resume Next
|
||||
PathIgnore = New DirectoryInfo(Path).EnumerateDirectories
|
||||
PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
Try
|
||||
@@ -245,25 +285,25 @@ Public Class ValidateFolderName
|
||||
'检查尾部小数点
|
||||
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾！"
|
||||
'检查特殊字符
|
||||
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str)
|
||||
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str)
|
||||
If 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"}, "文件夹名不可为 %！", True).Validate(Str)
|
||||
If InvalidStrCheck <> "" Then Return InvalidStrCheck
|
||||
'检查 NTFS 8.3 文件名（#4505）
|
||||
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
|
||||
If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
|
||||
'检查文件夹重名
|
||||
Dim Arr As New List(Of String)
|
||||
If PathIgnore IsNot Nothing Then
|
||||
For Each Folder As DirectoryInfo In PathIgnore
|
||||
Arr.Add(Folder.Name)
|
||||
For Each FolderPath In PathIgnore
|
||||
Arr.Add(PathUtils.GetLastPart(FolderPath))
|
||||
Next
|
||||
End If
|
||||
Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
|
||||
If Not SameNameCheck = "" Then Return SameNameCheck
|
||||
Return ""
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查文件夹名出错")
|
||||
Logger.Warn(ex, "检查文件夹名出错")
|
||||
Return "错误：" & ex.Message
|
||||
End Try
|
||||
End Function
|
||||
@@ -300,16 +340,16 @@ Public Class ValidateFileName
|
||||
'检查尾部小数点
|
||||
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾！"
|
||||
'检查特殊字符
|
||||
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符！").Validate(Str)
|
||||
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符！").Validate(Str)
|
||||
If 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"}, "文件名不可为 %！", True).Validate(Str)
|
||||
If InvalidStrCheck <> "" Then Return InvalidStrCheck
|
||||
'检查 NTFS 8.3 文件名（#4505）
|
||||
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
|
||||
If Str.RegexCheck(".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
|
||||
'检查文件重名
|
||||
If ParentFolder IsNot Nothing Then
|
||||
Dim DirInfo As New DirectoryInfo(ParentFolder)
|
||||
Dim DirInfo = DirectoryUtils.GetInfo(ParentFolder)
|
||||
If DirInfo.Exists Then
|
||||
Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
|
||||
"不可与现有文件重名！", IgnoreCase).Validate(Str)
|
||||
@@ -320,7 +360,7 @@ Public Class ValidateFileName
|
||||
End If
|
||||
Return ""
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查文件名出错")
|
||||
Logger.Warn(ex, "检查文件名出错")
|
||||
Return "错误：" & ex.Message
|
||||
End Try
|
||||
End Function
|
||||
@@ -349,9 +389,10 @@ Public Class ValidateFolderPath
|
||||
If LengthCheck <> "" Then Return LengthCheck
|
||||
'检查开头
|
||||
If Str.StartsWithF("\\Mac\") Then GoTo Fin
|
||||
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
|
||||
If Str.ToUpper = Drive.Name Then Return ""
|
||||
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
|
||||
For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
|
||||
Dim DriveName As String = Drive.Upper.First & ":\"
|
||||
If Str.Upper = DriveName Then Return ""
|
||||
If Str.StartsWithF(DriveName, True) Then GoTo Fin
|
||||
Next
|
||||
Return "文件夹路径头存在错误！"
|
||||
Fin:
|
||||
@@ -362,7 +403,7 @@ Fin:
|
||||
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)
|
||||
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符！").Validate(SubStr)
|
||||
If Not CharactCheck = "" Then Return CharactCheck
|
||||
'检查头部空格
|
||||
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头！"
|
||||
@@ -373,7 +414,7 @@ Fin:
|
||||
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
|
||||
'检查 NTFS 8.3 文件名（#4505）
|
||||
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
|
||||
If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
|
||||
Next
|
||||
Return ""
|
||||
End Function
|
||||
|
||||
@@ -1,14 +1,9 @@
|
||||
'一个万能的自动图片类型转换工具类
|
||||
'一个万能的自动图片类型转换工具类
|
||||
|
||||
Imports System.Drawing.Imaging
|
||||
|
||||
Public Class MyBitmap
|
||||
|
||||
''' <summary>
|
||||
''' 位图缓存。
|
||||
''' </summary>
|
||||
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
|
||||
|
||||
''' <summary>
|
||||
''' 存储的图片
|
||||
''' </summary>
|
||||
@@ -30,14 +25,17 @@ Public Class MyBitmap
|
||||
End Operator
|
||||
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
|
||||
If Image Is Nothing Then Return Nothing
|
||||
Dim Bitmap = Image.Pic
|
||||
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
|
||||
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
|
||||
Dim BitmapPic As System.Drawing.Bitmap = Image.Pic
|
||||
Dim rect = New System.Drawing.Rectangle(0, 0, BitmapPic.Width, BitmapPic.Height)
|
||||
Dim bitmapData = BitmapPic.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
|
||||
Try
|
||||
Dim size = rect.Width * rect.Height * 4
|
||||
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride)
|
||||
Dim Result = BitmapSource.Create(BitmapPic.Width, BitmapPic.Height, BitmapPic.HorizontalResolution, BitmapPic.VerticalResolution,
|
||||
PixelFormats.Bgra32, Nothing, bitmapData.Scan0,
|
||||
rect.Width * rect.Height * 4, bitmapData.Stride)
|
||||
Result.Freeze()
|
||||
Return Result
|
||||
Finally
|
||||
Bitmap.UnlockBits(bitmapData)
|
||||
BitmapPic.UnlockBits(bitmapData)
|
||||
End Try
|
||||
End Operator
|
||||
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
|
||||
@@ -65,15 +63,16 @@ Public Class MyBitmap
|
||||
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
|
||||
If FilePathOrResourceName.StartsWithF(PathImage) Then
|
||||
'使用缓存
|
||||
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
|
||||
Pic = BitmapCache(FilePathOrResourceName).Pic
|
||||
Static Cache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
|
||||
If Cache.ContainsKey(FilePathOrResourceName) Then
|
||||
Pic = Cache(FilePathOrResourceName).Pic
|
||||
Else
|
||||
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
|
||||
BitmapCache.TryAdd(FilePathOrResourceName, Pic)
|
||||
Cache.TryAdd(FilePathOrResourceName, Pic)
|
||||
End If
|
||||
Else
|
||||
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
|
||||
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
|
||||
Using InputStream = FileUtils.ReadAsStream(FilePathOrResourceName)
|
||||
'判断是否为 WebP 文件头
|
||||
Dim Header(1) As Byte
|
||||
InputStream.Read(Header, 0, 2)
|
||||
@@ -92,9 +91,13 @@ Public Class MyBitmap
|
||||
Pic = My.Application.TryFindResource(FilePathOrResourceName)
|
||||
If Pic Is Nothing Then
|
||||
Pic = New System.Drawing.Bitmap(1, 1)
|
||||
Throw New Exception($"加载 MyBitmap 失败（{FilePathOrResourceName}）", ex)
|
||||
If TypeOf ex Is ArgumentException Then
|
||||
Throw New Exception($"图片格式不支持，或图片文件损坏（{FilePathOrResourceName}）", ex)
|
||||
Else
|
||||
Throw New Exception($"加载 MyBitmap 意外失败（{FilePathOrResourceName}）", ex)
|
||||
End If
|
||||
Else
|
||||
Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", LogLevel.Developer)
|
||||
Logger.Warn(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）")
|
||||
Exit Try
|
||||
End If
|
||||
End Try
|
||||
@@ -123,9 +126,7 @@ Public Class MyBitmap
|
||||
End Sub
|
||||
Private Class WebPDecoder '将代码隔离在另外一个类中，这样只要不调用这个方法就不会加载 Imazen.WebP.dll
|
||||
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
|
||||
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
|
||||
Dim Decoder As New Imazen.WebP.SimpleDecoder()
|
||||
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
|
||||
Return New Imazen.WebP.SimpleDecoder().DecodeFromBytes(Bytes, Bytes.Length)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
@@ -159,7 +160,7 @@ Public Class MyBitmap
|
||||
Public Sub Save(FilePath As String)
|
||||
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
|
||||
encoder.Frames.Add(BitmapFrame.Create(Me))
|
||||
Using fileStream As New FileStream(FilePath, FileMode.Create)
|
||||
Using fileStream = FileUtils.CreateAsStream(FilePath)
|
||||
encoder.Save(fileStream)
|
||||
End Using
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,54 @@
|
||||
Public Class PclLogger
|
||||
Inherits FileLogger
|
||||
|
||||
''' <inheritdoc/>
|
||||
Public Overrides Function Format(Text As String, Level As LogLevel, FilePath As String, Ex As Exception) As String
|
||||
Text = MyBase.Format(Text, Level, FilePath, Ex)
|
||||
Text = FilterUserName(FilterAccessToken(Text, "*"c), "*"c)
|
||||
Return Text
|
||||
End Function
|
||||
|
||||
''' <inheritdoc/>
|
||||
Public Overrides Sub HandleBehavior(RawMessage As String, FormattedMessage As String, Behavior As LogBehavior, Ex As Exception)
|
||||
If IsProgramEnding Then Return
|
||||
MyBase.HandleBehavior(RawMessage, FormattedMessage, Behavior, Ex)
|
||||
Dim BriefText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(False))
|
||||
BriefText = FilterUserName(FilterAccessToken(BriefText, "*"c), "*"c)
|
||||
Dim DetailText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(True))
|
||||
DetailText = FilterUserName(FilterAccessToken(DetailText, "*"c), "*"c)
|
||||
Select Case Behavior
|
||||
Case LogBehavior.None
|
||||
'啥也不干
|
||||
Case LogBehavior.ToastIfDebug
|
||||
If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & BriefText, HintType.Blue, False)
|
||||
Case LogBehavior.Toast
|
||||
Hint(BriefText, HintType.Red, False)
|
||||
Case LogBehavior.Alert
|
||||
MyMsgBox(DetailText, "错误", IsWarn:=True)
|
||||
Case LogBehavior.AlertThenFeedback
|
||||
If PageSetupSystem.IsLauncherNewest Then
|
||||
If MyMsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", "错误", "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
|
||||
Else
|
||||
MyMsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", "错误", IsWarn:=True)
|
||||
End If
|
||||
Case LogBehavior.AlertThenCrash
|
||||
Static FirstTrigger As Boolean = True
|
||||
If FirstTrigger Then
|
||||
'首次触发
|
||||
FirstTrigger = False
|
||||
If PageSetupSystem.IsLauncherNewest Then
|
||||
If MsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, "错误") = MsgBoxResult.Yes Then Feedback(False, True)
|
||||
Else
|
||||
MsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, "错误")
|
||||
End If
|
||||
Else
|
||||
'多次触发，直接使程序崩溃（这通常代表着在其他线程循环触发严重异常）
|
||||
Thread.Sleep(2000)
|
||||
End If
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Exception)
|
||||
End Select
|
||||
'遥测
|
||||
If Behavior >= LogBehavior.Toast Then Telemetry("错误日志", "Exception", DetailText)
|
||||
End Sub
|
||||
|
||||
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
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
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
Public Module ModWatcher
|
||||
Public Module ModWatcher
|
||||
|
||||
'对全体的监视
|
||||
Public McWatcherList As New List(Of Watcher)
|
||||
@@ -15,7 +15,7 @@
|
||||
TriggerLauncherShutdown = False
|
||||
End If
|
||||
Next
|
||||
If IsWatcherRunning = IsRunning Then Exit Sub
|
||||
If IsWatcherRunning = IsRunning Then Return
|
||||
IsWatcherRunning = IsRunning
|
||||
If IsWatcherRunning Then
|
||||
MinecraftStart()
|
||||
@@ -33,13 +33,13 @@
|
||||
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] 已根据设置，在结束后暂停音乐播放"))
|
||||
If Settings.Get(Of Boolean)("UiMusicStop") Then
|
||||
RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置，在结束后开始音乐播放"))
|
||||
ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
|
||||
RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置，在结束后暂停音乐播放"))
|
||||
End If
|
||||
'启动器可见性
|
||||
Select Case Setup.Get("LaunchArgumentVisible")
|
||||
Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
|
||||
Case 2
|
||||
'直接关闭
|
||||
If TriggerLauncherShutdown Then
|
||||
@@ -58,13 +58,13 @@
|
||||
|
||||
'初始化
|
||||
Public GameProcess As Process
|
||||
Public Version As McVersion
|
||||
Public Instance As McInstance
|
||||
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)
|
||||
Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
|
||||
Me.Loader = Loader
|
||||
Me.Version = Version
|
||||
Me.Instance = Instance
|
||||
Me.WindowTitle = WindowTitle
|
||||
Me.PID = Loader.Input.Id
|
||||
WatcherLog("开始 Minecraft 日志监控")
|
||||
@@ -81,7 +81,7 @@
|
||||
WatcherStateChanged()
|
||||
|
||||
'初始化进程与日志读取
|
||||
Me.GameProcess = Loader.Input
|
||||
GameProcess = Loader.Input
|
||||
GameProcess.BeginOutputReadLine()
|
||||
GameProcess.BeginErrorReadLine()
|
||||
AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived
|
||||
@@ -91,13 +91,13 @@
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Canceled
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
For i = 1 To 3
|
||||
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
|
||||
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
|
||||
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy'/'M'/'d")).Replace("{time}", Date.Now.ToString("HH':'mm':'ss"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
@@ -105,7 +105,7 @@
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
Logger.Error(ex, "Minecraft 日志监控主循环出错")
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
@@ -118,7 +118,7 @@
|
||||
Return _State
|
||||
End Get
|
||||
Set(value As MinecraftState)
|
||||
If _State = value Then Exit Property
|
||||
If _State = value Then Return
|
||||
_State = value
|
||||
WatcherStateChanged()
|
||||
End Set
|
||||
@@ -144,7 +144,7 @@
|
||||
'输出文本
|
||||
Dim Copyed As New List(Of String)
|
||||
SyncLock WaitingLogLock
|
||||
If Not WaitingLog.Any() Then Exit Sub
|
||||
If Not WaitingLog.Any() Then Return
|
||||
Copyed = WaitingLog
|
||||
WaitingLog = New List(Of String)(1000)
|
||||
End SyncLock
|
||||
@@ -162,11 +162,11 @@
|
||||
'Else
|
||||
If State = MinecraftState.Loading Then
|
||||
'窗口未出现
|
||||
WatcherLog("Minecraft 尚未加载完成，可能已崩溃")
|
||||
WatcherLog("Minecraft 尚未加载完成，可能已崩溃", LogLevel.Error)
|
||||
Crashed()
|
||||
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then
|
||||
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then
|
||||
'返回值不为 0 且未结束
|
||||
WatcherLog("Minecraft 返回值异常，可能已崩溃")
|
||||
WatcherLog("Minecraft 返回值异常，可能已崩溃", LogLevel.Error)
|
||||
Crashed()
|
||||
ElseIf State <> MinecraftState.Crashed Then
|
||||
'正常关闭
|
||||
@@ -174,17 +174,19 @@
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "输出 Minecraft 日志失败")
|
||||
End Try
|
||||
End Sub
|
||||
Public LatestLog As New Queue(Of String)
|
||||
Public LatestLog As New ConcurrentQueue(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)
|
||||
If Text Is Nothing Then Return
|
||||
Text = Text.ReplaceLineEndings(vbCrLf)
|
||||
'If Text.Contains("�����") Then Hint("检测到错误的日志编码：" & Text)
|
||||
'加入预存储
|
||||
LatestLog.Enqueue(Text)
|
||||
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
|
||||
If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
|
||||
Logger.Trace(Text)
|
||||
'进度处理
|
||||
If LogProgress < 1 Then
|
||||
WatcherLog("日志 1/5：已出现日志输出")
|
||||
@@ -193,7 +195,7 @@
|
||||
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
|
||||
WatcherLog("日志 2/5：游戏用户已设置") '仅确保支持 Minecraft 1.7+
|
||||
LogProgress = 2
|
||||
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
|
||||
ElseIf LogProgress < 3 AndAlso Text.ContainsIgnoreCase("lwjgl version") Then
|
||||
WatcherLog("日志 3/5：LWJGL 版本已确认")
|
||||
LogProgress = 3
|
||||
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
|
||||
@@ -213,15 +215,15 @@
|
||||
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)
|
||||
WatcherLog("识别为崩溃的 Log：" & Text, LogLevel.Error)
|
||||
Crashed()
|
||||
ElseIf Text.Contains("Could not save crash report to") Then
|
||||
'Minecraft 崩溃，无法保存崩溃日志
|
||||
WatcherLog("识别为崩溃的 Log：" & Text)
|
||||
WatcherLog("识别为崩溃的 Log：" & Text, LogLevel.Error)
|
||||
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)
|
||||
WatcherLog("识别为崩溃的 Log：" & Text, LogLevel.Error)
|
||||
Crashed()
|
||||
'ElseIf Text.Contains("Shutdown failure!") Then
|
||||
' 'Minecraft 强行崩溃，由于点 X 强行关闭也会触发这句话，所以不可用
|
||||
@@ -229,8 +231,8 @@
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Private Sub WatcherLog(Text As String)
|
||||
McLaunchLog("[" & PID & "] " & Text)
|
||||
Private Sub WatcherLog(Text As String, Optional Level As LogLevel = LogLevel.Info)
|
||||
McLaunchLog("[" & PID & "] " & Text, Level)
|
||||
End Sub
|
||||
|
||||
'进度更新
|
||||
@@ -256,27 +258,27 @@
|
||||
Private WindowHandle As IntPtr
|
||||
Private Sub TimerWindow()
|
||||
Try
|
||||
If GameProcess.HasExited Then Exit Sub
|
||||
If IsWindowFinished Then Exit Sub
|
||||
If GameProcess.HasExited Then Return
|
||||
If IsWindowFinished Then Return
|
||||
'获取全部窗口，检查是否有新增的
|
||||
Dim MinecraftWindow As KeyValuePair(Of IntPtr, String)? = Nothing
|
||||
Try
|
||||
MinecraftWindow = TryGetMinecraftWindow()
|
||||
Catch ex As ComponentModel.Win32Exception
|
||||
'拒绝访问（#1062）
|
||||
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogLevel.Hint)
|
||||
Logger.Error(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogBehavior.Toast)
|
||||
IsWindowFinished = True
|
||||
End Try
|
||||
If MinecraftWindow Is Nothing Then Exit Sub
|
||||
If MinecraftWindow Is Nothing Then Return
|
||||
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
|
||||
'已找到窗口
|
||||
If Not MinecraftWindowName.StartsWithF("FML") Then
|
||||
If Not MinecraftWindowName.StartsWithF("FML") AndAlso Not MinecraftWindowName.StartsWithF("Quilt Loader") Then
|
||||
'已找到 Minecraft 窗口
|
||||
WindowHandle = MinecraftWindowHandle
|
||||
WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）")
|
||||
IsWindowFinished = True
|
||||
'最大化
|
||||
If Setup.Get("LaunchArgumentWindowType") = 4 Then
|
||||
If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
@@ -286,17 +288,17 @@
|
||||
ShowWindow(WindowHandle, 3)
|
||||
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
|
||||
Catch ex As Exception
|
||||
Log(ex, "最大化 Minecraft 窗口时出现错误")
|
||||
Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误")
|
||||
End Try
|
||||
End Sub, "MinecraftWindowMaximize")
|
||||
End If
|
||||
ElseIf Not IsWindowAppeared Then
|
||||
'已找到 FML 窗口
|
||||
WatcherLog("FML 窗口已加载：" & MinecraftWindowName & "（" & MinecraftWindowHandle.ToInt64 & "）")
|
||||
'已找到 Mod Loader 窗口
|
||||
WatcherLog("Mod Loader 窗口已加载：" & MinecraftWindowName & "（" & MinecraftWindowHandle.ToInt64 & "）")
|
||||
End If
|
||||
IsWindowAppeared = True
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "检查 Minecraft 窗口失败")
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -304,35 +306,35 @@
|
||||
''' Nothing 代表未找到。
|
||||
''' </summary>
|
||||
Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)?
|
||||
TryGetMinecraftWindow = Nothing
|
||||
Dim Result = Nothing
|
||||
EnumWindows(
|
||||
Sub(hwnd As IntPtr, lParam As Integer)
|
||||
If TryGetMinecraftWindow IsNot Nothing Then Exit Sub
|
||||
If Result IsNot Nothing Then Return
|
||||
'检查类名
|
||||
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
|
||||
If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
|
||||
'获取窗口标题名
|
||||
str = New StringBuilder(512)
|
||||
GetWindowText(hwnd, str, str.Capacity)
|
||||
Dim WindowText As String = str.ToString
|
||||
'有的 Mod 可以修改窗口标题，所以不能检测是否为 Minecraft 打头，这并不准确
|
||||
'部分版本会搞个 GLFW message window 出来所以得反选
|
||||
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
|
||||
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Return
|
||||
'获取窗口关联的进程
|
||||
Dim ProcessId As Integer
|
||||
GetWindowThreadProcessId(hwnd, ProcessId)
|
||||
Try
|
||||
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Exit Sub '需要是此后启动的进程
|
||||
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
|
||||
Catch ex As Exception
|
||||
Log(ex, "枚举 Minecraft 窗口进程失败")
|
||||
Exit Sub
|
||||
Logger.Warn(ex, "枚举 Minecraft 窗口进程失败")
|
||||
Return
|
||||
End Try
|
||||
'返回
|
||||
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
|
||||
Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
|
||||
End Sub, 0)
|
||||
Return TryGetMinecraftWindow
|
||||
Return Result
|
||||
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
|
||||
@@ -344,25 +346,25 @@
|
||||
|
||||
'崩溃处理
|
||||
Private Sub Crashed()
|
||||
If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Exit Sub
|
||||
If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Return
|
||||
State = MinecraftState.Crashed
|
||||
'崩溃分析
|
||||
WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析")
|
||||
Hint("检测到 Minecraft 出现错误，错误分析已开始……")
|
||||
WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析", LogLevel.Error)
|
||||
Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Red)
|
||||
FeedbackInfo()
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Dim Analyzer As New CrashAnalyzer(Instance)
|
||||
Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Analyze()
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
|
||||
{Instance.PathVersion & Instance.Name & ".json", Paths.Base & "PCL\Log1.txt", Paths.Base & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "崩溃分析失败")
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
End Sub
|
||||
@@ -375,7 +377,7 @@
|
||||
If Not GameProcess.HasExited Then GameProcess.Kill()
|
||||
WatcherLog("已强制结束 Minecraft 进程")
|
||||
Catch ex As Exception
|
||||
Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -1,8 +1,6 @@
|
||||
Public Module ModDevelop
|
||||
Public Class ModDevelop
|
||||
|
||||
#If DEBUG Then
|
||||
Public Sub Start()
|
||||
Public Shared Sub Start()
|
||||
End Sub
|
||||
#End If
|
||||
|
||||
End Module
|
||||
End Class
|
||||
|
||||
@@ -1,125 +1,334 @@
|
||||
Public Module ModEvent
|
||||
|
||||
Public Sub TryStartEvent(Type As String, Data As String)
|
||||
If String.IsNullOrWhiteSpace(Type) Then Exit Sub
|
||||
Dim RealData As String() = {""}
|
||||
If Data IsNot Nothing Then RealData = Data.Split("|")
|
||||
StartEvent(Type, RealData)
|
||||
#Region "附加属性"
|
||||
|
||||
''' <summary>
|
||||
''' 用于在 XAML 中初始化列表对象。
|
||||
''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象，因此需要一个包装类，然后在 XAML 中显式初始化。
|
||||
''' </summary>
|
||||
<Markup.ContentProperty("Events")>
|
||||
Public Class CustomEventCollection
|
||||
Implements IEnumerable(Of CustomEvent)
|
||||
Dim _Events As New List(Of CustomEvent)
|
||||
Public ReadOnly Property Events As List(Of CustomEvent)
|
||||
Get
|
||||
Return _Events
|
||||
End Get
|
||||
End Property
|
||||
Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
|
||||
Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
|
||||
End Function
|
||||
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
|
||||
Return DirectCast(Events, IEnumerable).GetEnumerator()
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 提供自定义事件的附加属性。
|
||||
''' </summary>
|
||||
Public Class CustomEventService
|
||||
|
||||
'Events
|
||||
Public Shared ReadOnly EventsProperty As DependencyProperty =
|
||||
DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
|
||||
d.SetValue(EventsProperty, value)
|
||||
End Sub
|
||||
Public Sub StartEvent(Type As String, Data As String())
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
|
||||
If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
|
||||
Return d.GetValue(EventsProperty)
|
||||
End Function
|
||||
|
||||
'EventType
|
||||
Public Shared ReadOnly EventTypeProperty As DependencyProperty =
|
||||
DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
|
||||
d.SetValue(EventTypeProperty, value)
|
||||
End Sub
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
|
||||
Return d.GetValue(EventTypeProperty)
|
||||
End Function
|
||||
|
||||
'EventData
|
||||
Public Shared ReadOnly EventDataProperty As DependencyProperty =
|
||||
DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Sub SetEventData(d As DependencyObject, value As String)
|
||||
d.SetValue(EventDataProperty, value)
|
||||
End Sub
|
||||
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
|
||||
Public Shared Function GetEventData(d As DependencyObject) As String
|
||||
Return d.GetValue(EventDataProperty)
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
Partial Public Module ModMain
|
||||
|
||||
''' <summary>
|
||||
''' 触发该控件上的自定义事件。
|
||||
''' 事件会在新线程中执行。
|
||||
''' </summary>
|
||||
<Runtime.CompilerServices.Extension>
|
||||
Public Sub RaiseCustomEvent(Control As DependencyObject)
|
||||
'收集事件列表
|
||||
Dim Events = CustomEventService.GetEvents(Control).ToList
|
||||
Dim EventType = CustomEventService.GetEventType(Control)
|
||||
If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
|
||||
'执行事件
|
||||
If Not Events.Any Then Return
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
For Each e In Events
|
||||
e.Raise()
|
||||
Next
|
||||
End Sub, "执行自定义事件 " & GetUuid())
|
||||
End Sub
|
||||
|
||||
End Module
|
||||
|
||||
#End Region
|
||||
|
||||
''' <summary>
|
||||
''' 自定义事件。
|
||||
''' </summary>
|
||||
Public Class CustomEvent
|
||||
Inherits DependencyObject
|
||||
|
||||
#Region "属性与触发"
|
||||
|
||||
Public Property Type As EventType
|
||||
Get
|
||||
Dim Value As EventType = EventType.None
|
||||
RunInUiWait(Sub() Value = GetValue(TypeProperty))
|
||||
Return Value
|
||||
End Get
|
||||
Set(value As EventType)
|
||||
SetValue(TypeProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly TypeProperty As DependencyProperty =
|
||||
DependencyProperty.Register("Type", GetType(EventType), GetType(CustomEvent), New PropertyMetadata(EventType.None))
|
||||
|
||||
Public Property Data As String
|
||||
Get
|
||||
Dim Value As String = Nothing
|
||||
RunInUiWait(Sub() Value = GetValue(DataProperty))
|
||||
Return Value
|
||||
End Get
|
||||
Set(value As String)
|
||||
SetValue(DataProperty, value)
|
||||
End Set
|
||||
End Property
|
||||
Public Shared ReadOnly DataProperty As DependencyProperty =
|
||||
DependencyProperty.Register("Data", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
|
||||
|
||||
Public Sub New()
|
||||
End Sub
|
||||
Public Sub New(Type As EventType, Data As String)
|
||||
Me.Type = Type
|
||||
Me.Data = Data
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 在当前线程中触发该自定义事件。
|
||||
''' </summary>
|
||||
Public Sub Raise()
|
||||
Raise(Type, Data)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
Public Enum EventType
|
||||
None = 0
|
||||
打开网页
|
||||
打开文件
|
||||
打开帮助
|
||||
执行命令
|
||||
启动游戏
|
||||
复制文本
|
||||
刷新主页
|
||||
刷新页面
|
||||
刷新帮助
|
||||
今日人品
|
||||
内存优化
|
||||
清理垃圾
|
||||
弹出窗口
|
||||
弹出提示
|
||||
切换页面
|
||||
导入整合包
|
||||
安装整合包
|
||||
下载文件
|
||||
修改设置
|
||||
写入设置
|
||||
修改变量
|
||||
写入变量
|
||||
加入房间
|
||||
检查更新
|
||||
End Enum
|
||||
|
||||
''' <summary>
|
||||
''' 在当前线程中触发一个自定义事件。
|
||||
''' </summary>
|
||||
Public Shared Sub Raise(Type As EventType, Arg As String)
|
||||
If Type = EventType.None Then Return
|
||||
Logger.Info($"执行自定义事件：{Type}, {Arg}")
|
||||
If Arg Is Nothing Then Arg = ""
|
||||
Dim Args As String() = Arg.Split("|")
|
||||
Try
|
||||
Log("[Control] 执行自定义事件：" & Type & ", " & Join(Data, ", "))
|
||||
Select Case Type
|
||||
|
||||
Case "打开网页"
|
||||
Data(0) = Data(0).Replace("\", "/")
|
||||
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议（#2200）
|
||||
Case EventType.打开网页
|
||||
Arg = Arg.Replace("\", "/")
|
||||
If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议（#2200）
|
||||
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序，请将 EventType 改为 打开文件。", "事件执行失败")
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
Hint("正在开启中，请稍候……")
|
||||
OpenWebsite(Data(0))
|
||||
Hint("正在开启，请稍候：" & Arg)
|
||||
RunInThread(Sub() OpenWebsite(Arg))
|
||||
|
||||
Case "打开文件", "打开帮助", "执行命令"
|
||||
Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
|
||||
RunInThread(
|
||||
Sub()
|
||||
Try
|
||||
'确认实际路径
|
||||
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
|
||||
Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
|
||||
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
|
||||
Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
|
||||
Logger.Info($"打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
|
||||
'执行
|
||||
If Type = "打开帮助" Then
|
||||
If Type = EventType.打开帮助 Then
|
||||
PageOtherHelp.EnterHelpPage(Location)
|
||||
Else
|
||||
If Not Setup.Get("HintCustomCommand") Then
|
||||
Select Case MyMsgBox(
|
||||
"即将执行：" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
|
||||
"请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
|
||||
Case 2
|
||||
Setup.Set("HintCustomCommand", True)
|
||||
Case 3
|
||||
Exit Sub
|
||||
End Select
|
||||
End If
|
||||
If Not EventSafetyConfirm("即将执行：" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
|
||||
Dim Info As New ProcessStartInfo With {
|
||||
.Arguments = If(Data.Length >= 2, Data(1), ""),
|
||||
.Arguments = If(Args.Length >= 2, Args(1), ""),
|
||||
.FileName = Location,
|
||||
.WorkingDirectory = ShortenPath(WorkingDir)
|
||||
.WorkingDirectory = WorkingDir
|
||||
}
|
||||
Process.Start(Info)
|
||||
StartProcess(Info)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
|
||||
Logger.Error(ex, "执行打开类自定义事件失败", LogBehavior.Alert)
|
||||
End Try
|
||||
End Sub)
|
||||
|
||||
Case "启动游戏"
|
||||
If Data(0) = "\current" Then
|
||||
If McVersionCurrent Is Nothing Then
|
||||
Hint("请先选择一个 Minecraft 版本！", HintType.Critical)
|
||||
Exit Sub
|
||||
Case EventType.启动游戏
|
||||
If Args(0) = "\current" Then
|
||||
If McInstanceSelected Is Nothing Then
|
||||
Hint("请先选择一个 Minecraft 版本！", HintType.Red)
|
||||
Return
|
||||
Else
|
||||
Data(0) = McVersionCurrent.Name
|
||||
Args(0) = McInstanceSelected.Name
|
||||
End If
|
||||
End If
|
||||
If McLaunchStart(New McLaunchOptions With
|
||||
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
|
||||
Hint("正在启动 " & Data(0) & "……")
|
||||
RunInUi(
|
||||
Sub()
|
||||
If McLaunchStart(New McLaunchOptions With
|
||||
{.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
|
||||
Hint($"正在启动 {Args(0)}……")
|
||||
End If
|
||||
End Sub)
|
||||
|
||||
Case EventType.复制文本
|
||||
ClipboardSet(Arg)
|
||||
|
||||
Case EventType.刷新主页
|
||||
RunInUi(
|
||||
Sub()
|
||||
FrmLaunchRight.ForceRefresh()
|
||||
If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
|
||||
End Sub)
|
||||
|
||||
Case EventType.刷新页面
|
||||
If TypeOf FrmMain.PageRight Is IRefreshable Then
|
||||
RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
|
||||
If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
|
||||
Else
|
||||
Hint("当前页面不支持刷新操作！", HintType.Red)
|
||||
End If
|
||||
|
||||
Case "复制文本"
|
||||
ClipboardSet(Join(Data, "|"))
|
||||
Case EventType.刷新帮助
|
||||
RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
|
||||
If String.IsNullOrEmpty(Arg) Then Hint("已刷新！", HintType.Green)
|
||||
|
||||
Case "刷新主页"
|
||||
FrmLaunchRight.ForceRefresh()
|
||||
If Data(0) = "" Then Hint("已刷新主页！", HintType.Finish)
|
||||
|
||||
Case "刷新帮助"
|
||||
PageOtherLeft.RefreshHelp()
|
||||
|
||||
Case "今日人品"
|
||||
Case EventType.今日人品
|
||||
PageOtherTest.Jrrp()
|
||||
|
||||
Case "内存优化"
|
||||
Case EventType.内存优化
|
||||
RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
|
||||
|
||||
Case "清理垃圾"
|
||||
Case EventType.清理垃圾
|
||||
RunInThread(Sub() PageOtherTest.RubbishClear())
|
||||
|
||||
Case "弹出窗口"
|
||||
MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
|
||||
Case EventType.弹出窗口
|
||||
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 弹窗标题|弹窗内容")
|
||||
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
|
||||
|
||||
Case "切换页面"
|
||||
FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
|
||||
Case EventType.弹出提示
|
||||
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Args(1))))
|
||||
|
||||
Case "导入整合包", "安装整合包"
|
||||
Case EventType.切换页面
|
||||
RunInUi(Sub() FrmMain.PageChange(
|
||||
EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
|
||||
If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
|
||||
|
||||
Case EventType.导入整合包, EventType.安装整合包
|
||||
RunInUi(Sub() ModpackInstall())
|
||||
|
||||
Case "下载文件"
|
||||
Data(0) = Data(0).Replace("\", "/")
|
||||
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
|
||||
Case EventType.下载文件
|
||||
Args(0) = Args(0).Replace("\", "/")
|
||||
If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
|
||||
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
|
||||
Exit Sub
|
||||
Return
|
||||
End If
|
||||
Try
|
||||
Select Case Data.Length
|
||||
Case 1
|
||||
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
|
||||
Case 2
|
||||
PageOtherTest.StartCustomDownload(Data(0), Data(1))
|
||||
Case Else
|
||||
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
|
||||
End Select
|
||||
Catch
|
||||
PageOtherTest.StartCustomDownload(Data(0), "未知")
|
||||
End Try
|
||||
If Not EventSafetyConfirm("即将从该网址下载文件：" & vbCrLf & Args(0)) Then Return
|
||||
RunInUi(
|
||||
Sub()
|
||||
Try
|
||||
Select Case Args.Length
|
||||
Case 1
|
||||
PageOtherTest.StartCustomDownload(Args(0), PathUtils.GetLastPart(Args(0)))
|
||||
Case 2
|
||||
PageOtherTest.StartCustomDownload(Args(0), Args(1))
|
||||
Case Else
|
||||
PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
|
||||
End Select
|
||||
Catch
|
||||
PageOtherTest.StartCustomDownload(Args(0), "未知")
|
||||
End Try
|
||||
End Sub)
|
||||
|
||||
Case EventType.修改设置, EventType.写入设置
|
||||
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 UiLauncherTransparent|400")
|
||||
Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
|
||||
If Args.Length = 2 Then Hint($"已写入设置：{Args(0)} → {Args(1)}", HintType.Green)
|
||||
|
||||
Case EventType.修改变量, EventType.写入变量
|
||||
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数，例如 VariableName|SomeValue")
|
||||
WriteReg("CustomEvent" & Args(0), Args(1))
|
||||
If Args.Length = 2 Then Hint($"已写入变量：{Args(0)} → {Args(1)}", HintType.Green)
|
||||
|
||||
Case EventType.加入房间
|
||||
RunInUi(
|
||||
Sub()
|
||||
If String.IsNullOrWhiteSpace(Arg) Then
|
||||
PageLinkMain.Join()
|
||||
Else
|
||||
If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
|
||||
PageLinkMain.Join(Arg)
|
||||
End If
|
||||
End Sub)
|
||||
|
||||
Case EventType.检查更新
|
||||
UpdateCheckByButton()
|
||||
|
||||
Case Else
|
||||
MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败")
|
||||
End Select
|
||||
Catch ex As Exception
|
||||
Log(ex, "事件执行失败", LogLevel.Msgbox)
|
||||
Logger.Error(ex, $"事件执行失败（{Type}, {Arg}）", LogBehavior.Alert)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -127,7 +336,7 @@
|
||||
''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
|
||||
''' 失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
|
||||
Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
|
||||
|
||||
'网页确认
|
||||
If RelativeUrl.StartsWithF("http", True) Then
|
||||
@@ -137,7 +346,7 @@
|
||||
'获取文件名
|
||||
Dim RawFileName As String
|
||||
Try
|
||||
RawFileName = GetFileNameFromPath(RelativeUrl)
|
||||
RawFileName = PathUtils.GetLastPart(RelativeUrl)
|
||||
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf &
|
||||
@@ -147,7 +356,7 @@
|
||||
End Try
|
||||
'下载文件
|
||||
Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
|
||||
Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp)
|
||||
Logger.Info($"转换网络资源：{RelativeUrl} -> {LocalTemp}")
|
||||
Try
|
||||
NetDownloadByClient(RelativeUrl, LocalTemp)
|
||||
NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
|
||||
@@ -160,33 +369,33 @@
|
||||
End Try
|
||||
RelativeUrl = LocalTemp
|
||||
End If
|
||||
RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
|
||||
RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
|
||||
|
||||
'确认实际路径
|
||||
Dim Location As String, WorkingDir As String = Path & "PCL"
|
||||
Dim Location As String, WorkingDir As String = Paths.Base & "PCL"
|
||||
HelpTryExtract()
|
||||
If RelativeUrl.Contains(":\") Then
|
||||
'绝对路径
|
||||
Location = RelativeUrl
|
||||
Log("[Control] 自定义事件中由绝对路径" & EventType & "：" & Location)
|
||||
ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
|
||||
Logger.Info($"自定义事件中由绝对路径{Type}：{Location}")
|
||||
ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
|
||||
'相对 PCL 文件夹的路径
|
||||
Location = Path & "PCL\" & RelativeUrl
|
||||
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & "：" & Location)
|
||||
ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
|
||||
Location = Paths.Base & "PCL\" & RelativeUrl
|
||||
Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}：{Location}")
|
||||
ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
|
||||
'相对 PCL 本地帮助文件夹的路径
|
||||
Location = Path & "PCL\Help\" & RelativeUrl
|
||||
WorkingDir = Path & "PCL\Help\"
|
||||
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & "：" & Location)
|
||||
ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
|
||||
Location = Paths.Base & "PCL\Help\" & RelativeUrl
|
||||
WorkingDir = Paths.Base & "PCL\Help\"
|
||||
Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}：{Location}")
|
||||
ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
|
||||
'相对 PCL 自带帮助文件夹的路径
|
||||
Location = PathTemp & "Help\" & RelativeUrl
|
||||
WorkingDir = PathTemp & "Help\"
|
||||
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & "：" & Location)
|
||||
ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
|
||||
Logger.Info($"自定义事件中由相对 PCL 自带帮助文件夹的路径{Type}：{Location}")
|
||||
ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
|
||||
'直接使用原有路径启动程序
|
||||
Location = RelativeUrl
|
||||
Log("[Control] 自定义事件中直接" & EventType & "：" & Location)
|
||||
Logger.Info($"自定义事件中直接{Type}：{Location}")
|
||||
Else
|
||||
'打开帮助，但是格式不对劲
|
||||
Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl)
|
||||
@@ -195,4 +404,20 @@
|
||||
Return {Location, WorkingDir}
|
||||
End Function
|
||||
|
||||
End Module
|
||||
''' <summary>
|
||||
''' 弹出安全确认弹窗。返回是否继续执行。
|
||||
''' </summary>
|
||||
Private Shared Function EventSafetyConfirm(Message As String) As Boolean
|
||||
If Settings.Get(Of Boolean)("HintCustomCommand") Then Return True
|
||||
Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
|
||||
Case 1
|
||||
Return True
|
||||
Case 2
|
||||
Settings.Set("HintCustomCommand", True)
|
||||
Return True
|
||||
Case Else
|
||||
Return False
|
||||
End Select
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
Imports System.Windows.Interop
|
||||
Imports System.Collections.ObjectModel
|
||||
Imports System.Windows.Interop
|
||||
Imports System.Windows.Threading
|
||||
|
||||
Public Module ModMain
|
||||
@@ -7,23 +8,12 @@ Public Module ModMain
|
||||
|
||||
''' <summary>
|
||||
''' 提示信息的种类。
|
||||
''' 该枚举在自定义事件中使用，是公开 API 的一部分。
|
||||
''' </summary>
|
||||
Public Enum HintType
|
||||
''' <summary>
|
||||
''' 信息，通常是蓝色的“i”。
|
||||
''' </summary>
|
||||
''' <remarks></remarks>
|
||||
Info
|
||||
''' <summary>
|
||||
''' 已完成，通常是绿色的“√”。
|
||||
''' </summary>
|
||||
''' <remarks></remarks>
|
||||
Finish
|
||||
''' <summary>
|
||||
''' 错误，通常是红色的“×”。
|
||||
''' </summary>
|
||||
''' <remarks></remarks>
|
||||
Critical
|
||||
Blue
|
||||
Green
|
||||
Red
|
||||
End Enum
|
||||
Private Structure HintMessage
|
||||
Public Text As String
|
||||
@@ -34,29 +24,26 @@ Public Module ModMain
|
||||
''' <summary>
|
||||
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
|
||||
''' </summary>
|
||||
Private HintWaiting As List(Of HintMessage) = If(HintWaiting, New List(Of HintMessage))
|
||||
Private HintWaiting As New ConcurrentQueue(Of HintMessage)
|
||||
''' <summary>
|
||||
''' 在窗口左下角弹出提示文本。
|
||||
''' </summary>
|
||||
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
|
||||
If HintWaiting Is Nothing Then HintWaiting = New List(Of HintMessage)
|
||||
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
|
||||
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
|
||||
HintWaiting.Enqueue(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
|
||||
End Sub
|
||||
|
||||
Private Sub HintTick()
|
||||
Try
|
||||
|
||||
'Tag 存储了：{ 是否可以重用, Uuid }
|
||||
If Not HintWaiting.Any() Then Exit Sub
|
||||
Do While HintWaiting.Any
|
||||
Dim CurrentHint As HintMessage = Nothing
|
||||
Do While HintWaiting.TryDequeue(CurrentHint)
|
||||
''清除空提示
|
||||
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
|
||||
' HintWaiting.RemoveAt(0)
|
||||
' Continue Do
|
||||
'End If
|
||||
Dim CurrentHint = HintWaiting(0)
|
||||
'去回车
|
||||
CurrentHint.Text = CurrentHint.Text.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
|
||||
CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
|
||||
'超量提示直接忽略
|
||||
If FrmMain.PanHint.Children.Count >= 20 Then GoTo EndHint
|
||||
'检查是否有重复提示
|
||||
@@ -68,13 +55,13 @@ Public Module ModMain
|
||||
Dim TargetColor0, TargetColor1 As MyColor
|
||||
Dim Percent As Double = 0.3
|
||||
Select Case CurrentHint.Type
|
||||
Case HintType.Info
|
||||
Case HintType.Blue
|
||||
TargetColor0 = New MyColor(215, 37, 155, 252)
|
||||
TargetColor1 = New MyColor(215, 10, 142, 252)
|
||||
Case HintType.Finish
|
||||
Case HintType.Green
|
||||
TargetColor0 = New MyColor(215, 33, 177, 33)
|
||||
TargetColor1 = New MyColor(215, 29, 160, 29)
|
||||
Case Else 'HintType.Critical
|
||||
Case Else 'HintType.Red
|
||||
TargetColor0 = New MyColor(215, 255, 53, 11)
|
||||
TargetColor1 = New MyColor(215, 255, 43, 0)
|
||||
End Select
|
||||
@@ -82,7 +69,7 @@ Public Module ModMain
|
||||
'有重复提示，且该提示的进入动画已播放
|
||||
If Not AniIsRun("Hint Show " & DoubleStack.Tag(1)) Then
|
||||
AniStop("Hint Hide " & DoubleStack.Tag(1))
|
||||
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
|
||||
Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
|
||||
AniStart({
|
||||
AaX(DoubleStack, -12 - DoubleStack.Margin.Left, 50,, New AniEaseOutFluent),
|
||||
AaX(DoubleStack, -8, 50, 50, New AniEaseInFluent),
|
||||
@@ -133,7 +120,7 @@ Public Module ModMain
|
||||
})
|
||||
AniStart(Animations, "Hint Show " & NewHintControl.Tag(1))
|
||||
'结束动画
|
||||
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
|
||||
Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
|
||||
AniStart({
|
||||
AaX(NewHintControl, -50, 200, Delay, New AniEaseInFluent),
|
||||
AaOpacity(NewHintControl, -1, 150, Delay),
|
||||
@@ -144,11 +131,10 @@ Public Module ModMain
|
||||
End If
|
||||
'结束处理
|
||||
EndHint:
|
||||
If CurrentHint.Log Then Log("[UI] 弹出提示：" & CurrentHint.Text)
|
||||
HintWaiting.RemoveAt(0)
|
||||
If CurrentHint.Log Then Logger.Info($"弹出提示：{CurrentHint.Text}")
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Log(ex, "显示弹出提示失败", LogLevel.Normal)
|
||||
Logger.Info(ex, "显示弹出提示失败")
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub HideAllHint()
|
||||
@@ -177,14 +163,14 @@ EndHint:
|
||||
Public Text As String
|
||||
''' <summary>
|
||||
''' 输入模式：文本框的文本。
|
||||
''' 选择模式：需要放进去的 List(Of MyListItem)。
|
||||
''' 选择模式：需要放进去的 IEnumberable(Of IMyRadio)。
|
||||
''' 登录模式：登录步骤 1 中返回的 JSON。
|
||||
''' </summary>
|
||||
Public Content As Object
|
||||
''' <summary>
|
||||
''' 输入模式：输入验证规则。
|
||||
''' </summary>
|
||||
Public ValidateRules As ObjectModel.Collection(Of Validate)
|
||||
Public ValidateRules As Collection(Of Validate)
|
||||
''' <summary>
|
||||
''' 输入模式：提示文本。
|
||||
''' </summary>
|
||||
@@ -247,18 +233,13 @@ EndHint:
|
||||
Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
If RunInUi() Then
|
||||
'若为 UI 线程，立即执行弹窗刻， 避免快速（连点器）点击时多次弹窗
|
||||
MyMsgBoxTick()
|
||||
End If
|
||||
If Button2.Length > 0 OrElse ForceWait Then
|
||||
'若有多个按钮则开始等待
|
||||
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
|
||||
'主窗体尚未加载，用老土的弹窗来替代
|
||||
WaitingMyMsgBox.Remove(Converter)
|
||||
If Button2.Length > 0 Then
|
||||
Dim RawResult As MsgBoxResult = MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
|
||||
Dim RawResult As MsgBoxResult =
|
||||
MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
|
||||
Select Case RawResult
|
||||
Case MsgBoxResult.Yes
|
||||
Converter.Result = 1
|
||||
@@ -271,20 +252,23 @@ EndHint:
|
||||
MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
|
||||
Converter.Result = 1
|
||||
End If
|
||||
Log("[Control] 主窗体加载完成前出现意料外的等待弹窗：" & Button1 & "," & Button2 & "," & Button3, LogLevel.Debug)
|
||||
Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗：{Button1},{Button2},{Button3}")
|
||||
Else
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
Try
|
||||
FrmMain.DragStop()
|
||||
If RunInUi() Then MyMsgBoxTick()
|
||||
ComponentDispatcher.PushModal()
|
||||
Dispatcher.PushFrame(Converter.WaitFrame)
|
||||
Finally
|
||||
ComponentDispatcher.PopModal()
|
||||
End Try
|
||||
End If
|
||||
Log("[Control] 普通弹框返回：" & If(Converter.Result, "null"))
|
||||
Logger.Info($"普通弹框返回：{If(Converter.Result, "null")}")
|
||||
Return Converter.Result
|
||||
Else
|
||||
'不进行等待，直接返回
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
Return 1
|
||||
End If
|
||||
End Function
|
||||
@@ -299,19 +283,20 @@ EndHint:
|
||||
''' <param name="Button1">显示的第一个按钮，默认为“确定”。</param>
|
||||
''' <param name="Button2">显示的第二个按钮，默认为“取消”。</param>
|
||||
''' <param name="IsWarn">是否为警告弹窗，若为 True，弹窗配色和背景会变为红色。</param>
|
||||
Public Function MyMsgBoxInput(Title As String, Optional Text As String = "", Optional DefaultInput As String = "", Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
|
||||
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Text = Text, .HintText = HintText, .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
'虽然我也不知道这是啥但是能用就成了 :)
|
||||
Try
|
||||
If FrmMain IsNot Nothing Then FrmMain.DragStop()
|
||||
If RunInUi() Then MyMsgBoxTick()
|
||||
ComponentDispatcher.PushModal()
|
||||
Dispatcher.PushFrame(Converter.WaitFrame)
|
||||
Finally
|
||||
ComponentDispatcher.PopModal()
|
||||
End Try
|
||||
Log("[Control] 输入弹框返回：" & If(Converter.Result, "null"))
|
||||
Logger.Info($"输入弹框返回：{If(Converter.Result, "null")}")
|
||||
Return Converter.Result
|
||||
End Function
|
||||
''' <summary>
|
||||
@@ -321,52 +306,53 @@ EndHint:
|
||||
''' <param name="Button1">显示的第一个按钮，默认为 “确定”。</param>
|
||||
''' <param name="Button2">显示的第二个按钮，默认为空。</param>
|
||||
''' <param name="IsWarn">是否为警告弹窗，若为 True，弹窗配色和背景会变为红色。</param>
|
||||
Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
|
||||
Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
'虽然我也不知道这是啥但是能用就成了 :)
|
||||
Try
|
||||
If FrmMain IsNot Nothing Then FrmMain.DragStop()
|
||||
If RunInUi() Then MyMsgBoxTick()
|
||||
ComponentDispatcher.PushModal()
|
||||
Dispatcher.PushFrame(Converter.WaitFrame)
|
||||
Finally
|
||||
ComponentDispatcher.PopModal()
|
||||
End Try
|
||||
Log("[Control] 选择弹框返回：" & If(Converter.Result, "null"))
|
||||
Logger.Info($"选择弹框返回：{If(Converter.Result, "null")}")
|
||||
Return Converter.Result
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 等待显示的弹窗。
|
||||
''' </summary>
|
||||
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
|
||||
Public WaitingMyMsgBox As New ConcurrentQueue(Of MyMsgBoxConverter)
|
||||
Public Sub MyMsgBoxTick()
|
||||
Try
|
||||
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Exit Sub
|
||||
If FrmMain?.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
|
||||
Dim TargetMsgBox As MyMsgBoxConverter = Nothing
|
||||
If FrmMain.PanMsg.Children.Count > 0 Then
|
||||
'弹窗中
|
||||
FrmMain.PanMsg.Visibility = Visibility.Visible
|
||||
ElseIf WaitingMyMsgBox.Any Then
|
||||
ElseIf WaitingMyMsgBox.TryDequeue(TargetMsgBox) Then
|
||||
'没有弹窗，显示一个等待的弹窗
|
||||
FrmMain.PanMsg.Visibility = Visibility.Visible
|
||||
Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type
|
||||
Select Case TargetMsgBox.Type
|
||||
Case MyMsgBoxType.Input
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgInput(TargetMsgBox))
|
||||
Case MyMsgBoxType.Select
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgSelect(TargetMsgBox))
|
||||
Case MyMsgBoxType.Text
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgText(TargetMsgBox))
|
||||
Case MyMsgBoxType.Login
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgLogin(TargetMsgBox))
|
||||
End Select
|
||||
WaitingMyMsgBox.RemoveAt(0)
|
||||
Else
|
||||
'没有弹窗，没有等待的弹窗
|
||||
If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
|
||||
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "处理等待中的弹窗失败")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -388,21 +374,11 @@ EndHint:
|
||||
Public FrmSpeedRight As PageSpeedRight
|
||||
|
||||
'联机页面声明
|
||||
Public FrmLinkLeft As PageLinkLeft
|
||||
Public FrmLinkIoi As PageLinkIoi
|
||||
Public FrmLinkHiper As PageLinkHiper
|
||||
Public FrmLinkHelp As PageOtherHelpDetail
|
||||
Public FrmLinkFeedback As PageLinkFeedback
|
||||
Public FrmLinkMain As PageLinkMain
|
||||
|
||||
'下载页面声明
|
||||
Public FrmDownloadLeft As PageDownloadLeft
|
||||
Public FrmDownloadInstall As PageDownloadInstall
|
||||
Public FrmDownloadClient As PageDownloadClient
|
||||
Public FrmDownloadOptiFine As PageDownloadOptiFine
|
||||
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
|
||||
Public FrmDownloadForge As PageDownloadForge
|
||||
Public FrmDownloadNeoForge As PageDownloadNeoForge
|
||||
Public FrmDownloadFabric As PageDownloadFabric
|
||||
Public FrmDownloadMod As PageDownloadMod
|
||||
Public FrmDownloadPack As PageDownloadPack
|
||||
Public FrmDownloadDataPack As PageDownloadDataPack
|
||||
@@ -432,15 +408,15 @@ EndHint:
|
||||
Public FrmLoginMsSkin As PageLoginMsSkin
|
||||
|
||||
'版本设置页面声明
|
||||
Public FrmVersionLeft As PageVersionLeft
|
||||
Public FrmVersionOverall As PageVersionOverall
|
||||
Public FrmVersionMod As PageVersionMod
|
||||
Public FrmVersionModDisabled As PageVersionModDisabled
|
||||
Public FrmVersionSetup As PageVersionSetup
|
||||
Public FrmVersionExport As PageVersionExport
|
||||
Public FrmInstanceLeft As PageInstanceLeft
|
||||
Public FrmInstanceOverall As PageInstanceOverall
|
||||
Public FrmInstanceMod As PageInstanceMod
|
||||
Public FrmInstanceModDisabled As PageInstanceModDisabled
|
||||
Public FrmInstanceSetup As PageInstanceSetup
|
||||
Public FrmInstanceExport As PageInstanceExport
|
||||
|
||||
'资源信息分页声明
|
||||
Public FrmDownloadCompDetail As PageDownloadCompDetail
|
||||
Public FrmDownloadResourceDetail As PageDownloadResourceDetail
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -496,7 +472,7 @@ EndHint:
|
||||
''' 是否为 “执行事件”。
|
||||
''' </summary>
|
||||
Public IsEvent As Boolean
|
||||
Public EventType As String
|
||||
Public EventType As CustomEvent.EventType
|
||||
Public EventData As String
|
||||
''' <summary>
|
||||
''' 若非执行事件，其对应的 .xaml 本地文件内容。
|
||||
@@ -510,8 +486,8 @@ EndHint:
|
||||
''' </summary>
|
||||
Public Sub New(FilePath As String)
|
||||
RawPath = FilePath
|
||||
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
|
||||
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
|
||||
If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
|
||||
Dim JsonData As JObject = ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf StringUtils.XmlEscape).DeserializeJson()
|
||||
'加载常规信息
|
||||
If JsonData("Title") IsNot Nothing Then
|
||||
Title = JsonData("Title")
|
||||
@@ -525,19 +501,18 @@ EndHint:
|
||||
ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
|
||||
ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
|
||||
Types = New List(Of String)
|
||||
For Each NameOfType In If(JsonData("Types"), GetJson("[]"))
|
||||
For Each NameOfType In If(JsonData("Types"), New JArray)
|
||||
Types.Add(NameOfType)
|
||||
Next
|
||||
'加载事件信息
|
||||
If If(JsonData("IsEvent"), False) Then
|
||||
EventType = JsonData("EventType")
|
||||
If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
|
||||
EventType = JsonData("EventType").ToObject(Of CustomEvent.EventType)
|
||||
EventData = If(JsonData("EventData"), "")
|
||||
IsEvent = True
|
||||
Else
|
||||
Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml")
|
||||
If File.Exists(XamlAddress) Then
|
||||
XamlContent = ReadFile(XamlAddress)
|
||||
Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
|
||||
If FileUtils.Exists(XamlAddress) Then
|
||||
XamlContent = FileUtils.ReadAsString(XamlAddress)
|
||||
IsEvent = False
|
||||
Else
|
||||
Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件（" & XamlAddress & "）")
|
||||
@@ -556,7 +531,7 @@ EndHint:
|
||||
Public Function SetToListItem(Item As MyListItem) As MyListItem
|
||||
Dim Logo As String
|
||||
If IsEvent Then
|
||||
If EventType = "弹出窗口" Then
|
||||
If EventType = CustomEvent.EventType.弹出窗口 Then
|
||||
Logo = PathImage & "Blocks/GrassPath.png"
|
||||
Else
|
||||
Logo = PathImage & "Blocks/CommandBlock.png"
|
||||
@@ -573,9 +548,9 @@ EndHint:
|
||||
.Height = 42
|
||||
.Type = MyListItem.CheckType.Clickable
|
||||
.Tag = Me
|
||||
.EventType = Nothing
|
||||
.EventData = Nothing
|
||||
End With
|
||||
CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性，它们会被下面的点击事件处理
|
||||
CustomEventService.SetEventData(Item, Nothing)
|
||||
'项目的点击事件
|
||||
AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
|
||||
Return Item
|
||||
@@ -600,44 +575,44 @@ EndHint:
|
||||
Try
|
||||
Dim IgnoreList As New List(Of String)
|
||||
'读取自定义文件
|
||||
If Directory.Exists(Path & "PCL\Help\") Then
|
||||
For Each File In EnumerateFiles(Path & "PCL\Help\")
|
||||
Select Case File.Extension.ToLower
|
||||
Case ".helpignore"
|
||||
If DirectoryUtils.Exists(Paths.Base & "PCL\Help\") Then
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Help\", True)
|
||||
Select Case PathUtils.GetExtension(File)
|
||||
Case "helpignore"
|
||||
'加载忽略列表
|
||||
Log("[Help] 发现 .helpignore 文件：" & File.FullName)
|
||||
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
|
||||
Logger.Info($"发现 .helpignore 文件：{File}")
|
||||
For Each Line In FileUtils.ReadAsLines(File, True)
|
||||
Dim RealString As String = Line.BeforeFirst("#").Trim
|
||||
If String.IsNullOrWhiteSpace(RealString) Then Continue For
|
||||
IgnoreList.Add(RealString)
|
||||
If ModeDebug Then Log("[Help] > " & RealString)
|
||||
Logger.Trace($"> {RealString}")
|
||||
Next
|
||||
Case ".json"
|
||||
FileList.Add(File.FullName)
|
||||
Case "json"
|
||||
FileList.Add(File)
|
||||
End Select
|
||||
Next
|
||||
End If
|
||||
Log("[Help] 已扫描 PCL 文件夹下的帮助文件，目前总计 " & FileList.Count & " 条")
|
||||
Logger.Info($"已扫描 PCL 文件夹下的帮助文件，目前总计 {FileList.Count} 条")
|
||||
'读取自带文件
|
||||
For Each File In EnumerateFiles(PathTemp & "Help")
|
||||
For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
|
||||
'跳过非 json 文件与以 . 开头的文件夹
|
||||
If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
|
||||
If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
|
||||
'检查忽略列表
|
||||
Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
|
||||
Dim RealPath As String = File.Replace(PathTemp & "Help\", "")
|
||||
For Each Ignore In IgnoreList
|
||||
If RegexCheck(RealPath, Ignore) Then
|
||||
If ModeDebug Then Log("[Help] 已忽略 " & RealPath & "：" & Ignore)
|
||||
If RealPath.RegexCheck(Ignore) Then
|
||||
Logger.Trace($"已忽略 {RealPath}：{Ignore}")
|
||||
GoTo NextFile
|
||||
End If
|
||||
Next
|
||||
FileList.Add(File.FullName)
|
||||
FileList.Add(File)
|
||||
NextFile:
|
||||
Next
|
||||
Log("[Help] 已扫描缓存文件夹下的帮助文件，目前总计 " & FileList.Count & " 条")
|
||||
Logger.Info($"已扫描缓存文件夹下的帮助文件，目前总计 {FileList.Count} 条")
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
|
||||
Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
|
||||
End Try
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
If Loader.IsCanceled Then Return
|
||||
|
||||
'将文件实例化
|
||||
Dim Dict As New List(Of HelpEntry)
|
||||
@@ -645,19 +620,19 @@ NextFile:
|
||||
Try
|
||||
Dim Entry As New HelpEntry(FilePath)
|
||||
Dict.Add(Entry)
|
||||
If ModeDebug Then Log("[Help] 已加载的帮助条目：" & Entry.Title & " ← " & FilePath)
|
||||
Logger.Trace($"已加载的帮助条目：{Entry.Title} ← {FilePath}")
|
||||
Catch ex As Exception
|
||||
Log(ex, "初始化帮助条目失败（" & FilePath & "）", LogLevel.Msgbox)
|
||||
Logger.Error(ex, $"初始化帮助条目失败（{FilePath}）", LogBehavior.Alert)
|
||||
End Try
|
||||
Next
|
||||
|
||||
'回设
|
||||
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助；若不需要帮助页面，可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
If Loader.IsCanceled Then Return
|
||||
Loader.Output = Dict
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "帮助列表初始化失败")
|
||||
Logger.Warn(ex, "帮助列表初始化失败")
|
||||
Throw
|
||||
End Try
|
||||
End SyncLock
|
||||
@@ -666,46 +641,46 @@ NextFile:
|
||||
''' 尝试解压内置帮助文件。
|
||||
''' </summary>
|
||||
Public Sub HelpTryExtract()
|
||||
If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
|
||||
DeleteDirectory(PathTemp & "Help")
|
||||
Directory.CreateDirectory(PathTemp & "Help")
|
||||
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
|
||||
ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8)
|
||||
Setup.Set("SystemHelpVersion", VersionCode)
|
||||
Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
|
||||
If Settings.Get(Of Integer)("SystemHelpVersion") <> VersionCode OrElse Not FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
|
||||
DirectoryUtils.Delete(PathTemp & "Help")
|
||||
ExtractResources(PathTemp & "Cache\Help.zip", "Help")
|
||||
FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
|
||||
Settings.Set("SystemHelpVersion", VersionCode)
|
||||
Logger.Info($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp + "Help\启动器\备份设置.xaml")}")
|
||||
End If
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 对帮助文件约定的替换标记进行处理，如果遇到需要转义的字符会进行转义。
|
||||
''' </summary>
|
||||
Public Function HelpArgumentReplace(Xaml As String) As String
|
||||
Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
|
||||
Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
|
||||
Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "愚人节"
|
||||
|
||||
Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1
|
||||
Private _IsAprilEnabled As Boolean? = Nothing
|
||||
Public ReadOnly Property IsAprilEnabled As Boolean
|
||||
Get
|
||||
If _IsAprilEnabled Is Nothing Then
|
||||
_IsAprilEnabled =
|
||||
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
|
||||
Settings.Get(Of Integer)("AprilYear") <> Date.Now.Year '成功后同年内则不再触发
|
||||
End If
|
||||
Return _IsAprilEnabled.Value
|
||||
End Get
|
||||
End Property
|
||||
Public IsAprilGiveup As Boolean = False
|
||||
Private AprilSpeed As New Vector(0, 0)
|
||||
Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
|
||||
Private AprilDistance As Integer = 0
|
||||
Private AprilDifficultiedDistance As Integer = 0
|
||||
Private Sub TimerFool()
|
||||
Try
|
||||
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Exit Sub
|
||||
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Exit Sub
|
||||
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
|
||||
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Return
|
||||
|
||||
'计算是否空闲
|
||||
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
|
||||
If MousePos = AprilMousePosLast Then
|
||||
AprilIdieCount += 1
|
||||
Static IdieCount As Integer = 0
|
||||
Static MousePosLast As New Point(0, 0)
|
||||
If MousePos = MousePosLast Then
|
||||
IdieCount += 1
|
||||
Else
|
||||
AprilMousePosLast = MousePos
|
||||
AprilIdieCount = 0
|
||||
MousePosLast = MousePos
|
||||
IdieCount = 0
|
||||
End If
|
||||
'计算躲避移动
|
||||
Dim Direction As Vector
|
||||
@@ -717,9 +692,11 @@ NextFile:
|
||||
Direction = -Dir
|
||||
Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
|
||||
Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
|
||||
Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度
|
||||
'计算回归移动
|
||||
If AprilIdieCount >= 64 * 5 Then
|
||||
Dim Difficulty As Double = 1 / (1 + (AprilDifficultiedDistance / 6000) ^ 2) + 0.25 '难度，初始为 1.25x，6000 距离为 0.75x，12000 为 0.5x，24000 为 0.256x，最低 0.25x
|
||||
Dim Acc = Math.Max(0, -0.65 - Math.Log((Distance / Difficulty + 0.4) / 200)) * Direction * Difficulty '加速度
|
||||
'FrmMain.Title = CInt(AprilTotalDistance) & " - " & Difficulty
|
||||
'5s 不动时回到起始点
|
||||
If IdieCount >= 64 * 5 Then
|
||||
Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
|
||||
Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
|
||||
If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
|
||||
@@ -729,10 +706,11 @@ NextFile:
|
||||
End If
|
||||
End If
|
||||
'回到边界
|
||||
Static Speed As New Vector(0, 0)
|
||||
Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
|
||||
If Relative.X < -ButtonWidth * 2 Then
|
||||
FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
|
||||
AprilSpeed.X -= 80
|
||||
Speed.X -= 80
|
||||
If Relative.Y < 0 Then
|
||||
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
|
||||
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
|
||||
@@ -740,7 +718,7 @@ NextFile:
|
||||
End If
|
||||
ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
|
||||
FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
|
||||
AprilSpeed.X += 80
|
||||
Speed.X += 80
|
||||
If Relative.Y < 0 Then
|
||||
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
|
||||
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
|
||||
@@ -748,7 +726,7 @@ NextFile:
|
||||
End If
|
||||
ElseIf Relative.Y < -ButtonHeight * 2 Then
|
||||
FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
|
||||
AprilSpeed.Y -= 25
|
||||
Speed.Y -= 25
|
||||
If Relative.X < 0 Then
|
||||
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
|
||||
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
|
||||
@@ -756,7 +734,7 @@ NextFile:
|
||||
End If
|
||||
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
|
||||
FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
|
||||
AprilSpeed.Y += 25
|
||||
Speed.Y += 25
|
||||
If Relative.X < 0 Then
|
||||
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
|
||||
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
|
||||
@@ -764,34 +742,36 @@ NextFile:
|
||||
End If
|
||||
End If
|
||||
'移动
|
||||
AprilSpeed = AprilSpeed * 0.8 + Acc
|
||||
Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
|
||||
If SpeedValue < 0.01 Then Exit Sub
|
||||
AprilSpeed.Normalize()
|
||||
AprilSpeed *= SpeedValue
|
||||
AprilDistance += SpeedValue
|
||||
FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X
|
||||
FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y
|
||||
Speed = Speed * 0.8 + Acc
|
||||
Dim SpeedValue = Math.Min(60, Speed.Length)
|
||||
If SpeedValue < 0.01 Then Return
|
||||
Speed.Normalize()
|
||||
Speed *= SpeedValue
|
||||
AprilDifficultiedDistance += SpeedValue
|
||||
FrmLaunchLeft.AprilPosTrans.X += Speed.X
|
||||
FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
|
||||
'大小改变
|
||||
FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
|
||||
FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
|
||||
FrmLaunchLeft.AprilScaleTrans.ScaleX = (1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160)).Clamp(0.2, 1.8)
|
||||
FrmLaunchLeft.AprilScaleTrans.ScaleY = (1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100)).Clamp(0.2, 1.8)
|
||||
'放弃提示
|
||||
If AprilDistance > 4000 Then
|
||||
AprilDistance = -4000
|
||||
Static GiveUpDistance As Double = -1500
|
||||
GiveUpDistance += SpeedValue
|
||||
If GiveUpDistance > 2500 Then
|
||||
GiveUpDistance = 0
|
||||
Select Case RandomInteger(0, 3)
|
||||
Case 0
|
||||
Hint("放弃吧！只需要点一下右下角的小白旗……")
|
||||
Hint("放弃吧！只需要点一下右下角的小白旗……", HintType.Red)
|
||||
Case 1
|
||||
Hint("看到右下角的那面小白旗了吗？")
|
||||
Hint("看到右下角的那面小白旗了吗？", HintType.Red)
|
||||
Case 2
|
||||
Hint("这里建议点一下右下角的小白旗投降呢.jpg")
|
||||
Hint("这里建议点一下右下角的小白旗投降呢.jpg", HintType.Red)
|
||||
Case 3
|
||||
Hint("右下角的小白旗永远等着你……")
|
||||
Hint("右下角的小白旗永远等着你……", HintType.Red)
|
||||
End Select
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "愚人节移动出错", LogLevel.Feedback)
|
||||
Logger.Error(ex, "愚人节移动出错")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -807,7 +787,7 @@ NextFile:
|
||||
PostMessage(Handle, 400 * 16 + 2, 0, 0)
|
||||
SetForegroundWindow(Handle) '不在这里放不行，神秘 WinAPI，建议别动
|
||||
Catch ex As Exception
|
||||
Log(ex, "设置窗口置顶失败", LogLevel.Hint)
|
||||
Logger.Error(ex, "设置窗口置顶失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
|
||||
@@ -824,24 +804,103 @@ NextFile:
|
||||
'查看现有设置
|
||||
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
|
||||
If ReadOnlyKey IsNot Nothing Then
|
||||
Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
|
||||
If REG_VALUE = CurrentValue?.ToString() Then
|
||||
Log($"[System] 无需调整显卡设置：{Executeable}")
|
||||
If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
|
||||
Logger.Info($"无需调整显卡设置：{Executeable}")
|
||||
Return
|
||||
End If
|
||||
Else
|
||||
'创建父级键
|
||||
Log($"[System] 需要创建显卡设置的父级键")
|
||||
Logger.Info($"需要创建显卡设置的父级键")
|
||||
My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
|
||||
End If
|
||||
End Using
|
||||
'写入新设置
|
||||
Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
|
||||
WriteKey.SetValue(Executeable, REG_VALUE)
|
||||
Log($"[System] 已调整显卡设置：{Executeable}")
|
||||
Logger.Info($"已调整显卡设置：{Executeable}")
|
||||
End Using
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
|
||||
''' </summary>
|
||||
Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
|
||||
If Text Is Nothing OrElse Not Text.Contains("{") Then Return Text
|
||||
'预处理（注意，文件夹必须以 \ 结尾）
|
||||
Static Replacer As Func(Of String, String) =
|
||||
Function(s As String) As String
|
||||
If s Is Nothing Then Return ""
|
||||
If EscapeHandler Is Nothing Then Return s
|
||||
If s.Contains(":\") Then
|
||||
Dim IsFolder = s.EndsWithF("\") OrElse s.EndsWithF("/")
|
||||
s = PathUtils.ToShortPath(s)
|
||||
If IsFolder Then s = PathUtils.AddSlashSuffix(s)
|
||||
End If
|
||||
Return EscapeHandler(s)
|
||||
End Function
|
||||
'基础
|
||||
Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
|
||||
Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
|
||||
Text = Text.Replace("{pcl_version_branch}", Replacer(BuildTypeDisplay))
|
||||
Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
|
||||
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
|
||||
Text = Text.Replace("{identify}", Replacer(Identify))
|
||||
Text = Text.Replace("{path}", Replacer(Paths.Base))
|
||||
Text = Text.Replace("{path_with_name}", Replacer(PathExe))
|
||||
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
|
||||
Text = Text.Replace("{pcl_md5}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Md5)))
|
||||
Text = Text.Replace("{pcl_sha1}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Sha1)))
|
||||
'时间
|
||||
If ReplaceTime Then '在窗口标题中，时间会被后续动态替换，所以此时不应该替换
|
||||
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
|
||||
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
|
||||
End If
|
||||
'Minecraft
|
||||
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.Folder))
|
||||
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
|
||||
If McInstanceSelected?.IsLoaded Then
|
||||
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
|
||||
Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
|
||||
Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
|
||||
If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.Lower) Then
|
||||
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
|
||||
Else
|
||||
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
|
||||
End If
|
||||
Else
|
||||
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
|
||||
Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
|
||||
Text = Text.Replace("{name}", Replacer(Nothing))
|
||||
Text = Text.Replace("{version}", Replacer(Nothing))
|
||||
End If
|
||||
'登录信息
|
||||
If McLoginLoader.State = LoadState.Finished Then
|
||||
Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
|
||||
Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.Lower))
|
||||
Select Case McLoginLoader.Input.Type
|
||||
Case McLoginType.Legacy
|
||||
Text = Text.Replace("{login}", Replacer("离线"))
|
||||
Case McLoginType.Ms
|
||||
Text = Text.Replace("{login}", Replacer("正版"))
|
||||
Case McLoginType.Nide
|
||||
Text = Text.Replace("{login}", Replacer("统一通行证"))
|
||||
Case McLoginType.Auth
|
||||
Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
|
||||
End Select
|
||||
Else
|
||||
Text = Text.Replace("{user}", Replacer(Nothing))
|
||||
Text = Text.Replace("{uuid}", Replacer(Nothing))
|
||||
Text = Text.Replace("{login}", Replacer(Nothing))
|
||||
End If
|
||||
'高级
|
||||
Text = Text.RegexReplace("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
|
||||
Text = Text.RegexReplace("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
|
||||
Text = Text.RegexReplace("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
|
||||
Text = Text.RegexReplace("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
|
||||
Text = Text.RegexReplace("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
|
||||
Return Text
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "任务缓存"
|
||||
@@ -858,12 +917,12 @@ NextFile:
|
||||
IsTaskTempCleared = True
|
||||
IsTaskTempClearing = True
|
||||
Try
|
||||
Log("[System] 开始清理任务缓存文件夹")
|
||||
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
|
||||
DeleteDirectory($"{PathTemp}TaskTemp\")
|
||||
Log("[System] 已清理任务缓存文件夹")
|
||||
Logger.Info("开始清理任务缓存文件夹")
|
||||
DirectoryUtils.Delete($"{OsDrive}ProgramData\PCL\TaskTemp\")
|
||||
DirectoryUtils.Delete($"{PathTemp}TaskTemp\")
|
||||
Logger.Info("已清理任务缓存文件夹")
|
||||
Catch ex As Exception
|
||||
Log(ex, "清理任务缓存文件夹失败")
|
||||
Logger.Warn(ex, "清理任务缓存文件夹失败")
|
||||
Finally
|
||||
IsTaskTempClearing = False
|
||||
End Try
|
||||
@@ -886,18 +945,64 @@ NextFile:
|
||||
Try
|
||||
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
|
||||
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
|
||||
Directory.CreateDirectory(ResultFolder)
|
||||
DirectoryUtils.Create(ResultFolder)
|
||||
CheckPermissionWithException(ResultFolder)
|
||||
Return ResultFolder
|
||||
Catch
|
||||
End Try
|
||||
'使用备用路径
|
||||
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
|
||||
Directory.CreateDirectory(ResultFolder)
|
||||
DirectoryUtils.Create(ResultFolder)
|
||||
CheckPermission(ResultFolder)
|
||||
Return ResultFolder
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "反馈与遥测"
|
||||
|
||||
'反馈
|
||||
Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
|
||||
On Error Resume Next
|
||||
FeedbackInfo()
|
||||
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
|
||||
OpenExplorer(Paths.Base & "PCL\Log1.txt")
|
||||
End If
|
||||
OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 在日志中输出系统诊断信息。
|
||||
''' </summary>
|
||||
Public Sub FeedbackInfo()
|
||||
On Error Resume Next
|
||||
Logger.Warn($"诊断信息：{vbCrLf}" &
|
||||
"操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
|
||||
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
|
||||
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
|
||||
"MC 文件夹：" & If(McFolderSelected, "Nothing") & vbCrLf &
|
||||
"文件位置：" & Paths.Base)
|
||||
End Sub
|
||||
|
||||
'遥测
|
||||
Public Sub Telemetry([Event] As String, ParamArray Datas As String())
|
||||
If BuildType = BuildTypes.Debug Then Return '开发版不上传遥测
|
||||
If Not Settings.Get(Of Boolean)("SystemSystemTelemetry") Then Return '用户关闭了遥测
|
||||
If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Logger.Info($"匿名数据上报：{[Event]}")
|
||||
Dim Url As String = $"{ClsBaseUrl}&Event={StringUtils.UrlEscape([Event])}"
|
||||
For i = 0 To Datas.Length - 1 Step 2
|
||||
Url &= "&" & StringUtils.UrlEscape(Datas(i)) & "=" & StringUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
|
||||
Next
|
||||
NetRequestByClient(Url, MakeLog:=False)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "匿名数据上报失败")
|
||||
End Try
|
||||
End Sub, "Telemetry", ThreadPriority.Lowest)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
Public DragControl = Nothing
|
||||
@@ -913,7 +1018,7 @@ NextFile:
|
||||
If ThemeDontClick = 2 Then ThemeRefresh()
|
||||
#End Region
|
||||
Catch ex As Exception
|
||||
Log(ex, "短程主时钟执行异常", LogLevel.Assert)
|
||||
Logger.Error(ex, "短程主时钟执行异常", LogBehavior.AlertThenCrash)
|
||||
End Try
|
||||
Timer4Count += 1
|
||||
If Timer4Count = 4 Then
|
||||
@@ -923,7 +1028,7 @@ NextFile:
|
||||
If ThemeNow = 12 Then ThemeRefresh()
|
||||
#End Region
|
||||
Catch ex As Exception
|
||||
Log(ex, "中程主时钟执行异常", LogLevel.Debug)
|
||||
Logger.Warn(ex, "中程主时钟执行异常")
|
||||
End Try
|
||||
End If
|
||||
Timer150Count += 1
|
||||
@@ -931,17 +1036,18 @@ NextFile:
|
||||
Timer150Count = 0
|
||||
Try
|
||||
#Region "每 7.5s 执行一次的代码"
|
||||
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
|
||||
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDifficultiedDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
|
||||
'以未知原因窗口被丢到一边去的修复（Top、Left = -25600），还有 #745
|
||||
RunInUi(Sub()
|
||||
If Not FrmMain.Hidden Then
|
||||
If FrmMain.Top < -9000 Then FrmMain.Top = 100
|
||||
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
|
||||
End If
|
||||
End Sub)
|
||||
RunInUi(
|
||||
Sub()
|
||||
If Not FrmMain.Hidden Then
|
||||
If FrmMain.Top < -9000 Then FrmMain.Top = 100
|
||||
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
|
||||
End If
|
||||
End Sub)
|
||||
#End Region
|
||||
Catch ex As Exception
|
||||
Log(ex, "长程主时钟执行异常", LogLevel.Assert)
|
||||
Logger.Error(ex, "长程主时钟执行异常", LogBehavior.AlertThenCrash)
|
||||
End Try
|
||||
End If
|
||||
End Sub
|
||||
@@ -954,10 +1060,10 @@ NextFile:
|
||||
Thread.Sleep(50 * 0.98)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Log(ex, "程序主时钟出错", LogLevel.Feedback)
|
||||
Logger.Error(ex, "程序主时钟出错")
|
||||
End Try
|
||||
End Sub, "Timer Main")
|
||||
If Not IsAprilEnabled Then Exit Sub
|
||||
If Not IsAprilEnabled Then Return
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
@@ -970,7 +1076,7 @@ NextFile:
|
||||
Thread.Sleep(1)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Log(ex, "愚人节主时钟出错", LogLevel.Feedback)
|
||||
Logger.Error(ex, "愚人节主时钟出错")
|
||||
End Try
|
||||
End Sub, "Timer Main Fool")
|
||||
End Sub
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
Public Module ModMusic
|
||||
Imports NAudio.Wave
|
||||
|
||||
Public Module ModMusic
|
||||
|
||||
#Region "播放列表"
|
||||
|
||||
@@ -21,23 +23,22 @@
|
||||
'初始化全部可用音乐列表
|
||||
If MusicAllList Is Nothing Then
|
||||
MusicAllList = New List(Of String)
|
||||
Directory.CreateDirectory(Path & "PCL\Musics\")
|
||||
For Each File In EnumerateFiles(Path & "PCL\Musics\")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Musics\", True)
|
||||
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
|
||||
Dim Ext As String = File.Extension.ToLower
|
||||
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
|
||||
MusicAllList.Add(File.FullName)
|
||||
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
|
||||
MusicAllList.Add(File)
|
||||
Next
|
||||
End If
|
||||
'打乱顺序播放
|
||||
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
|
||||
MusicWaitingList = If(Settings.Get(Of Boolean)("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
|
||||
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
|
||||
'若需要避免成为第一项的为第一项，则将它放在最后
|
||||
MusicWaitingList.RemoveAt(0)
|
||||
MusicWaitingList.Add(PreventFirst)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "初始化音乐列表失败")
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -45,16 +46,18 @@
|
||||
''' 如果没有，可能会返回 Nothing。
|
||||
''' </summary>
|
||||
Private Function DequeueNextMusicAddress() As String
|
||||
Dim Result As String
|
||||
'初始化，确保存在音乐
|
||||
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
|
||||
'出列下一个音乐，如果出列结束则生成新列表
|
||||
If MusicWaitingList.Any() Then
|
||||
DequeueNextMusicAddress = MusicWaitingList(0)
|
||||
Result = MusicWaitingList(0)
|
||||
MusicWaitingList.RemoveAt(0)
|
||||
Else
|
||||
DequeueNextMusicAddress = Nothing
|
||||
Result = Nothing
|
||||
End If
|
||||
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
|
||||
If Not MusicWaitingList.Any() Then MusicListInit(False, Result)
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
@@ -79,7 +82,7 @@
|
||||
If MusicState = MusicStates.Pause Then
|
||||
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
|
||||
FrmMain.BtnExtraMusic.LogoScale = 0.8
|
||||
ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
|
||||
ToolTipText = "已暂停：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
|
||||
If MusicAllList.Count > 1 Then
|
||||
ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
|
||||
Else
|
||||
@@ -88,7 +91,7 @@
|
||||
Else
|
||||
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
|
||||
FrmMain.BtnExtraMusic.LogoScale = 1
|
||||
ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
|
||||
ToolTipText = "正在播放：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
|
||||
If MusicAllList.Count > 1 Then
|
||||
ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
|
||||
Else
|
||||
@@ -96,12 +99,11 @@
|
||||
End If
|
||||
End If
|
||||
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
|
||||
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
|
||||
End If
|
||||
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "刷新背景音乐 UI 失败")
|
||||
End Try
|
||||
End Sub)
|
||||
End Sub
|
||||
@@ -111,7 +113,7 @@
|
||||
''' </summary>
|
||||
Public Sub MusicControlPause()
|
||||
If MusicNAudio Is Nothing Then
|
||||
Hint("音乐播放尚未开始！", HintType.Critical)
|
||||
Hint("音乐播放尚未开始！", HintType.Red)
|
||||
Else
|
||||
Select Case MusicState
|
||||
Case MusicStates.Pause
|
||||
@@ -119,7 +121,7 @@
|
||||
Case MusicStates.Play
|
||||
MusicPause()
|
||||
Case Else
|
||||
Log("[Music] 音乐目前为停止状态，已强制尝试开始播放", LogLevel.Debug)
|
||||
Logger.Warn("音乐目前为停止状态，已强制尝试开始播放")
|
||||
MusicRefreshPlay(False)
|
||||
End Select
|
||||
End If
|
||||
@@ -129,16 +131,16 @@
|
||||
''' 播放下一曲，并显示提示文本。
|
||||
''' </summary>
|
||||
Public Sub MusicControlNext()
|
||||
If MusicAllList.Count = 1 Then
|
||||
If MusicAllList.IsSingle Then
|
||||
MusicStartPlay(MusicCurrent)
|
||||
Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
|
||||
Hint("重新播放：" & PathUtils.GetLastPart(MusicCurrent), HintType.Green)
|
||||
Else
|
||||
Dim Address As String = DequeueNextMusicAddress()
|
||||
If Address Is Nothing Then
|
||||
Hint("没有可以播放的音乐！", HintType.Critical)
|
||||
Hint("没有可以播放的音乐！", HintType.Red)
|
||||
Else
|
||||
MusicStartPlay(Address)
|
||||
Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish)
|
||||
Hint("正在播放：" & PathUtils.GetLastPart(Address), HintType.Green)
|
||||
End If
|
||||
End If
|
||||
MusicRefreshUI()
|
||||
@@ -155,9 +157,9 @@
|
||||
Get
|
||||
If MusicNAudio Is Nothing Then Return MusicStates.Stop
|
||||
Select Case MusicNAudio.PlaybackState
|
||||
Case 0 'NAudio.Wave.PlaybackState.Stopped
|
||||
Case 0 'PlaybackState.Stopped
|
||||
Return MusicStates.Stop
|
||||
Case 2 'NAudio.Wave.PlaybackState.Paused
|
||||
Case 2 'PlaybackState.Paused
|
||||
Return MusicStates.Pause
|
||||
Case Else
|
||||
Return MusicStates.Play
|
||||
@@ -182,19 +184,19 @@
|
||||
MusicListInit(True)
|
||||
If Not MusicAllList.Any() Then
|
||||
If MusicNAudio Is Nothing Then
|
||||
If ShowHint Then Hint("未检测到可用的背景音乐！", HintType.Critical)
|
||||
If ShowHint Then Hint("未检测到可用的背景音乐！", HintType.Red)
|
||||
Else
|
||||
MusicNAudio = Nothing
|
||||
If ShowHint Then Hint("背景音乐已清除！", HintType.Finish)
|
||||
If ShowHint Then Hint("背景音乐已清除！", HintType.Green)
|
||||
End If
|
||||
Else
|
||||
Dim Address As String = DequeueNextMusicAddress()
|
||||
If Address Is Nothing Then
|
||||
If ShowHint Then Hint("没有可以播放的音乐！", HintType.Critical)
|
||||
If ShowHint Then Hint("没有可以播放的音乐！", HintType.Red)
|
||||
Else
|
||||
Try
|
||||
MusicStartPlay(Address, IsFirstLoad)
|
||||
If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False)
|
||||
If ShowHint Then Hint("背景音乐已刷新：" & PathUtils.GetLastPart(Address), HintType.Green, False)
|
||||
Catch
|
||||
End Try
|
||||
End If
|
||||
@@ -202,7 +204,7 @@
|
||||
MusicRefreshUI()
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "刷新背景音乐播放失败", LogLevel.Feedback)
|
||||
Logger.Error(ex, "刷新背景音乐播放失败")
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -210,7 +212,7 @@
|
||||
''' </summary>
|
||||
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
|
||||
If Address Is Nothing Then Return
|
||||
Log("[Music] 播放开始：" & Address)
|
||||
Logger.Info($"播放开始：{Address}")
|
||||
MusicCurrent = Address
|
||||
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
|
||||
End Sub
|
||||
@@ -224,13 +226,13 @@
|
||||
If MusicState = MusicStates.Play Then
|
||||
RunInThread(
|
||||
Sub()
|
||||
Log("[Music] 已暂停播放")
|
||||
Logger.Info("已暂停播放")
|
||||
MusicNAudio?.Pause()
|
||||
MusicRefreshUI()
|
||||
End Sub)
|
||||
Return True
|
||||
Else
|
||||
Log($"[Music] 无需暂停播放，当前状态为 {MusicState}")
|
||||
Logger.Info($"无需暂停播放，当前状态为 {MusicState}")
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
@@ -239,15 +241,15 @@
|
||||
''' </summary>
|
||||
Public Function MusicResume() As Boolean
|
||||
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
|
||||
Log($"[Music] 无需继续播放，当前状态为 {MusicState}")
|
||||
Logger.Info($"无需继续播放，当前状态为 {MusicState}")
|
||||
Return False
|
||||
Else
|
||||
RunInThread(
|
||||
Sub()
|
||||
Log("[Music] 已恢复播放")
|
||||
Logger.Info("已恢复播放")
|
||||
Try
|
||||
MusicNAudio?.Play()
|
||||
Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223
|
||||
Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
|
||||
MusicNAudio?.Stop()
|
||||
MusicNAudio?.Play()
|
||||
End Try
|
||||
@@ -260,7 +262,8 @@
|
||||
#End Region
|
||||
|
||||
''' <summary>
|
||||
''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
|
||||
''' 当前正在播放的 WaveOutEvent。
|
||||
''' 如果为它赋了类别，则会没有必要地加载 NAudio.dll。
|
||||
''' </summary>
|
||||
Public MusicNAudio = Nothing
|
||||
''' <summary>
|
||||
@@ -272,26 +275,33 @@
|
||||
''' 在 MusicUuid 不变的前提下，持续播放某地址的音乐，且在播放结束后随机播放下一曲。
|
||||
''' </summary>
|
||||
Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False)
|
||||
Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing
|
||||
Dim Reader As NAudio.Wave.WaveStream = Nothing
|
||||
Dim CurrentWave As WaveOutEvent = Nothing
|
||||
Dim Reader As WaveStream = Nothing
|
||||
Try
|
||||
'开始播放
|
||||
CurrentWave = New NAudio.Wave.WaveOutEvent()
|
||||
CurrentWave = New WaveOutEvent()
|
||||
MusicNAudio = CurrentWave
|
||||
CurrentWave.DeviceNumber = -1
|
||||
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
|
||||
Try
|
||||
Reader = New AudioFileReader(MusicCurrent)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "使用 AudioFileReader 加载音频文件失败，换用 MediaFoundationReader 重试")
|
||||
Reader = New MediaFoundationReader(MusicCurrent)
|
||||
End Try
|
||||
CurrentWave.Init(Reader)
|
||||
CurrentWave.Play()
|
||||
'第一次打开的暂停
|
||||
If IsFirstLoad AndAlso Not Setup.Get("UiMusicAuto") Then CurrentWave.Pause()
|
||||
If IsFirstLoad AndAlso Not Settings.Get(Of Boolean)("UiMusicAuto") Then CurrentWave.Pause()
|
||||
MusicRefreshUI()
|
||||
'停止条件：播放完毕或变化
|
||||
Dim PreviousVolume = 0
|
||||
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped
|
||||
If Setup.Get("UiMusicVolume") <> PreviousVolume Then
|
||||
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = PlaybackState.Stopped
|
||||
If Settings.Get(Of Integer)("UiMusicVolume") <> PreviousVolume Then
|
||||
'更新音量
|
||||
PreviousVolume = Setup.Get("UiMusicVolume")
|
||||
PreviousVolume = Settings.Get(Of Integer)("UiMusicVolume")
|
||||
#Disable Warning BC40008 '类型或成员已过时
|
||||
CurrentWave.Volume = PreviousVolume / 1000
|
||||
#Enable Warning BC40008 '类型或成员已过时
|
||||
End If
|
||||
'更新进度条
|
||||
Dim Percent = Reader.CurrentTime.TotalMilliseconds / Reader.TotalTime.TotalMilliseconds
|
||||
@@ -299,24 +309,22 @@
|
||||
Thread.Sleep(100)
|
||||
End While
|
||||
'当前音乐已播放结束，继续下一曲
|
||||
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
|
||||
If CurrentWave.PlaybackState = PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
|
||||
Catch ex As Exception
|
||||
Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", LogLevel.Developer)
|
||||
Logger.Warn(ex, $"播放音乐出现内部错误（{MusicCurrent}）")
|
||||
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
|
||||
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Critical)
|
||||
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Red)
|
||||
Thread.Sleep(1000000000)
|
||||
End If
|
||||
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
|
||||
Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Critical)
|
||||
Hint("由于音频设备变更，音乐播放功能在重启 PCL 后才能恢复！", HintType.Red)
|
||||
Thread.Sleep(1000000000)
|
||||
End If
|
||||
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
|
||||
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
|
||||
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
|
||||
If Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
|
||||
ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
|
||||
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
|
||||
Hint("播放音乐失败（" & PathUtils.GetLastPart(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
|
||||
Else
|
||||
Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint)
|
||||
Logger.Error(ex, $"播放音乐失败（{PathUtils.GetLastPart(MusicCurrent)}）", LogBehavior.Toast)
|
||||
End If
|
||||
'将播放错误的音乐从列表中移除
|
||||
MusicAllList.Remove(MusicCurrent)
|
||||
|
||||
@@ -1,173 +1,40 @@
|
||||
'由于包含加解密等安全信息，本文件中的部分代码已被删除
|
||||
|
||||
Imports System.Security.Cryptography
|
||||
'由于包含加解密等安全信息，本文件中的部分代码已被删除
|
||||
|
||||
Friend Module ModSecret
|
||||
|
||||
#Region "杂项"
|
||||
|
||||
'标注 PCL 的不同分支，仅用于替换标记
|
||||
Public Const VersionBranchMain As String = "OpenSource"
|
||||
'在开源版的注册表与常规版的注册表隔离，以防数据冲突
|
||||
Public Const RegFolder As String = "PCLDebug"
|
||||
'用于微软登录的 ClientId
|
||||
Public Const OAuthClientId As String = ""
|
||||
Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")
|
||||
'CurseForge API Key
|
||||
Public Const CurseForgeAPIKey As String = ""
|
||||
|
||||
Friend Sub SecretOnApplicationStart()
|
||||
'提升 UI 线程优先级
|
||||
Thread.CurrentThread.Priority = ThreadPriority.Highest
|
||||
'确保 .NET Framework 版本
|
||||
Try
|
||||
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
Catch ex As UriFormatException '修复 #3555
|
||||
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
|
||||
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
End Try
|
||||
'检测当前文件夹权限
|
||||
Try
|
||||
Directory.CreateDirectory(Path & "PCL")
|
||||
Catch ex As Exception
|
||||
MsgBox($"PCL 无法创建 PCL 文件夹（{Path & "PCL"}），请尝试：" & vbCrLf &
|
||||
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
|
||||
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
|
||||
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
|
||||
MsgBoxStyle.Critical, "运行环境错误")
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End Try
|
||||
If Not CheckPermission(Path & "PCL") Then
|
||||
MsgBox("PCL 没有对当前文件夹的写入权限，请尝试：" & vbCrLf &
|
||||
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
|
||||
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
|
||||
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
|
||||
MsgBoxStyle.Critical, "运行环境错误")
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End If
|
||||
'开源版本提示
|
||||
MyMsgBox($"该版本中无法使用以下特性：
|
||||
- CurseForge API 调用：需要你自行申请 API Key，然后添加到 ModSecret.vb 的开头
|
||||
- 正版登录：需要你自行申请 Client ID，然后添加到 ModSecret.vb 的开头
|
||||
- 更新与联网通知：避免滥用隐患
|
||||
- 主题切换：这是需要赞助解锁的纪念性质的功能，别让赞助者太伤心啦……
|
||||
- 百宝箱：开发早期往里面塞了些开发工具，整理起来太麻烦了", "开源版本说明")
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 获取设备标识码。
|
||||
''' </summary>
|
||||
Friend Function SecretGetUniqueAddress() As String
|
||||
Return "0000-0000-0000-0000"
|
||||
End Function
|
||||
|
||||
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
|
||||
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
|
||||
DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
|
||||
McLaunchLog("当前剩余内存：" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
|
||||
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
|
||||
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
|
||||
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 打码字符串中的 AccessToken。
|
||||
''' </summary>
|
||||
Friend Function SecretFilter(Raw As String, FilterChar As Char) As String
|
||||
'打码 "accessToken " 后的内容
|
||||
If Raw.Contains("accessToken ") Then
|
||||
For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
|
||||
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
|
||||
Next
|
||||
End If
|
||||
'打码当前登录的结果
|
||||
Dim AccessToken As String = McLoginLoader.Output.AccessToken
|
||||
If AccessToken Is Nothing OrElse AccessToken.Length < 10 OrElse Not Raw.ContainsF(AccessToken, True) OrElse
|
||||
McLoginLoader.Output.Uuid = McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
|
||||
Return Raw
|
||||
Else
|
||||
Return Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
|
||||
End If
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")
|
||||
'用于匿名数据收集的腾讯云日志服务上报 URL，形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id}
|
||||
Public Const ClsBaseUrl As String = ""
|
||||
|
||||
#Region "网络鉴权"
|
||||
|
||||
Friend Function SecretCdnSign(UrlWithMark As String)
|
||||
Friend Function SecretCdnSign(UrlWithMark As String) As String
|
||||
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
|
||||
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 设置 Headers 的 UA、Referer。
|
||||
''' </summary>
|
||||
Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
|
||||
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
|
||||
Client.Headers("User-Agent") = "LogStatistic" '#4951
|
||||
ElseIf UseBrowserUserAgent Then
|
||||
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
|
||||
Else
|
||||
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
|
||||
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
|
||||
If Not Req.Headers.UserAgent.Any Then
|
||||
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
|
||||
Req.Headers.Add("User-Agent", "LogStatistic") '#4951
|
||||
ElseIf SimulateBrowserHeaders Then
|
||||
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{CInt(BuildType)} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
|
||||
Else
|
||||
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{CInt(BuildType)}")
|
||||
End If
|
||||
End If
|
||||
Client.Headers("Referer") = "http://" & VersionCode & ".open.pcl2.server/"
|
||||
If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey
|
||||
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
|
||||
If Url.Contains("api.curseforge.com") OrElse Url.Contains("forgecdn.net") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 设置 Headers 的 UA、Referer。
|
||||
''' </summary>
|
||||
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
|
||||
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
|
||||
Request.UserAgent = "LogStatistic" '#4951
|
||||
ElseIf UseBrowserUserAgent Then
|
||||
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
|
||||
Else
|
||||
Request.UserAgent = "PCL2/" & VersionStandardCode
|
||||
End If
|
||||
Request.Referer = "http://" & VersionCode & ".open.pcl2.server/"
|
||||
If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "字符串加解密"
|
||||
|
||||
''' <summary>
|
||||
''' 获取八位密钥。
|
||||
''' </summary>
|
||||
Private Function SecretKeyGet(Key As String) As String
|
||||
Return "00000000"
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 加密字符串。
|
||||
''' </summary>
|
||||
Friend Function SecretEncrypt(SourceString As String, Optional Key As String = "") As String
|
||||
Key = SecretKeyGet(Key)
|
||||
Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
|
||||
Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
|
||||
Dim des As New DESCryptoServiceProvider
|
||||
Using MS As New MemoryStream
|
||||
Dim inData As Byte() = Encoding.UTF8.GetBytes(SourceString)
|
||||
Using cs As New CryptoStream(MS, des.CreateEncryptor(btKey, btIV), CryptoStreamMode.Write)
|
||||
cs.Write(inData, 0, inData.Length)
|
||||
cs.FlushFinalBlock()
|
||||
Return Convert.ToBase64String(MS.ToArray())
|
||||
End Using
|
||||
End Using
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 解密字符串。
|
||||
''' </summary>
|
||||
Friend Function SecretDecrypt(SourceString As String, Optional Key As String = "") As String
|
||||
Key = SecretKeyGet(Key)
|
||||
Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
|
||||
Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
|
||||
Dim des As New DESCryptoServiceProvider
|
||||
Using MS As New MemoryStream
|
||||
Dim inData As Byte() = Convert.FromBase64String(SourceString)
|
||||
Using cs As New CryptoStream(MS, des.CreateDecryptor(btKey, btIV), CryptoStreamMode.Write)
|
||||
cs.Write(inData, 0, inData.Length)
|
||||
cs.FlushFinalBlock()
|
||||
Return Encoding.UTF8.GetString(MS.ToArray())
|
||||
End Using
|
||||
End Using
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -194,49 +61,69 @@ Friend Module ModSecret
|
||||
Public ColorSemiTransparent As New MyColor(1, Color8)
|
||||
|
||||
Public ThemeNow As Integer = -1
|
||||
Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As Object = 0
|
||||
Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As OneOf(Of Integer, Integer()) = 0
|
||||
Public ThemeDontClick As Integer = 0
|
||||
|
||||
Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
|
||||
Hint("该版本中不包含主题功能……")
|
||||
Try
|
||||
If ThemeNow = NewTheme AndAlso NewTheme >= 0 Then Return
|
||||
If NewTheme >= 0 Then ThemeNow = NewTheme
|
||||
|
||||
Color1 = New MyColor().FromHSL2(ColorHue, ColorSat * 0.2, 25 + ColorLightAdjust * 0.3)
|
||||
Color2 = New MyColor().FromHSL2(ColorHue, ColorSat, 45 + ColorLightAdjust)
|
||||
Color3 = New MyColor().FromHSL2(ColorHue, ColorSat, 55 + ColorLightAdjust)
|
||||
Color4 = New MyColor().FromHSL2(ColorHue, ColorSat, 65 + ColorLightAdjust)
|
||||
Color5 = New MyColor().FromHSL2(ColorHue, ColorSat, 80 + ColorLightAdjust * 0.4)
|
||||
Color6 = New MyColor().FromHSL2(ColorHue, ColorSat, 91 + ColorLightAdjust * 0.1)
|
||||
Color7 = New MyColor().FromHSL2(ColorHue, ColorSat, 95)
|
||||
Color8 = New MyColor().FromHSL2(ColorHue, ColorSat, 97)
|
||||
ColorBg0 = Color4 * 0.4 + Color5 * 0.4 + ColorGray4 * 0.2
|
||||
ColorBg1 = New MyColor(190, Color7)
|
||||
|
||||
ColorSemiTransparent = New MyColor(1, Color8)
|
||||
Application.Current.Resources("ColorBrush1") = New SolidColorBrush(Color1)
|
||||
Application.Current.Resources("ColorBrush2") = New SolidColorBrush(Color2)
|
||||
Application.Current.Resources("ColorBrush3") = New SolidColorBrush(Color3)
|
||||
Application.Current.Resources("ColorBrush4") = New SolidColorBrush(Color4)
|
||||
Application.Current.Resources("ColorBrush5") = New SolidColorBrush(Color5)
|
||||
Application.Current.Resources("ColorBrush6") = New SolidColorBrush(Color6)
|
||||
Application.Current.Resources("ColorBrush7") = New SolidColorBrush(Color7)
|
||||
Application.Current.Resources("ColorBrush8") = New SolidColorBrush(Color8)
|
||||
Application.Current.Resources("ColorBrushBg0") = New SolidColorBrush(ColorBg0)
|
||||
Application.Current.Resources("ColorBrushBg1") = New SolidColorBrush(ColorBg1)
|
||||
Application.Current.Resources("ColorObject1") = CType(Color1, Color)
|
||||
Application.Current.Resources("ColorObject2") = CType(Color2, Color)
|
||||
Application.Current.Resources("ColorObject3") = CType(Color3, Color)
|
||||
Application.Current.Resources("ColorObject4") = CType(Color4, Color)
|
||||
Application.Current.Resources("ColorObject5") = CType(Color5, Color)
|
||||
Application.Current.Resources("ColorObject6") = CType(Color6, Color)
|
||||
Application.Current.Resources("ColorObject7") = CType(Color7, Color)
|
||||
Application.Current.Resources("ColorObject8") = CType(Color8, Color)
|
||||
Application.Current.Resources("ColorObjectBg0") = CType(ColorBg0, Color)
|
||||
Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
|
||||
ThemeRefreshMain()
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "刷新主题颜色失败", LogBehavior.Toast)
|
||||
End Try
|
||||
End Sub
|
||||
Public Sub ThemeRefreshMain()
|
||||
RunInUi(
|
||||
Sub()
|
||||
If Not FrmMain.IsLoaded Then Exit Sub
|
||||
If Not FrmMain.IsLoaded Then Return
|
||||
'顶部条背景
|
||||
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
|
||||
If ThemeNow = 5 Then
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 15)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
|
||||
FrmMain.PanTitle.Background = Brush
|
||||
FrmMain.PanTitle.Background.Freeze()
|
||||
ElseIf Not (ThemeNow = 12 OrElse ThemeDontClick = 2) Then
|
||||
If TypeOf ColorHueTopbarDelta Is Integer Then
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
|
||||
Else
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
|
||||
End If
|
||||
FrmMain.PanTitle.Background = Brush
|
||||
FrmMain.PanTitle.Background.Freeze()
|
||||
Else
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)})
|
||||
FrmMain.PanTitle.Background = Brush
|
||||
End If
|
||||
Dim Deltas = ColorHueTopbarDelta.Switch(Function(d) New Integer() {-d, 0, d}, Function(d) d)
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + Deltas(0), ColorSat, 48 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + Deltas(1), ColorSat, 54 + ColorLightAdjust)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + Deltas(2), ColorSat, 48 + ColorLightAdjust)})
|
||||
FrmMain.PanTitle.Background = Brush
|
||||
FrmMain.PanTitle.Background.Freeze()
|
||||
'主页面背景
|
||||
If Setup.Get("UiBackgroundColorful") Then
|
||||
If Settings.Get(Of Boolean)("UiBackgroundColorful") Then
|
||||
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 20, Math.Min(60, ColorSat) * 0.5, 80)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.9, 90)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 20, Math.Min(60, ColorSat) * 0.5, 80)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
|
||||
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 15, ColorSat * 0.8, 91)})
|
||||
FrmMain.PanForm.Background = Brush
|
||||
Else
|
||||
FrmMain.PanForm.Background = New MyColor(245, 245, 245)
|
||||
@@ -252,30 +139,23 @@ Friend Module ModSecret
|
||||
Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
|
||||
Return False
|
||||
End Function
|
||||
Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
|
||||
Return False
|
||||
End Function
|
||||
Friend Function DonateCodeInput() As Boolean?
|
||||
Return Nothing
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "更新"
|
||||
|
||||
Public IsUpdateStarted As Boolean = False
|
||||
Public IsUpdateWaitingRestart As Boolean = False
|
||||
Public Sub UpdateCheckByButton()
|
||||
Friend Sub UpdateCheckByButton()
|
||||
Hint("该版本中不包含更新功能……")
|
||||
End Sub
|
||||
Public Sub UpdateStart(BaseUrl As String, Slient As Boolean, Optional ReceivedKey As String = Nothing, Optional ForceValidated As Boolean = False)
|
||||
End Sub
|
||||
|
||||
Friend IsUpdateWaitingRestart As Boolean = False
|
||||
Public Sub UpdateRestart(TriggerRestartAndByEnd As Boolean)
|
||||
End Sub
|
||||
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL，它会被用于整合包打包。
|
||||
''' 确保 PathTemp/Latest.exe 是最新正式版的 PCL，它会被用于整合包打包。
|
||||
''' 如果不是，则下载一个。
|
||||
''' </summary>
|
||||
Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
|
||||
@@ -284,9 +164,38 @@ Friend Module ModSecret
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "联网通知"
|
||||
#Region "联网配置"
|
||||
|
||||
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
|
||||
''' <summary>
|
||||
''' 联网获取的配置信息。
|
||||
''' 若获取失败或仍在获取中，可能为 Nothing。
|
||||
''' </summary>
|
||||
Public ServerConfig As JObject
|
||||
|
||||
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Logger.Info("该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
|
||||
{.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "赞助等级"
|
||||
|
||||
Public ReadOnly Property CurrentRank As DonationRank
|
||||
Get
|
||||
Return DonationRank.None
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Public Sub InputPotatoCode(IsUpdating As Boolean)
|
||||
End Sub
|
||||
Friend Sub GeneratePotatoCode()
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 获取设备识别码。
|
||||
''' </summary>
|
||||
Friend Function GetIdentify() As String
|
||||
Return "0000-0000-0000-0000"
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
@@ -1,59 +0,0 @@
|
||||
Imports System.Net
|
||||
|
||||
Public Class CookieWebClient
|
||||
Inherits WebClient
|
||||
|
||||
Public Sub New(container As CookieContainer, Headers As Dictionary(Of String, String))
|
||||
Me.New(container)
|
||||
For Each keyVal In Headers
|
||||
Me.Headers(keyVal.Key) = keyVal.Value
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Public Sub New()
|
||||
Me.New(New CookieContainer())
|
||||
End Sub
|
||||
|
||||
Public Sub New(container As CookieContainer)
|
||||
Me.container = container
|
||||
End Sub
|
||||
|
||||
Private Shadows ReadOnly container As New CookieContainer()
|
||||
|
||||
''' <summary>
|
||||
''' 以毫秒为单位的超时。
|
||||
''' </summary>
|
||||
Public Timeout As Integer = 600000
|
||||
|
||||
Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
|
||||
Dim r As WebRequest = MyBase.GetWebRequest(address)
|
||||
Dim request = TryCast(r, HttpWebRequest)
|
||||
|
||||
If request IsNot Nothing Then
|
||||
request.CookieContainer = container
|
||||
request.Timeout = Timeout
|
||||
End If
|
||||
|
||||
Return r
|
||||
End Function
|
||||
|
||||
Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
|
||||
Dim response As WebResponse = MyBase.GetWebResponse(request, result)
|
||||
ReadCookies(response)
|
||||
Return response
|
||||
End Function
|
||||
|
||||
Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
|
||||
Dim response As WebResponse = MyBase.GetWebResponse(request)
|
||||
ReadCookies(response)
|
||||
Return response
|
||||
End Function
|
||||
|
||||
Private Sub ReadCookies(r As WebResponse)
|
||||
Dim response = TryCast(r, HttpWebResponse)
|
||||
If response IsNot Nothing Then
|
||||
Dim cookies As CookieCollection = response.Cookies
|
||||
container.Add(cookies)
|
||||
End If
|
||||
End Sub
|
||||
End Class
|
||||
@@ -0,0 +1,277 @@
|
||||
''' <summary>
|
||||
''' 本地的社区资源文件。
|
||||
''' </summary>
|
||||
Public Class LocalResourceFile
|
||||
|
||||
#Region "文件信息"
|
||||
|
||||
''' <summary>
|
||||
''' 该文件的文件信息。
|
||||
''' </summary>
|
||||
Public ReadOnly File As FileInfo
|
||||
Public Sub New(FileInfo As FileInfo)
|
||||
Me.File = FileInfo
|
||||
End Sub
|
||||
Public Sub New(FullName As String)
|
||||
Me.New(FileUtils.GetInfo(FullName))
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 该文件是否没有被禁用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property IsEnabled As Boolean
|
||||
Get
|
||||
Return {".jar", ".zip", ".litemod"}.Contains(File.Extension.Lower)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 假若该资源未被禁用时，文件的文件名。
|
||||
''' </summary>
|
||||
Public ReadOnly Property EnabledName As String
|
||||
Get
|
||||
Return File.Name.Replace(".disabled", "").Replace(".old", "")
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 假若该资源未被禁用时，文件的完整路径。
|
||||
''' </summary>
|
||||
Public ReadOnly Property EnabledFullName As String
|
||||
Get
|
||||
Return $"{File.DirectoryName}\{EnabledName}"
|
||||
End Get
|
||||
End Property
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "信息项"
|
||||
|
||||
''' <summary>
|
||||
''' 在初始化结束之后，任何信息被后续更新时触发此事件。
|
||||
''' </summary>
|
||||
Public Event OnUpdate(sender As LocalResourceFile)
|
||||
|
||||
''' <summary>
|
||||
''' 可读名称。
|
||||
''' 可能为无扩展的文件名，但不会是 Nothing。
|
||||
''' </summary>
|
||||
Public Property Display As String
|
||||
Get
|
||||
If _Display Is Nothing Then _Display = ProjectVersion?.Display
|
||||
If _Display Is Nothing Then _Display = PathUtils.GetFileNameWithoutExtension(File.FullName)
|
||||
Return _Display
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Display Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
|
||||
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
|
||||
_Display = value
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
Private _Display As String = Nothing
|
||||
|
||||
''' <summary>
|
||||
''' Mod 的描述信息。
|
||||
''' 可能为 Nothing。
|
||||
''' </summary>
|
||||
Public Property Description As String
|
||||
Get
|
||||
Return _Description
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
|
||||
_Description = value.ToString.Trim(vbLf)
|
||||
'优化显示：若以 [a-zA-Z0-9] 结尾，加上小数点句号
|
||||
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
Private _Description As String = Nothing
|
||||
|
||||
''' <summary>
|
||||
''' Mod 的版本。
|
||||
''' 不保证符合版本格式规范，且可能为 Nothing。
|
||||
''' </summary>
|
||||
Public Property Version As String
|
||||
Get
|
||||
If _Version Is Nothing Then _Version = ProjectVersion?.Version
|
||||
Return _Version
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Version IsNot Nothing AndAlso _Version.RegexCheck("[0-9.\-]+") Then Return
|
||||
If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识
|
||||
_Version = value
|
||||
End Set
|
||||
End Property
|
||||
Public _Version As String = Nothing
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "网络信息"
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 关联的网络项目。
|
||||
''' </summary>
|
||||
Public Property Project As ResourceProject
|
||||
Get
|
||||
Return _Project
|
||||
End Get
|
||||
Set(value As ResourceProject)
|
||||
_Project = value
|
||||
RaiseEvent OnUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _Project As ResourceProject
|
||||
|
||||
''' <summary>
|
||||
''' 本地文件对应的联网文件信息。
|
||||
''' </summary>
|
||||
Public ProjectVersion As ResourceVersion
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 对应的联网最新版本。
|
||||
''' </summary>
|
||||
Public Property UpdateFile As ResourceVersion
|
||||
Get
|
||||
Return _UpdateFile
|
||||
End Get
|
||||
Set(value As ResourceVersion)
|
||||
_UpdateFile = value
|
||||
RaiseEvent OnUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _UpdateFile As ResourceVersion
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 的更新日志网址。
|
||||
''' </summary>
|
||||
Public ChangelogUrls As New List(Of String)
|
||||
''' <summary>
|
||||
''' 所有网络信息是否已成功加载。
|
||||
''' </summary>
|
||||
Public OnlineDataLoaded As Boolean = False
|
||||
|
||||
''' <summary>
|
||||
''' 将网络信息保存为 JSON。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
If Project IsNot Nothing Then Json.Add("Project", Project.ToJson())
|
||||
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
|
||||
Json.Add("OnlineDataLoaded", OnlineDataLoaded)
|
||||
If ProjectVersion IsNot Nothing Then Json.Add("Version", ProjectVersion.ToCacheJson())
|
||||
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToCacheJson())
|
||||
Return Json
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从 JSON 中读取网络信息。
|
||||
''' </summary>
|
||||
Public Sub FromJson(Json As JObject)
|
||||
OnlineDataLoaded = Json("OnlineDataLoaded")
|
||||
If Json.ContainsKey("Project") Then Project = New ResourceProject(Json("Project"))
|
||||
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
|
||||
If Json.ContainsKey("Version") Then ProjectVersion = ResourceVersion.FromCacheJson(Json("Version"))
|
||||
If Json.ContainsKey("UpdateFile") Then UpdateFile = ResourceVersion.FromCacheJson(Json("UpdateFile"))
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 该文件是否可以更新。
|
||||
''' </summary>
|
||||
Public ReadOnly Property HasUpdate As Boolean
|
||||
Get
|
||||
Return Not Settings.Get(Of Boolean)("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
|
||||
End Get
|
||||
End Property
|
||||
|
||||
''' <summary>
|
||||
''' 获取用于 CurseForge 信息获取的 Hash 值（MurmurHash2）。
|
||||
''' </summary>
|
||||
Public ReadOnly Property CurseForgeHash As UInteger
|
||||
Get
|
||||
If _CurseForgeHash Is Nothing Then
|
||||
'读取缓存
|
||||
Dim CacheKey As String = $"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-C".GetStableHashCode()
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" AndAlso Cached.RegexCheck("^\d+$") Then '#5062
|
||||
_CurseForgeHash = Cached
|
||||
Return _CurseForgeHash
|
||||
End If
|
||||
'读取文件
|
||||
Dim data As New List(Of Byte)
|
||||
For Each b As Byte In FileUtils.ReadAsBytes(File.FullName)
|
||||
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
|
||||
data.Add(b)
|
||||
Next
|
||||
'计算 MurmurHash2
|
||||
Dim length As Integer = data.Count
|
||||
Dim h As UInteger = 1 Xor length '1 是种子
|
||||
Dim i As Integer
|
||||
For i = 0 To length - 4 Step 4
|
||||
Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
|
||||
k = (k * &H5BD1E995L) And &HFFFFFFFFL
|
||||
k = k Xor (k >> 24)
|
||||
k = (k * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = h Xor k
|
||||
Next
|
||||
Select Case length - i
|
||||
Case 3
|
||||
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
|
||||
h = h Xor (CUInt(data(i + 2)) << 16)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
Case 2
|
||||
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
Case 1
|
||||
h = h Xor data(i)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
End Select
|
||||
h = h Xor (h >> 13)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = h Xor (h >> 15)
|
||||
_CurseForgeHash = h
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
|
||||
End If
|
||||
Return _CurseForgeHash
|
||||
End Get
|
||||
End Property
|
||||
Private _CurseForgeHash As UInteger?
|
||||
|
||||
''' <summary>
|
||||
''' 获取用于 Modrinth 信息获取的 Hash 值（SHA1）。
|
||||
''' </summary>
|
||||
Public ReadOnly Property ModrinthHash As String
|
||||
Get
|
||||
If _ModrinthHash Is Nothing Then
|
||||
'读取缓存
|
||||
Dim CacheKey As String = $"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-M".GetStableHashCode()
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" Then
|
||||
_ModrinthHash = Cached
|
||||
Return _ModrinthHash
|
||||
End If
|
||||
'计算 SHA1
|
||||
_ModrinthHash = CryptographyUtils.ComputeFileHash(File.FullName, CryptographyUtils.HashMethod.Sha1)
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
|
||||
End If
|
||||
Return _ModrinthHash
|
||||
End Get
|
||||
End Property
|
||||
Private _ModrinthHash As String
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "API"
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return File.FullName
|
||||
End Function
|
||||
Public Overrides Function Equals(obj As Object) As Boolean
|
||||
Dim Target = TryCast(obj, LocalResourceFile)
|
||||
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,337 @@
|
||||
Public Module LocalResourceLoaders
|
||||
|
||||
'加载 Mod 列表
|
||||
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
|
||||
Private Sub LocalResourceFileLoad(Loader As LoaderTask(Of String, List(Of LocalResourceFile)))
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
|
||||
|
||||
'等待 Mod 更新完成
|
||||
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
|
||||
Logger.Info($"等待 Mod 更新完成后才能继续加载 Mod 列表：{Loader.Input}")
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
|
||||
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
|
||||
If Loader.IsCanceled Then Return
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
Finally
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
|
||||
End Try
|
||||
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
|
||||
End If
|
||||
|
||||
'获取 Mod 文件夹下的可用文件列表
|
||||
Dim ModFileList As New List(Of String)
|
||||
If DirectoryUtils.Exists(Loader.Input) Then
|
||||
Dim RawName As String = Loader.Input.Lower
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Loader.Input, True)
|
||||
If File.BeforeLast("\").Lower & "\" <> RawName Then
|
||||
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
|
||||
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
|
||||
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
|
||||
PathUtils.GetLastPart(PathUtils.RemoveLastPart(File)) = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Static IsModFile As Func(Of String, Boolean) =
|
||||
Function(FullName As String)
|
||||
If FullName Is Nothing OrElse Not FullName.Contains(".") Then Return False
|
||||
FullName = FullName.Lower
|
||||
If FullName.EndsWithF(".jar", True) OrElse FullName.EndsWithF(".zip", True) OrElse FullName.EndsWithF(".litemod", True) OrElse
|
||||
FullName.EndsWithF(".jar.disabled", True) OrElse FullName.EndsWithF(".zip.disabled", True) OrElse FullName.EndsWithF(".litemod.disabled", True) OrElse
|
||||
FullName.EndsWithF(".jar.old", True) OrElse FullName.EndsWithF(".zip.old", True) OrElse FullName.EndsWithF(".litemod.old", True) Then Return True
|
||||
Return False
|
||||
End Function
|
||||
If IsModFile(File) Then ModFileList.Add(File)
|
||||
Next
|
||||
End If
|
||||
|
||||
'获取本地文件缓存
|
||||
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
|
||||
Dim Cache As New JObject
|
||||
Try
|
||||
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
|
||||
If Not String.IsNullOrWhiteSpace(CacheContent) Then
|
||||
Cache = CacheContent.DeserializeJson()
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LocalModCacheVersion Then
|
||||
Logger.Warn($"本地 Mod 信息缓存版本已过期，将弃用这些缓存信息")
|
||||
Cache = New JObject
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "读取本地 Mod 信息缓存失败，已重置")
|
||||
Cache = New JObject
|
||||
End Try
|
||||
Cache("version") = Versions.LocalModCacheVersion
|
||||
|
||||
'加载 Mod 列表
|
||||
Dim ModList As New List(Of LocalResourceFile)
|
||||
For Each ModFile In ModFileList
|
||||
If Loader.IsCanceled Then Return
|
||||
Dim ModEntry As New LocalResourceFile(ModFile)
|
||||
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件，名称相同，但一个启用一个禁用
|
||||
If DumpMod IsNot Nothing Then
|
||||
Dim DisabledMod As LocalResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
|
||||
Logger.Warn($"重复的 Mod 文件：{DumpMod.File.Name} 与 {ModEntry.File.Name}，已忽略 {DisabledMod.File.Name}")
|
||||
If DisabledMod Is ModEntry Then
|
||||
Continue For
|
||||
Else
|
||||
ModList.Remove(DisabledMod)
|
||||
End If
|
||||
End If
|
||||
ModList.Add(ModEntry)
|
||||
Next
|
||||
Logger.Info($"共发现 {ModList.Count} 个 Mod")
|
||||
|
||||
'排序
|
||||
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
|
||||
|
||||
'回设
|
||||
If Loader.IsCanceled Then Return
|
||||
Loader.Output = ModList
|
||||
|
||||
'开始联网加载
|
||||
'TODO: 添加信息获取中提示
|
||||
LocalResourceOnlineLoader.Start((ModList, Cache, PageInstanceLeft.Instance.Version), IsForceRestart:=True)
|
||||
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "Mod 列表加载失败")
|
||||
Throw
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'联网加载 Mod 详情
|
||||
Public LocalResourceOnlineLoader As New LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer)("LocalResourceOnlineLoader", AddressOf LocalResourceOnlineLoad)
|
||||
Private Sub LocalResourceOnlineLoad(Loader As LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer))
|
||||
Dim Mods As New List(Of LocalResourceFile)
|
||||
Dim Cache As JObject = Loader.Input.Cache
|
||||
Dim ModLoaders = Loader.Input.Target.ModLoaders
|
||||
'读取缓存，获取需要更新的 Mod 列表
|
||||
For Each ModEntry As LocalResourceFile In Loader.Input.ModList
|
||||
If Loader.IsCanceled Then Return
|
||||
Dim CacheKey = ModEntry.ModrinthHash & Loader.Input.Target.VanillaName & ModLoaders
|
||||
If Cache.ContainsKey(CacheKey) Then
|
||||
ModEntry.FromJson(Cache(CacheKey))
|
||||
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
|
||||
If ModEntry.OnlineDataLoaded AndAlso Date.Now - Cache(CacheKey)("Project")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
|
||||
End If
|
||||
Mods.Add(ModEntry)
|
||||
Next
|
||||
Logger.Info($"有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息，{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息")
|
||||
If Not Mods.Any Then Return
|
||||
'获取作为检查目标的加载器和版本
|
||||
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
|
||||
Dim TargetMcVersion As McVersion = Loader.Input.Target
|
||||
Dim VanillaVersion = TargetMcVersion.VanillaName
|
||||
'开始网络获取
|
||||
Logger.Info($"目标加载器：{ModLoaders}，版本：{VanillaVersion}")
|
||||
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
|
||||
Dim CurrentTaskThread As Thread = Thread.CurrentThread
|
||||
'从 Modrinth 获取信息
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'步骤 1：获取 Hash 与对应的工程 ID
|
||||
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
|
||||
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
|
||||
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
|
||||
Logger.Info($"从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
|
||||
If ModrinthVersion.Count = 0 Then Return
|
||||
Dim ModrinthMapping As New Dictionary(Of String, List(Of LocalResourceFile))
|
||||
For Each Entry In Mods
|
||||
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
|
||||
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
|
||||
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
|
||||
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度
|
||||
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of LocalResourceFile)
|
||||
ModrinthMapping(ProjectId).Add(Entry)
|
||||
'记录对应的 ProjectVersion
|
||||
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
|
||||
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then
|
||||
Entry.ProjectVersion = File
|
||||
Else
|
||||
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
|
||||
End If
|
||||
Next
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3：获取工程信息
|
||||
If Not ModrinthMapping.Any() Then Return
|
||||
Dim ModrinthProject As JArray = DlModRequest(
|
||||
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
|
||||
For Each ProjectJson In ModrinthProject
|
||||
Dim Project As New ResourceProject(ProjectJson)
|
||||
For Each Entry In ModrinthMapping(Project.Id)
|
||||
Entry.Project = Project
|
||||
Next
|
||||
Next
|
||||
Logger.Info($"已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
|
||||
'步骤 4：获取更新信息
|
||||
If ModLoaders = ModLoaders.None Then
|
||||
Logger.Warn("该 Minecraft 版本没有可用的 Mod 加载器，不获取 Mod 更新信息")
|
||||
Return
|
||||
End If
|
||||
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
|
||||
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
|
||||
""loaders"": [""{ModLoaders.Flags.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
|
||||
For Each Entry In Mods
|
||||
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.ProjectVersion Is Nothing Then Continue For
|
||||
Dim UpdateFile = ResourceVersion.FromPlatformJson(ModrinthUpdate(Entry.ModrinthHash), ResourceTypes.Mod)
|
||||
If Not UpdateFile.DownloadAvailable Then Continue For
|
||||
Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
|
||||
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
|
||||
'设置更新日志与更新文件
|
||||
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
|
||||
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
|
||||
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
|
||||
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
Logger.Info($"从 Modrinth 获取本地 Mod 信息结束")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader Modrinth")
|
||||
'从 CurseForge 获取信息
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'步骤 1：获取 Hash 与对应的工程 ID
|
||||
Dim Hashes As New List(Of UInteger)
|
||||
For Each Entry In Mods
|
||||
Hashes.Add(Entry.CurseForgeHash)
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Next
|
||||
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
|
||||
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
|
||||
Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
|
||||
If Not CurseForgeRaw.Any() Then Return
|
||||
|
||||
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
|
||||
Dim ProjectIdToLocalFiles As New Dictionary(Of Integer, List(Of LocalResourceFile))
|
||||
For Each Project In CurseForgeRaw
|
||||
Dim ProjectId = Project("id").ToString
|
||||
Dim Hash As UInteger = Project("file")("fileFingerprint")
|
||||
For Each Entry In Mods
|
||||
If Entry.CurseForgeHash <> Hash Then Continue For
|
||||
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度
|
||||
ProjectIdToLocalFiles.AddIntoValueCollection(ProjectId, Entry)
|
||||
'记录对应的 ProjectVersion
|
||||
Dim File = ResourceVersion.FromPlatformJson(Project("file"), ResourceTypes.Mod)
|
||||
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
|
||||
Next
|
||||
Next
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
|
||||
If Not ProjectIdToLocalFiles.Any() Then Return
|
||||
|
||||
'步骤 3：获取工程信息
|
||||
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
|
||||
$"{{""modIds"": [{ProjectIdToLocalFiles.Keys.Join(",")}]}}", "application/json")("data")
|
||||
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of LocalResourceFile)) 'FileId -> 本地 Mod 文件列表
|
||||
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
|
||||
For Each ProjectJson In CurseForgeProject
|
||||
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
|
||||
'设置 Entry 中的工程信息
|
||||
Dim Project As New ResourceProject(ProjectJson)
|
||||
Dim TargetLoaders As ModLoaders = ModLoaders.None
|
||||
For Each LocalFile In ProjectIdToLocalFiles(Project.Id) '倒查防止 CurseForge 返回的内容有漏
|
||||
If LocalFile.Project?.Platform = ResourcePlatforms.Modrinth Then
|
||||
LocalFile.Project = LocalFile.Project '再次触发修改事件
|
||||
Else
|
||||
LocalFile.Project = Project
|
||||
TargetLoaders = TargetLoaders Or LocalFile.Project.ModLoaders
|
||||
End If
|
||||
Next
|
||||
TargetLoaders = TargetLoaders And ModLoaders '与目标 MC 版本的加载器取交集
|
||||
'查找或许版本更新的文件列表
|
||||
If ModLoaders = ModLoaders.None Then Continue For '无法判断 MC 版本使用的加载器，跳过更新检查
|
||||
Dim LatestFiles = ProjectJson("latestFilesIndexes").Where(
|
||||
Function(Entry)
|
||||
'Mod Loader 匹配
|
||||
If Entry("modLoader") Is Nothing Then Return False
|
||||
Dim EntryLoader As ModLoaders = Resource.FromCurseForgeModLoaderType(Entry("modLoader").ToObject(Of Integer))
|
||||
If Not TargetLoaders.HasFlag(EntryLoader) Then Return False
|
||||
'MC 版本匹配
|
||||
Dim EntryVersion As String = Entry("gameVersion")
|
||||
Return EntryVersion IsNot Nothing AndAlso EntryVersion = VanillaVersion
|
||||
End Function).
|
||||
MaxByAll(Function(Entry) Entry("gameVersion").ToString, New VersionComparer) '只保留最新的 MC 版本
|
||||
For Each Entry In LatestFiles
|
||||
Dim FileId = Entry("fileId").ToObject(Of Integer)
|
||||
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of LocalResourceFile)
|
||||
UpdateFileIds(FileId).AddRange(ProjectIdToLocalFiles(Project.Id))
|
||||
FileIdToProjectSlug(FileId) = Project.Slug
|
||||
Next
|
||||
Next
|
||||
Logger.Info($"已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
|
||||
If Not UpdateFileIds.Any() Then Return
|
||||
|
||||
'步骤 4：获取更新文件信息
|
||||
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
|
||||
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
|
||||
Dim UpdateFiles As New Dictionary(Of LocalResourceFile, ResourceVersion)
|
||||
For Each FileJson In CurseForgeFiles
|
||||
Dim File = ResourceVersion.FromPlatformJson(FileJson, ResourceTypes.Mod)
|
||||
If Not File.DownloadAvailable Then Continue For
|
||||
For Each Entry As LocalResourceFile In UpdateFileIds(File.Id)
|
||||
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
|
||||
UpdateFiles(Entry) = File
|
||||
Next
|
||||
Next
|
||||
For Each Pair In UpdateFiles
|
||||
Dim Entry As LocalResourceFile = Pair.Key
|
||||
Dim UpdateFile As ResourceVersion = Pair.Value
|
||||
Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
|
||||
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
|
||||
'设置更新日志与更新文件
|
||||
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
|
||||
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
|
||||
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
|
||||
Logger.Info($"从 CurseForge 获取 Mod 更新信息结束")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader CurseForge")
|
||||
'等待线程结束
|
||||
Do Until EndedThreadCount = 2
|
||||
Thread.Sleep(10)
|
||||
If Loader.IsCanceled Then Return
|
||||
Loop
|
||||
'保存缓存
|
||||
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
|
||||
Logger.Info($"联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
For Each Entry In Mods
|
||||
Entry.OnlineDataLoaded = Not IsFailed
|
||||
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
|
||||
Next
|
||||
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
'刷新边栏
|
||||
If Loader.IsCanceled Then Return
|
||||
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
|
||||
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
|
||||
Else
|
||||
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
|
||||
End If
|
||||
End Sub
|
||||
|
||||
End Module
|
||||
@@ -0,0 +1,713 @@
|
||||
''' <summary>
|
||||
''' 社区资源的项目信息。
|
||||
''' </summary>
|
||||
Public Class ResourceProject
|
||||
|
||||
'源信息
|
||||
|
||||
''' <summary>
|
||||
''' 该项目信息的所属平台。
|
||||
''' </summary>
|
||||
Public ReadOnly Platform As ResourcePlatforms
|
||||
''' <summary>
|
||||
''' 工程中包含的文件种类。
|
||||
''' 若为 Modrinth 工程，可能为 Mod 或 数据包。
|
||||
''' </summary>
|
||||
Public ReadOnly Types As ResourceTypes
|
||||
''' <summary>
|
||||
''' 工程的短名。例如 technical-enchant。
|
||||
''' </summary>
|
||||
Public ReadOnly Slug As String
|
||||
''' <summary>
|
||||
''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。
|
||||
''' </summary>
|
||||
Public ReadOnly Id As String
|
||||
''' <summary>
|
||||
''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。
|
||||
''' </summary>
|
||||
Public ReadOnly CurseForgeFileIds As List(Of Integer)
|
||||
|
||||
'描述性信息
|
||||
|
||||
''' <summary>
|
||||
''' 原始的英文名称。
|
||||
''' </summary>
|
||||
Public ReadOnly RawName As String
|
||||
''' <summary>
|
||||
''' 英文描述。
|
||||
''' </summary>
|
||||
Public ReadOnly Description As String
|
||||
''' <summary>
|
||||
''' 来源网站的工程页面网址。确保格式一定标准。
|
||||
''' CurseForge：https://www.curseforge.com/minecraft/mc-mods/jei
|
||||
''' Modrinth：https://modrinth.com/mod/technical-enchant
|
||||
''' </summary>
|
||||
Public ReadOnly Website As String
|
||||
''' <summary>
|
||||
''' 最后一次更新的时间。
|
||||
''' </summary>
|
||||
Public ReadOnly LastUpdate As Date
|
||||
''' <summary>
|
||||
''' 下载量计数。注意，该计数仅为一个来源，无法反应两边加起来的下载量！
|
||||
''' </summary>
|
||||
Public ReadOnly DownloadCount As Integer
|
||||
''' <summary>
|
||||
''' 所有支持的 Mod 加载器。可能为 <see cref="ModLoaders.None"/>。
|
||||
''' </summary>
|
||||
Public ReadOnly ModLoaders As ModLoaders = ModLoaders.None
|
||||
''' <summary>
|
||||
''' 描述性标签的内容。已转换为中文。
|
||||
''' </summary>
|
||||
Public ReadOnly Tags As List(Of String)
|
||||
''' <summary>
|
||||
''' Logo 图片的下载地址。
|
||||
''' 若为 Nothing 则没有，保证不为空字符串。
|
||||
''' </summary>
|
||||
Public LogoUrl As String = Nothing
|
||||
''' <summary>
|
||||
''' 支持的 Drop 编号，从高到低排序，不为 Nothing。
|
||||
''' 例如：261（26.1.x）、180（1.18.x）。
|
||||
''' </summary>
|
||||
Public ReadOnly Drops As List(Of Integer)
|
||||
''' <summary>
|
||||
''' Modrinth API 返回的原始版本列表。
|
||||
''' 仅用于 Modrinth 工程的二次筛选，不会被缓存，不会被预处理。
|
||||
''' 若非从 Modrinth 获取则为 Nothing。
|
||||
''' </summary>
|
||||
Public ReadOnly UnsafeGameVersions As List(Of String)
|
||||
|
||||
'数据库信息
|
||||
|
||||
Private LoadedDatabase As Boolean = False
|
||||
Private _WikiEntry As WikiEntry = Nothing
|
||||
''' <summary>
|
||||
''' 关联的数据库条目。若为 Nothing 则没有。
|
||||
''' </summary>
|
||||
Private Property WikiEntry As WikiEntry
|
||||
Get
|
||||
If Not LoadedDatabase Then
|
||||
LoadedDatabase = True
|
||||
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then
|
||||
_WikiEntry = WikiEntry.All.Value.FirstOrDefault(Function(c) c.Slugs.GetOrDefault(Platform) = Slug)
|
||||
End If
|
||||
End If
|
||||
Return _WikiEntry
|
||||
End Get
|
||||
Set(value As WikiEntry)
|
||||
LoadedDatabase = True
|
||||
_WikiEntry = value
|
||||
End Set
|
||||
End Property
|
||||
''' <summary>
|
||||
''' MC 百科的页面 ID。若为 0 则没有。
|
||||
''' </summary>
|
||||
Public ReadOnly Property WikiId As Integer
|
||||
Get
|
||||
Return If(WikiEntry Is Nothing, 0, WikiEntry.Id)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 翻译后的中文名。若数据库没有则等同于 RawName。
|
||||
''' </summary>
|
||||
Public ReadOnly Property TranslatedName As String
|
||||
Get
|
||||
Return If(WikiEntry?.ChineseName, RawName)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'实例化
|
||||
|
||||
''' <summary>
|
||||
''' 从工程 Json 中初始化实例。若出错会抛出异常。
|
||||
''' </summary>
|
||||
Public Sub New(Data As JObject)
|
||||
If Data.ContainsKey("Tags") Then
|
||||
#Region "缓存 JSON"
|
||||
Platform = Data("Platform").ToObject(Of Integer)
|
||||
Types = Data("Types").ToObject(Of Integer)
|
||||
Slug = Data("Slug")
|
||||
Id = Data("Id")
|
||||
If Data.ContainsKey("CurseForgeFileIds") Then CurseForgeFileIds = CType(Data("CurseForgeFileIds"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
|
||||
RawName = Data("RawName")
|
||||
Description = Data("Description")
|
||||
Website = Data("Website")
|
||||
LastUpdate = Data("LastUpdate")
|
||||
DownloadCount = Data("DownloadCount")
|
||||
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of Integer)
|
||||
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
|
||||
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
|
||||
If Data.ContainsKey("Drops") Then
|
||||
Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
|
||||
Else
|
||||
Drops = New List(Of Integer)
|
||||
End If
|
||||
#End Region
|
||||
Else
|
||||
Platform = If(Data.ContainsKey("summary"), ResourcePlatforms.CurseForge, ResourcePlatforms.Modrinth)
|
||||
If Platform = ResourcePlatforms.CurseForge Then
|
||||
#Region "CurseForge"
|
||||
'简单信息
|
||||
Id = Data("id")
|
||||
Slug = Data("slug")
|
||||
RawName = Data("name")
|
||||
Description = Data("summary")
|
||||
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
|
||||
LastUpdate = Data("dateReleased") '#1194
|
||||
DownloadCount = Data("downloadCount")
|
||||
If Data("logo").Count > 0 Then
|
||||
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
|
||||
LogoUrl = Data("logo")("url")
|
||||
Else
|
||||
LogoUrl = Data("logo")("thumbnailUrl")
|
||||
End If
|
||||
End If
|
||||
If LogoUrl = "" Then LogoUrl = Nothing
|
||||
'Type
|
||||
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
|
||||
Types = ResourceTypes.Mod
|
||||
ElseIf Website.Contains("/modpacks/") Then
|
||||
Types = ResourceTypes.ModPack
|
||||
ElseIf Website.Contains("/resourcepacks/") Then
|
||||
Types = ResourceTypes.ResourcePack
|
||||
ElseIf Website.Contains("/texture-packs/") Then
|
||||
Types = ResourceTypes.ResourcePack
|
||||
ElseIf Website.Contains("/shaders/") Then
|
||||
Types = ResourceTypes.Shader
|
||||
Else
|
||||
Types = ResourceTypes.DataPack
|
||||
End If
|
||||
'FileIndexes / VanillaMajorVersions / ModLoaders
|
||||
ModLoaders = ModLoaders.None
|
||||
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
|
||||
For Each File In If(Data("latestFiles"), New JArray)
|
||||
Dim NewFile = ResourceVersion.FromPlatformJson(File, Types)
|
||||
If Not NewFile.DownloadAvailable Then Continue For
|
||||
ModLoaders = ModLoaders Or NewFile.ModLoaders
|
||||
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
|
||||
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
|
||||
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
|
||||
Next
|
||||
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样，见 #3599
|
||||
If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
|
||||
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
|
||||
Next
|
||||
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
|
||||
Drops = Files.SelectMany(Function(f) f.Value).
|
||||
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Tags
|
||||
Tags = New List(Of String)
|
||||
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831)
|
||||
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
|
||||
Select Case Category
|
||||
'Mod
|
||||
Case 406 : Tags.Add("世界元素")
|
||||
Case 407 : Tags.Add("生物群系")
|
||||
Case 410 : Tags.Add("维度")
|
||||
Case 408 : Tags.Add("矿物/资源")
|
||||
Case 409 : Tags.Add("天然结构")
|
||||
Case 412 : Tags.Add("科技")
|
||||
Case 415 : Tags.Add("管道/物流")
|
||||
Case 4843 : Tags.Add("自动化")
|
||||
Case 417 : Tags.Add("能源")
|
||||
Case 4558 : Tags.Add("红石")
|
||||
Case 436 : Tags.Add("食物/烹饪")
|
||||
Case 416 : Tags.Add("农业")
|
||||
Case 414 : Tags.Add("运输")
|
||||
Case 420 : Tags.Add("仓储")
|
||||
Case 419 : Tags.Add("魔法")
|
||||
Case 422 : Tags.Add("冒险")
|
||||
Case 424 : Tags.Add("装饰")
|
||||
Case 411 : Tags.Add("生物")
|
||||
Case 434 : Tags.Add("装备")
|
||||
Case 6814 : Tags.Add("性能优化")
|
||||
Case 9026 : Tags.Add("创造模式")
|
||||
Case 423 : Tags.Add("信息显示")
|
||||
Case 435 : Tags.Add("服务器")
|
||||
Case 5191 : Tags.Add("改良")
|
||||
Case 421 : Tags.Add("支持库")
|
||||
'整合包
|
||||
Case 4484 : Tags.Add("多人")
|
||||
Case 4479 : Tags.Add("硬核")
|
||||
Case 4483 : Tags.Add("战斗")
|
||||
Case 4478 : Tags.Add("任务")
|
||||
Case 4472 : Tags.Add("科技")
|
||||
Case 4473 : Tags.Add("魔法")
|
||||
Case 4475 : Tags.Add("冒险")
|
||||
Case 4476 : Tags.Add("探索")
|
||||
Case 4477 : Tags.Add("小游戏")
|
||||
Case 4474 : Tags.Add("科幻")
|
||||
Case 4736 : Tags.Add("空岛")
|
||||
Case 5128 : Tags.Add("原版改良")
|
||||
Case 4487 : Tags.Add("FTB")
|
||||
Case 4480 : Tags.Add("基于地图")
|
||||
Case 4481 : Tags.Add("轻量")
|
||||
Case 4482 : Tags.Add("大型")
|
||||
'资源包
|
||||
Case 403 : Tags.Add("原版风")
|
||||
Case 400 : Tags.Add("写实风")
|
||||
Case 401 : Tags.Add("现代风")
|
||||
Case 402 : Tags.Add("中世纪")
|
||||
Case 399 : Tags.Add("蒸汽朋克")
|
||||
Case 5244 : Tags.Add("含字体")
|
||||
Case 404 : Tags.Add("动态效果")
|
||||
Case 4465 : Tags.Add("兼容 Mod")
|
||||
Case 393 : Tags.Add("16x")
|
||||
Case 394 : Tags.Add("32x")
|
||||
Case 395 : Tags.Add("64x")
|
||||
Case 396 : Tags.Add("128x")
|
||||
Case 397 : Tags.Add("256x")
|
||||
Case 398 : Tags.Add("超高清")
|
||||
Case 5193 : Tags.Add("数据包") '有这个 Tag 的项会从资源包请求中被移除
|
||||
'光影包
|
||||
Case 6553 : Tags.Add("写实风")
|
||||
Case 6554 : Tags.Add("幻想风")
|
||||
Case 6555 : Tags.Add("原版风")
|
||||
'数据包
|
||||
Case 6948 : Tags.Add("冒险")
|
||||
Case 6949 : Tags.Add("幻想")
|
||||
Case 6950 : Tags.Add("支持库")
|
||||
Case 6952 : Tags.Add("魔法")
|
||||
Case 6946 : Tags.Add("Mod 相关")
|
||||
Case 6951 : Tags.Add("科技")
|
||||
Case 6953 : Tags.Add("实用")
|
||||
End Select
|
||||
Next
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
|
||||
Slug = Data("slug")
|
||||
RawName = Data("title")
|
||||
Description = Data("description")
|
||||
LastUpdate = If(Data("date_modified"), Data("updated"))
|
||||
DownloadCount = Data("downloads")
|
||||
LogoUrl = Data("icon_url")
|
||||
If LogoUrl = "" Then LogoUrl = Nothing
|
||||
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
|
||||
'GameVersions
|
||||
'搜索结果的键为 versions，获取特定工程的键为 game_versions
|
||||
UnsafeGameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).Select(Function(v) v.ToString).Distinct.ToList
|
||||
Drops = UnsafeGameVersions.Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Type
|
||||
Select Case Data("project_type").ToString
|
||||
Case "modpack" : Types = ResourceTypes.ModPack
|
||||
Case "resourcepack" : Types = ResourceTypes.ResourcePack
|
||||
Case "shader" : Types = ResourceTypes.Shader
|
||||
Case Else : Types = ResourceTypes.Mod 'Modrinth 将数据包标为 Mod，但 categories 字段里有 datapack
|
||||
End Select
|
||||
'Tags & ModLoaders
|
||||
Tags = New List(Of String)
|
||||
ModLoaders = ModLoaders.None
|
||||
For Each Category In If(Data("loaders")?.Select(Function(t) t.ToString), {}).Concat(Data("categories").Select(Function(t) t.ToString))
|
||||
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
|
||||
If Category = Loader.ToString.Lower Then
|
||||
ModLoaders = ModLoaders Or Loader
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
For Each Category In Data("categories").Select(Function(t) t.ToString)
|
||||
Select Case Category
|
||||
Case "datapack" : Types = ResourceTypes.DataPack
|
||||
'共用
|
||||
Case "technology" : Tags.Add("科技")
|
||||
Case "magic" : Tags.Add("魔法")
|
||||
Case "adventure" : Tags.Add("冒险")
|
||||
Case "utility" : Tags.Add("实用")
|
||||
Case "optimization" : Tags.Add("性能优化")
|
||||
Case "vanilla-like" : Tags.Add("原版风")
|
||||
Case "realistic" : Tags.Add("写实风")
|
||||
'Mod/数据包
|
||||
Case "worldgen" : Tags.Add("世界元素")
|
||||
Case "food" : Tags.Add("食物/烹饪")
|
||||
Case "game-mechanics" : Tags.Add("游戏机制")
|
||||
Case "transportation" : Tags.Add("运输")
|
||||
Case "storage" : Tags.Add("仓储")
|
||||
Case "decoration" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装饰")
|
||||
Case "mobs" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("生物")
|
||||
Case "equipment" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装备")
|
||||
Case "social" : Tags.Add("服务器")
|
||||
Case "library" : Tags.Add("支持库")
|
||||
'整合包
|
||||
Case "multiplayer" : Tags.Add("多人")
|
||||
Case "challenging" : Tags.Add("硬核")
|
||||
Case "combat" : Tags.Add("战斗")
|
||||
Case "quests" : Tags.Add("任务")
|
||||
Case "kitchen-sink" : Tags.Add("水槽包")
|
||||
Case "lightweight" : Tags.Add("轻量")
|
||||
'资源包
|
||||
Case "simplistic" : Tags.Add("简洁")
|
||||
Case "combat" : Tags.Add("战斗")
|
||||
Case "tweaks" : Tags.Add("改良")
|
||||
|
||||
Case "8x-" : Tags.Add("极简")
|
||||
Case "16x" : Tags.Add("16x")
|
||||
Case "32x" : Tags.Add("32x")
|
||||
Case "48x" : Tags.Add("48x")
|
||||
Case "64x" : Tags.Add("64x")
|
||||
Case "128x" : Tags.Add("128x")
|
||||
Case "256x" : Tags.Add("256x")
|
||||
Case "512x+" : Tags.Add("超高清")
|
||||
|
||||
Case "audio" : Tags.Add("含声音")
|
||||
Case "fonts" : Tags.Add("含字体")
|
||||
Case "models" : Tags.Add("含模型")
|
||||
Case "gui" : Tags.Add("含 UI")
|
||||
Case "locale" : Tags.Add("含语言")
|
||||
Case "core-shaders" : Tags.Add("核心着色器")
|
||||
Case "modded" : Tags.Add("兼容 Mod")
|
||||
'光影包
|
||||
Case "fantasy" : Tags.Add("幻想风")
|
||||
Case "semi-realistic" : Tags.Add("半写实风")
|
||||
Case "cartoon" : Tags.Add("卡通风")
|
||||
'暂时不添加性能负荷 Tag
|
||||
'Case "potato" : Tags.Add("极低")
|
||||
'Case "low" : Tags.Add("低")
|
||||
'Case "medium" : Tags.Add("中")
|
||||
'Case "high" : Tags.Add("高")
|
||||
Case "colored-lighting" : Tags.Add("彩色光照")
|
||||
Case "path-tracing" : Tags.Add("路径追踪")
|
||||
Case "pbr" : Tags.Add("PBR")
|
||||
Case "reflections" : Tags.Add("反射")
|
||||
|
||||
Case "iris" : Tags.Add("Iris")
|
||||
Case "optifine" : Tags.Add("OptiFine")
|
||||
Case "vanilla" : Tags.Add("原版可用")
|
||||
End Select
|
||||
Next
|
||||
If Types = ResourceTypes.DataPack AndAlso ModLoaders <> ModLoaders.None Then Types = ResourceTypes.DataPack Or ResourceTypes.Mod
|
||||
#End Region
|
||||
End If
|
||||
If Not Tags.Any() Then Tags.Add("其他")
|
||||
Tags.Sort()
|
||||
End If
|
||||
'保存缓存
|
||||
Cache(Id) = Me
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 从工程 ID 联网获取对应工程的信息。
|
||||
''' </summary>
|
||||
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms) As ResourceProject
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
If Cache.ContainsKey(ProjectId) Then '存在缓存
|
||||
Return Cache(ProjectId)
|
||||
ElseIf Platform = ResourcePlatforms.CurseForge Then 'CurseForge
|
||||
Return New ResourceProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId)("data"))
|
||||
Else 'Modrinth
|
||||
Return New ResourceProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId))
|
||||
End If
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从工程 ID 列表联网获取工程信息，结果不按原顺序排列。
|
||||
''' </summary>
|
||||
Public Shared Iterator Function FromProjectIds(ProjectIds As IEnumerable(Of String), Platform As ResourcePlatforms) As IEnumerable(Of ResourceProject)
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
'获取缓存
|
||||
Dim MissingProjectIds As New List(Of String)
|
||||
For Each ProjectId In ProjectIds
|
||||
If Cache.ContainsKey(ProjectId) Then
|
||||
Yield Cache(ProjectId)
|
||||
Else
|
||||
MissingProjectIds.Add(ProjectId)
|
||||
End If
|
||||
Next
|
||||
If Not MissingProjectIds.Any() Then Return
|
||||
'联网获取剩余的工程对象
|
||||
Dim Projects As JArray
|
||||
If Platform.HasFlag(ResourcePlatforms.CurseForge) Then
|
||||
Projects = DlModRequest("https://api.curseforge.com/v1/mods",
|
||||
HttpMethod.Post, "{""modIds"": [" & MissingProjectIds.Join(","c) & "]}", "application/json")("data")
|
||||
Else
|
||||
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{MissingProjectIds.Join(""",""")}""]")
|
||||
End If
|
||||
For Each Project In Projects
|
||||
Yield New ResourceProject(Project)
|
||||
Next
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 将当前实例转为可用于保存缓存的 Json。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
Json("Platform") = CInt(Platform)
|
||||
Json("Types") = CInt(Types)
|
||||
Json("Slug") = Slug
|
||||
Json("Id") = Id
|
||||
If CurseForgeFileIds IsNot Nothing Then Json("CurseForgeFileIds") = New JArray(CurseForgeFileIds)
|
||||
Json("RawName") = RawName
|
||||
Json("Description") = Description
|
||||
Json("Website") = Website
|
||||
Json("LastUpdate") = LastUpdate
|
||||
Json("DownloadCount") = DownloadCount
|
||||
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = CInt(ModLoaders)
|
||||
Json("Tags") = New JArray(Tags)
|
||||
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If Drops.Any Then Json("Drops") = New JArray(Drops)
|
||||
Json("CacheTime") = Date.Now '用于检查缓存时间
|
||||
Return Json
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 将当前工程信息实例化为控件。
|
||||
''' </summary>
|
||||
Public Function ToResourceItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyVirtualizingElement(Of MyResourceItem)
|
||||
'获取版本描述
|
||||
Dim GameVersionDescription As String
|
||||
If Drops Is Nothing OrElse Not Drops.Any() Then
|
||||
GameVersionDescription = "仅快照版本" '#5412
|
||||
Else
|
||||
Dim Segments As New List(Of String)
|
||||
Dim IsOld As Boolean = False
|
||||
For i = 0 To Drops.Count - 1 '版本号一定为降序
|
||||
'获取当前连续的版本号段
|
||||
Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
|
||||
If StartDrop < 120 Then '如果支持新版本，则不显示 1.11-
|
||||
If Segments.Any() AndAlso Not IsOld Then
|
||||
Exit For
|
||||
Else
|
||||
IsOld = True
|
||||
End If
|
||||
End If
|
||||
For ii = i + 1 To Drops.Count - 1
|
||||
If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
|
||||
EndDrop = Drops(ii)
|
||||
i = ii
|
||||
Next
|
||||
'将版本号段转为描述文本
|
||||
Dim StartName = McVersion.DropToVersion(StartDrop)
|
||||
Dim EndName = McVersion.DropToVersion(EndDrop)
|
||||
If StartDrop = EndDrop Then
|
||||
Segments.Add(StartName)
|
||||
ElseIf AllDrops IsNot Nothing AndAlso StartDrop >= AllDrops.First Then
|
||||
If EndDrop < 120 Then
|
||||
Segments.Clear()
|
||||
Segments.Add("全版本")
|
||||
Exit For
|
||||
Else
|
||||
Segments.Add(EndName & "+")
|
||||
End If
|
||||
ElseIf EndDrop < 120 Then
|
||||
Segments.Add(StartName & "-")
|
||||
Exit For
|
||||
ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
|
||||
Segments.Add(StartName & ", " & EndName)
|
||||
Else
|
||||
Segments.Add(StartName & "~" & EndName)
|
||||
End If
|
||||
Next
|
||||
GameVersionDescription = Segments.Join(", ")
|
||||
End If
|
||||
'获取 Mod 加载器描述
|
||||
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
|
||||
Dim ModLoadersForDesc = ModLoaders.Flags().ToList()
|
||||
If Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaders.Quilt)
|
||||
Select Case ModLoadersForDesc.Count
|
||||
Case 0
|
||||
If ModLoadersForDesc.IsSingle Then
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
|
||||
Else
|
||||
ModLoaderDescriptionFull = "未知"
|
||||
ModLoaderDescriptionPart = ""
|
||||
End If
|
||||
Case 1
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
|
||||
Case Else
|
||||
Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
|
||||
If ModLoadersForDesc.Contains(ModLoaders.Forge) AndAlso
|
||||
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Fabric)) AndAlso
|
||||
(NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) AndAlso
|
||||
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Quilt) OrElse Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt")) Then
|
||||
ModLoaderDescriptionFull = "任意"
|
||||
ModLoaderDescriptionPart = ""
|
||||
Else
|
||||
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
|
||||
End If
|
||||
End Select
|
||||
'实例化 UI
|
||||
Return New MyVirtualizingElement(Of MyResourceItem)(
|
||||
Function()
|
||||
Dim NewItem As New MyResourceItem With {.Tag = Me}
|
||||
ApplyLogoToMyImage(NewItem.PathLogo)
|
||||
Dim Titles = GetControlTitle(True)
|
||||
NewItem.Title = Titles.Title
|
||||
If Titles.SubTitle = "" Then
|
||||
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
|
||||
Else
|
||||
NewItem.SubTitle = Titles.SubTitle
|
||||
End If
|
||||
NewItem.Tags = Tags
|
||||
NewItem.Description = Description.ReplaceLineEndings("")
|
||||
'下边栏
|
||||
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
|
||||
'全部隐藏
|
||||
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
|
||||
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
|
||||
NewItem.ColumnVersion1.Width = New GridLength(0)
|
||||
NewItem.ColumnVersion2.MaxWidth = 0
|
||||
NewItem.ColumnVersion3.Width = New GridLength(0)
|
||||
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
|
||||
'全部显示
|
||||
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
|
||||
ElseIf ShowMcVersionDesc Then
|
||||
'仅显示版本
|
||||
NewItem.LabVersion.Text = GameVersionDescription
|
||||
Else
|
||||
'仅显示 Mod 加载器
|
||||
NewItem.LabVersion.Text = ModLoaderDescriptionFull
|
||||
End If
|
||||
NewItem.LabSource.Text = Platform.ToString
|
||||
NewItem.LabTime.Text = StringUtils.FormatTimeSpan(LastUpdate - Date.Now, True)
|
||||
NewItem.LabDownload.Text =
|
||||
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
|
||||
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
|
||||
Return NewItem
|
||||
End Function) With {.Height = 64}
|
||||
End Function
|
||||
Public Sub ApplyLogoToMyImage(Img As MyImage)
|
||||
If String.IsNullOrEmpty(LogoUrl) Then
|
||||
Img.Source = PathImage & "Icons/NoIcon.png"
|
||||
Else
|
||||
Img.Source = LogoUrl
|
||||
Img.FallbackSource = DlSourceModGet(LogoUrl)
|
||||
End If
|
||||
End Sub
|
||||
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As (Title As String, SubTitle As String)
|
||||
'检查下列代码时可以参考 #1567 的测试例
|
||||
Dim Title As String = RawName
|
||||
Dim SubtitleList As List(Of String)
|
||||
If TranslatedName = RawName Then
|
||||
'没有中文翻译
|
||||
'将所有名称分段
|
||||
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
|
||||
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
|
||||
If NameLists.IsSingle Then GoTo NoSubtitle
|
||||
'查找其中的缩写、Forge/Fabric 等版本标记
|
||||
SubtitleList = New List(Of String)
|
||||
Dim NormalNameList = New List(Of String)
|
||||
For Each Name In NameLists
|
||||
Dim LowerName As String = Name.Lower
|
||||
If Name = Name.Upper AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
|
||||
'缩写
|
||||
SubtitleList.Add(Name)
|
||||
ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso
|
||||
Not LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").RegexCheck("[a-z]+") Then '去掉关键词后没有其他字母
|
||||
'Forge/Fabric 等版本标记
|
||||
SubtitleList.Add(Name)
|
||||
Else
|
||||
'其他部分
|
||||
NormalNameList.Add(Name)
|
||||
End If
|
||||
Next
|
||||
'根据分类后的结果处理
|
||||
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
|
||||
'同时包含 NormalName 和 Subtitle
|
||||
Title = NormalNameList.Join(" - ")
|
||||
Else
|
||||
'有中文翻译
|
||||
'尝试将文本分为三段：Title (EnglishName) - Suffix
|
||||
'检查时注意 Carpet（它没有中文译名，但有 Suffix）和 “汤姆存储 - 星的奇妙优化 (Tom's balabala)”
|
||||
Title = If(TranslatedName.Contains(" ("), TranslatedName.BeforeFirst(" ("), TranslatedName.BeforeLast(" - "))
|
||||
Dim Suffix As String = ""
|
||||
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
|
||||
Dim EnglishName As String = TranslatedName
|
||||
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
|
||||
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
|
||||
'中段的额外信息截取
|
||||
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
|
||||
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
|
||||
If SubtitleList.Count > 1 AndAlso
|
||||
Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版
|
||||
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.Upper = SubtitleList.Last) Then '不是缩写
|
||||
SubtitleList = New List(Of String) From {EnglishName} '使用原名
|
||||
End If
|
||||
'添加后缀
|
||||
If Suffix <> "" Then SubtitleList.Add(Suffix)
|
||||
End If
|
||||
SubtitleList = SubtitleList.Distinct.ToList()
|
||||
'设置标题与描述
|
||||
Dim Subtitle As String = ""
|
||||
If SubtitleList.Any Then
|
||||
For Each Ex In SubtitleList
|
||||
Dim IsModLoaderDescription As Boolean =
|
||||
Ex.Lower.Contains("neoforge") OrElse Ex.Lower.Contains("forge") OrElse Ex.Lower.Contains("fabric") OrElse Ex.Lower.Contains("quilt")
|
||||
'是否显示 ModLoader 信息
|
||||
If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
|
||||
'去除 “Forge/Fabric” 这一无意义提示
|
||||
If Ex.Length < 16 AndAlso Ex.Lower.Contains("fabric") AndAlso Ex.Lower.Contains("forge") Then Continue For
|
||||
'将 “Forge” 等提示改为 “Forge 版”
|
||||
If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
|
||||
Ex.Lower.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
|
||||
Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
|
||||
End If
|
||||
'将 “forge” 等词语的首字母大写
|
||||
Ex = Ex.Replace("neoforge", "NeoForge").Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
|
||||
Subtitle &= " | " & Ex.Trim
|
||||
Next
|
||||
Else
|
||||
NoSubtitle:
|
||||
Subtitle = ""
|
||||
End If
|
||||
Return (Title, Subtitle)
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 工程 ID 对应的工程实例的缓存。不会保存到文件。
|
||||
''' </summary>
|
||||
Protected Friend Shared Cache As New Dictionary(Of String, ResourceProject)
|
||||
|
||||
''' <summary>
|
||||
''' 检查是否与某个 Project 是相同的工程，只是在不同的网站。
|
||||
''' </summary>
|
||||
Public Function IsLike(Project As ResourceProject) As Boolean
|
||||
If Id = Project.Id Then Return True '相同实例
|
||||
'提取字符串中的字母和数字
|
||||
Dim GetRaw =
|
||||
Function(Data As String) As String
|
||||
Dim Result As New StringBuilder()
|
||||
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
|
||||
Result.Append(r)
|
||||
Next
|
||||
Return Result.ToString.Lower
|
||||
End Function
|
||||
'来自不同的网站
|
||||
If Platform = Project.Platform Then Return False
|
||||
'Mod 加载器一致
|
||||
If ModLoaders <> Project.ModLoaders Then Return False
|
||||
'若不为光影，则要求 MC 版本一致
|
||||
If Types <> ResourceTypes.Shader AndAlso Drops.Ordered.SequenceEqual(Project.Drops.Ordered) Then Return False
|
||||
'最近更新时间差距在一周以内
|
||||
If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 Then Return False
|
||||
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
|
||||
If TranslatedName = Project.TranslatedName OrElse
|
||||
RawName = Project.RawName OrElse Description = Project.Description OrElse
|
||||
GetRaw(Slug) = GetRaw(Project.Slug) Then
|
||||
Logger.Info($"将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
|
||||
'如果只有一个有 DatabaseEntry，设置给另外一个
|
||||
If WikiEntry Is Nothing AndAlso Project.WikiEntry IsNot Nothing Then WikiEntry = Project.WikiEntry
|
||||
If WikiEntry IsNot Nothing AndAlso Project.WikiEntry Is Nothing Then Project.WikiEntry = WikiEntry
|
||||
Return True
|
||||
End If
|
||||
Return False
|
||||
End Function
|
||||
|
||||
'辅助函数
|
||||
Public Overrides Function ToString() As String
|
||||
Return $"{Id} ({Slug}): {RawName}"
|
||||
End Function
|
||||
Public Overrides Function Equals(obj As Object) As Boolean
|
||||
Dim project = TryCast(obj, ResourceProject)
|
||||
Return project IsNot Nothing AndAlso Id = project.Id
|
||||
End Function
|
||||
Public Shared Operator =(left As ResourceProject, right As ResourceProject) As Boolean
|
||||
Return EqualityComparer(Of ResourceProject).Default.Equals(left, right)
|
||||
End Operator
|
||||
Public Shared Operator <>(left As ResourceProject, right As ResourceProject) As Boolean
|
||||
Return Not left = right
|
||||
End Operator
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,526 @@
|
||||
Public Class ResourceSearcher
|
||||
Private Const RESULT_PAGE_SIZE = 40
|
||||
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果，请尝试搜索其英文名称"
|
||||
|
||||
'输入
|
||||
Public Class SearchRequest
|
||||
|
||||
'结果要求
|
||||
|
||||
''' <summary>
|
||||
''' 结果存储器，会从中获取需加载的页面等。
|
||||
''' 加载后也应输出到此处。
|
||||
''' </summary>
|
||||
Public Storage As SearchResult
|
||||
''' <summary>
|
||||
''' 应当尽量达成的结果数量。
|
||||
''' </summary>
|
||||
Public TargetResultCount As Integer
|
||||
''' <summary>
|
||||
''' 根据加载位置记录，是否还可以继续获取内容。
|
||||
''' </summary>
|
||||
Public ReadOnly Property CanContinue As Boolean
|
||||
Get
|
||||
If Tag.StartsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.CurseForge) Then Storage.CurseForgeTotal = 0
|
||||
If Tag.EndsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.Modrinth) Then Storage.ModrinthTotal = 0
|
||||
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
|
||||
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'输入内容
|
||||
|
||||
''' <summary>
|
||||
''' 筛选资源种类。
|
||||
''' </summary>
|
||||
Public Type As ResourceTypes
|
||||
''' <summary>
|
||||
''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen"，分别是 CurseForge 和 Modrinth 的 ID。
|
||||
''' </summary>
|
||||
Public Tag As String = ""
|
||||
''' <summary>
|
||||
''' 筛选 Mod 加载器类别。
|
||||
''' <see cref="ModLoaders.None"/> 代表不筛选。
|
||||
''' 对于 Modrinth 请求，支持多个枚举值。
|
||||
''' </summary>
|
||||
Public ModLoaders As ModLoaders = ModLoaders.None
|
||||
''' <summary>
|
||||
''' 筛选 MC 版本。
|
||||
''' </summary>
|
||||
Public GameVersion As String = Nothing
|
||||
''' <summary>
|
||||
''' 搜索的初始内容。
|
||||
''' </summary>
|
||||
Public SearchText As String = Nothing
|
||||
''' <summary>
|
||||
''' 允许的来源。
|
||||
''' </summary>
|
||||
Public Sources As ResourcePlatforms = ResourcePlatforms.Any
|
||||
Public Sub New(Type As ResourceTypes, Storage As SearchResult, TargetResultCount As Integer)
|
||||
Me.Type = Type
|
||||
Me.Storage = Storage
|
||||
Me.TargetResultCount = TargetResultCount
|
||||
End Sub
|
||||
|
||||
'构造请求
|
||||
|
||||
''' <summary>
|
||||
''' 获取对应的 CurseForge API 请求链接。
|
||||
''' </summary>
|
||||
Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
|
||||
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={RESULT_PAGE_SIZE}"
|
||||
Select Case Type
|
||||
Case ResourceTypes.Mod
|
||||
Address += "&classId=6"
|
||||
Case ResourceTypes.ModPack
|
||||
Address += "&classId=4471"
|
||||
Case ResourceTypes.DataPack
|
||||
Address += "&classId=6945"
|
||||
Case ResourceTypes.Shader
|
||||
Address += "&classId=6552"
|
||||
Case ResourceTypes.ResourcePack
|
||||
Address += "&classId=12"
|
||||
End Select
|
||||
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
|
||||
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First)
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & StringUtils.UrlEscape(SearchText)
|
||||
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
|
||||
Return Address
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 获取对应的 Modrinth API 请求链接。
|
||||
''' </summary>
|
||||
Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
|
||||
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & StringUtils.UrlEscape(SearchText)
|
||||
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
|
||||
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
|
||||
Dim Facets As New List(Of String)
|
||||
Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
|
||||
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
|
||||
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
|
||||
Facets.Add($"[""categories:'{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("',categories:'")}'""]")
|
||||
End If
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
|
||||
Address += "&facets=[" & String.Join(",", Facets) & "]"
|
||||
Return Address
|
||||
End Function
|
||||
|
||||
'相同判断
|
||||
Public Overrides Function Equals(obj As Object) As Boolean
|
||||
Dim request = TryCast(obj, SearchRequest)
|
||||
Return request IsNot Nothing AndAlso
|
||||
Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
|
||||
Tag = request.Tag AndAlso ModLoaders = request.ModLoaders AndAlso Sources = request.Sources AndAlso
|
||||
GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
|
||||
End Function
|
||||
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
|
||||
Return EqualityComparer(Of SearchRequest).Default.Equals(left, right)
|
||||
End Operator
|
||||
Public Shared Operator <>(left As SearchRequest, right As SearchRequest) As Boolean
|
||||
Return Not left = right
|
||||
End Operator
|
||||
Public Overrides Function GetHashCode() As Integer
|
||||
Return (Type, Tag, ModLoaders, GameVersion, SearchText, Sources).GetHashCode()
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
'输出
|
||||
Public Class SearchResult
|
||||
|
||||
'加载位置记录
|
||||
|
||||
Public CurseForgeOffset As Integer = 0
|
||||
Public CurseForgeTotal As Integer = -1
|
||||
|
||||
Public ModrinthOffset As Integer = 0
|
||||
Public ModrinthTotal As Integer = -1
|
||||
|
||||
'结果列表
|
||||
|
||||
''' <summary>
|
||||
''' 可供展示的所有工程的列表。
|
||||
''' </summary>
|
||||
Public Results As New List(Of ResourceProject)
|
||||
''' <summary>
|
||||
''' 当前的错误信息。如果没有则为 Nothing。
|
||||
''' </summary>
|
||||
Public ErrorMessage As String = Nothing
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 根据搜索请求获取一系列的工程列表。
|
||||
''' </summary>
|
||||
Public Shared Function GetLoader(InputDelegate As Func(Of SearchRequest)) As LoaderTask(Of SearchRequest, Integer)
|
||||
Return New LoaderTask(Of SearchRequest, Integer)("社区资源获取", AddressOf Run, InputDelegate) With {.ReloadTimeout = 60 * 1000}
|
||||
End Function
|
||||
Private Shared Sub Run(Task As LoaderTask(Of SearchRequest, Integer))
|
||||
Dim Request As SearchRequest = Task.Input
|
||||
Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
|
||||
|
||||
#Region "前置检查"
|
||||
|
||||
If Storage.Results.Count >= Request.TargetResultCount Then
|
||||
Logger.Info($"已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
|
||||
Return
|
||||
ElseIf Not Request.CanContinue Then
|
||||
If Not Storage.Results.Any() Then
|
||||
Throw New Exception("没有符合条件的结果")
|
||||
Else
|
||||
Logger.Info($"已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
|
||||
Return
|
||||
End If
|
||||
End If
|
||||
|
||||
'拒绝 1.13- Quilt（这个版本根本没有 Quilt）
|
||||
If Request.ModLoaders = ModLoaders.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
|
||||
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
|
||||
End If
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "中文搜索"
|
||||
|
||||
Dim RawSearchText As String = If(Request.SearchText, "").Trim
|
||||
RawSearchText = RawSearchText.Lower
|
||||
Logger.Info($"工程列表搜索原始文本：{RawSearchText}")
|
||||
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
|
||||
|
||||
Dim IsChineseSearch As Boolean =
|
||||
RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
|
||||
(Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) '目前仅对 Mod 和数据包进行中文搜索，注意整合包的名称可能已经有中文了
|
||||
Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
|
||||
If IsChineseSearch Then
|
||||
'帮助方法：从搜索项提取可能的英文单词
|
||||
Dim ExtractWords =
|
||||
Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
|
||||
'从各个可能的来源提取候选
|
||||
Dim Candidates As New List(Of String)
|
||||
If Result.Item.Slugs.ContainsKey(Source) Then
|
||||
Candidates.Add(Result.Item.Slugs(Source).
|
||||
Replace("-", " ").Replace("/", " "))
|
||||
End If
|
||||
If Result.Item.ChineseName IsNot Nothing Then
|
||||
Candidates.Add(Result.Item.ChineseName.
|
||||
AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
|
||||
End If
|
||||
'分词、清洗、去重
|
||||
Candidates = Candidates.
|
||||
SelectMany(Function(c) c.Split(" ")).
|
||||
Select(Function(w) w.TrimStart("{[(").TrimEnd("}])").Lower).
|
||||
Where(
|
||||
Function(w)
|
||||
If w.Length <= 1 Then Return False '单字或空白
|
||||
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
|
||||
If Val(w) > 0 Then Return False '数字
|
||||
If Not w.IsAsciiOnly Then Return False '非纯英文
|
||||
Return True
|
||||
End Function).Distinct.ToList
|
||||
'如果一个词可以由其他词拼成，则去掉这个词（例如将 ender io enderio 的 enderio 剔除，只保留 ender io）
|
||||
Dim CanForm As Func(Of String, Boolean) = Nothing
|
||||
CanForm = Function(s) Candidates.Contains(s) OrElse Candidates.Any(Function(c) s.StartsWith(c) AndAlso CanForm(s.Substring(c.Length)))
|
||||
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
|
||||
Return Candidates
|
||||
End Function
|
||||
Dim GetSearchEntries =
|
||||
Iterator Function(Source As ResourcePlatforms)
|
||||
For Each Entry In WikiEntry.All.Value
|
||||
If Not Entry.Slugs.ContainsKey(Source) Then Continue For
|
||||
If Entry.ChineseName IsNot Nothing Then
|
||||
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(StrConv(Entry.ChineseName.BeforeFirst(" ("), VbStrConv.SimplifiedChinese).Split("/"c, True), 1), '部分 Mod 有别名
|
||||
New SearchSource(StrConv(Entry.ChineseName.AfterFirst(" ("), VbStrConv.SimplifiedChinese) & Entry.Slugs(Source), 0.5)
|
||||
}}
|
||||
Else
|
||||
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(Entry.Slugs(Source), 0.5)
|
||||
}}
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
'CurseForge
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
|
||||
'数据库搜索
|
||||
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.CurseForge).ToList()
|
||||
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
|
||||
If CurseForgeSearchResults.Any Then
|
||||
'选取目标（CurseForge 要求每个词都必须匹配上，所以只能选择一个 Mod 进行搜索）
|
||||
Dim CurseForgeTarget =
|
||||
If(CurseForgeSearchResults.First.AbsoluteRight,
|
||||
CurseForgeSearchResults.Where(Function(s) s.AbsoluteRight).ToList, '优先使用所有完全匹配的
|
||||
CurseForgeSearchResults.MaxByAll(Function(s) s.Similarity)). '其次使用所有相似度最高的
|
||||
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
|
||||
'后处理
|
||||
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
|
||||
Logger.Warn($"中文搜索关键词（CurseForge）：{CurseForgeAltSearchText}")
|
||||
End If
|
||||
End If
|
||||
'Modrinth
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
|
||||
'数据库搜索
|
||||
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.Modrinth).ToList()
|
||||
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
|
||||
If ModrinthSearchResults.Any Then
|
||||
'分词
|
||||
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
|
||||
For Each Result In ModrinthSearchResults
|
||||
For Each Word In ExtractWords(Result, ResourcePlatforms.Modrinth)
|
||||
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
|
||||
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(RawSearchText)), 1000, Result.Similarity) '完全匹配为 1000
|
||||
WordWeights(Word) += Similarity * Result.Item.Popularity '权重 += 相似度 * 受欢迎程度
|
||||
Next
|
||||
Next
|
||||
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
|
||||
Logger.Warn($"中文搜索关键词（Modrinth）：{ModrinthAltSearchText}")
|
||||
'直接请求工程
|
||||
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.Slugs(ResourcePlatforms.Modrinth)).ToList
|
||||
End If
|
||||
End If
|
||||
'结束
|
||||
If String.IsNullOrEmpty(CurseForgeAltSearchText) AndAlso String.IsNullOrEmpty(ModrinthAltSearchText) AndAlso Not ModrinthSlugs.Any Then
|
||||
Throw New Exception(MSG_NO_CHINESE_RESULT)
|
||||
End If
|
||||
End If
|
||||
Task.Progress = 0.05
|
||||
|
||||
#End Region
|
||||
|
||||
Dim RealResults As New List(Of ResourceProject)
|
||||
NextPage:
|
||||
Dim RawResults As New List(Of ResourceProject)
|
||||
|
||||
#Region "从 CurseForge 和 Modrinth 获取结果列表，存储于 RawResults"
|
||||
|
||||
Dim WorkThreads As New List(Of Thread)
|
||||
Dim Errors As New ConcurrentBag(Of (Ex As Exception, Source As ResourcePlatforms))
|
||||
|
||||
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
|
||||
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
|
||||
Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
|
||||
Dim SearchResults As New ConcurrentBag(Of ResourceProject)
|
||||
Try
|
||||
|
||||
'CurseForge 搜索
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) AndAlso
|
||||
Not (Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(CurseForgeAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
|
||||
Logger.Info($"开始 CurseForge 搜索：{CurseForgeUrl}")
|
||||
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
|
||||
Dim ProjectList As New List(Of ResourceProject)
|
||||
For Each JsonEntry As JObject In RequestResult("data")
|
||||
Dim Project As New ResourceProject(JsonEntry)
|
||||
If Request.Type = ResourceTypes.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
|
||||
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For '过滤分区不匹配的搜索结果（#8265）
|
||||
ProjectList.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Storage.CurseForgeOffset += RequestResult("data").Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "CurseForge 搜索失败")
|
||||
Storage.CurseForgeTotal = -1
|
||||
Errors.Add((ex, ResourcePlatforms.CurseForge))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "CurseForge Search"))
|
||||
End If
|
||||
|
||||
'Modrinth 搜索
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
|
||||
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(ModrinthAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
|
||||
Logger.Info($"开始 Modrinth 搜索：{ModrinthUrl}")
|
||||
Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
|
||||
Dim ProjectList As New List(Of ResourceProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New ResourceProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Storage.ModrinthOffset += RequestResult("hits").Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "Modrinth 搜索失败")
|
||||
Storage.ModrinthTotal = -1
|
||||
Errors.Add((ex, ResourcePlatforms.Modrinth))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "Modrinth Search"))
|
||||
End If
|
||||
|
||||
'Modrinth 直接获取工程
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
|
||||
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
ModrinthSlugs.Any Then '有直接获取的 Slug
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
|
||||
Logger.Info($"开始 Modrinth 直接获取：{ModrinthUrl}")
|
||||
Dim ProjectList As New List(Of ResourceProject)
|
||||
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
|
||||
Dim Project As New ResourceProject(JsonEntry)
|
||||
'应用筛选
|
||||
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For
|
||||
If Not String.IsNullOrEmpty(Request.Tag) AndAlso
|
||||
Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了，只能从 json 判
|
||||
If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
|
||||
Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
|
||||
If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
|
||||
Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
|
||||
ProjectList.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
|
||||
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "Modrinth 直接获取失败")
|
||||
Errors.Add((ex, ResourcePlatforms.Modrinth))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "Modrinth Get"))
|
||||
End If
|
||||
|
||||
'等待线程结束
|
||||
For Each Thread In WorkThreads
|
||||
Thread.Join()
|
||||
If Task.IsCanceled Then Return '会自动触发 Finally 以清理线程
|
||||
Next
|
||||
RawResults = New List(Of ResourceProject)(SearchResults)
|
||||
|
||||
'仅保留兼容 Forge 的 Mod，或老版本中没有标注任何 Mod Loader 的 Mod
|
||||
If IgnoreModLoaderFilter Then
|
||||
RawResults.KeepIf(Function(p) p.ModLoaders = ModLoaders.None OrElse p.ModLoaders.HasFlag(ModLoaders.Forge))
|
||||
End If
|
||||
|
||||
'确保存在结果
|
||||
Storage.ErrorMessage = Nothing
|
||||
If Not RawResults.Any() Then
|
||||
If Errors.Any() Then
|
||||
Throw Errors.First.Ex
|
||||
Else
|
||||
If IsChineseSearch AndAlso Not (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) Then
|
||||
Throw New Exception(MSG_NO_CHINESE_RESULT)
|
||||
ElseIf Request.Sources = ResourcePlatforms.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
|
||||
Throw New Exception("CurseForge 不兼容所选的类型")
|
||||
ElseIf Request.Sources = ResourcePlatforms.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
|
||||
Throw New Exception("Modrinth 不兼容所选的类型")
|
||||
Else
|
||||
Throw New Exception("没有搜索结果")
|
||||
End If
|
||||
End If
|
||||
ElseIf Errors.Any() Then
|
||||
'有结果但是有错误
|
||||
If Errors.Any(Function(e) e.Source = ResourcePlatforms.CurseForge) Then
|
||||
Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
|
||||
Else
|
||||
Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
|
||||
End If
|
||||
End If
|
||||
|
||||
Finally
|
||||
For Each Thread In WorkThreads
|
||||
If Thread.IsAlive Then Thread.Interrupt()
|
||||
Next
|
||||
End Try
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "提取非重复项，存储于 RealResults"
|
||||
|
||||
'将 CurseForge 排在 Modrinth 的前面，避免加载结束顺序不同导致排名不同
|
||||
RawResults = RawResults.Where(Function(x) x.Platform = ResourcePlatforms.CurseForge).Concat(RawResults.Where(Function(x) x.Platform <> ResourcePlatforms.CurseForge)).ToList
|
||||
'去重
|
||||
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)).ToList
|
||||
'已有内容去重
|
||||
RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
|
||||
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
|
||||
'加入列表
|
||||
RealResults.AddRange(RawResults)
|
||||
Logger.Info($"去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）")
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "检查结果数量，如果不足且可继续，会继续加载下一页"
|
||||
|
||||
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
|
||||
Logger.Info($"总结果数需求最少 {Request.TargetResultCount} 个，仅获得了 {RealResults.Count + Storage.Results.Count} 个")
|
||||
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试，这时候重试可能导致无限循环
|
||||
Logger.Info("将继续尝试加载下一页")
|
||||
GoTo NextPage
|
||||
Else
|
||||
Logger.Info("无法继续加载，将强制结束")
|
||||
End If
|
||||
End If
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "将结果排序并添加"
|
||||
|
||||
Dim Scores As New Dictionary(Of ResourceProject, Double) '排序分
|
||||
Dim GetDownloadCountMult =
|
||||
Function(Project As ResourceProject) As Double
|
||||
Select Case Request.Type
|
||||
Case ResourceTypes.Mod, ResourceTypes.ModPack
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 5)
|
||||
Case ResourceTypes.DataPack
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 10, 1)
|
||||
Case ResourceTypes.ResourcePack, ResourceTypes.Shader
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 4)
|
||||
Case Else
|
||||
Return 1
|
||||
End Select
|
||||
End Function
|
||||
If String.IsNullOrEmpty(RawSearchText) Then
|
||||
'如果没有搜索文本，按下载量将结果排序
|
||||
For Each Result As ResourceProject In RealResults
|
||||
Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
|
||||
Next
|
||||
Else
|
||||
'如果有搜索文本，按关联度将结果排序
|
||||
'排序分 = 搜索相对相似度 (1) + 下载量权重 (对数，10 亿时为 1) + 有中文名 (0.2)
|
||||
Dim SearchEntries As New List(Of SearchEntry(Of ResourceProject))
|
||||
For Each Result As ResourceProject In RealResults
|
||||
Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
|
||||
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
|
||||
SearchEntries.Add(New SearchEntry(Of ResourceProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split("/"c, True), 1),
|
||||
New SearchSource(Result.Description, 0.05)}})
|
||||
Next
|
||||
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
|
||||
For Each OneResult In SearchResult
|
||||
Scores(OneResult.Item) +=
|
||||
If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
|
||||
If(SearchResult.First.AbsoluteRight, 10, SearchResult.First.Similarity) '最高 1 分的相似度分
|
||||
Next
|
||||
End If
|
||||
'根据排序分得出结果并添加
|
||||
If Task.IsCanceled Then Throw New OperationCanceledException '#8246
|
||||
Storage.Results.AddRange(
|
||||
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
|
||||
|
||||
#End Region
|
||||
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,426 @@
|
||||
''' <summary>
|
||||
''' 社区资源的单个可下载版本。
|
||||
''' </summary>
|
||||
Public Class ResourceVersion
|
||||
|
||||
'基础字段
|
||||
|
||||
''' <summary>
|
||||
''' 用于唯一性鉴别该版本的 ID。CurseForge 中为 123456 的大整数，Modrinth 中为英文乱码的 Version 字段。
|
||||
''' </summary>
|
||||
Public Id As String
|
||||
''' <summary>
|
||||
''' 该版本所对应的单一资源类别。
|
||||
''' </summary>
|
||||
Public ResourceType As ResourceTypes
|
||||
|
||||
'描述性字段
|
||||
|
||||
''' <summary>
|
||||
''' 版本描述名。
|
||||
''' 并非文件名或版本号，是由上传者完全自定义的字段。
|
||||
''' </summary>
|
||||
Public Display As String
|
||||
''' <summary>
|
||||
''' 发布时间。
|
||||
''' </summary>
|
||||
Public ReleaseDate As Date
|
||||
''' <summary>
|
||||
''' 下载量计数。
|
||||
''' 注意，仅为一个平台的计数，无法反映多平台加起来的下载量，且 CurseForge 可能错误地返回 0。
|
||||
''' </summary>
|
||||
Public DownloadCount As Integer
|
||||
''' <summary>
|
||||
''' 版本号。
|
||||
''' 不一定是标准格式。CurseForge 默认为 Nothing。
|
||||
''' </summary>
|
||||
Public Version As String
|
||||
''' <summary>
|
||||
''' 所有支持的 Mod 加载器列表。可能为 <see cref="ModLoaders.None"/>。
|
||||
''' </summary>
|
||||
Public ModLoaders As ModLoaders = ModLoaders.None
|
||||
''' <summary>
|
||||
''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
|
||||
''' </summary>
|
||||
Public GameVersions As List(Of String)
|
||||
|
||||
''' <summary>
|
||||
''' 发布状态。
|
||||
''' </summary>
|
||||
Public ReleaseType As ReleaseTypes
|
||||
''' <summary>
|
||||
''' 发布状态的友好描述。
|
||||
''' 例如："正式版"，"Beta 版"。
|
||||
''' </summary>
|
||||
Public ReadOnly Property ReleaseTypeDisplay As String
|
||||
Get
|
||||
Select Case ReleaseType
|
||||
Case ReleaseTypes.Release
|
||||
Return "正式版"
|
||||
Case ReleaseTypes.Beta
|
||||
Return If(ModeDebug, "Beta 版", "测试版")
|
||||
Case Else
|
||||
Return If(ModeDebug, "Alpha 版", "早期测试版")
|
||||
End Select
|
||||
End Get
|
||||
End Property
|
||||
Public Enum ReleaseTypes
|
||||
'https://docs.curseforge.com/rest-api/#tocS_FileReleaseType
|
||||
Release = 1
|
||||
Beta = 2
|
||||
Alpha = 3
|
||||
End Enum
|
||||
|
||||
'下载信息
|
||||
|
||||
''' <summary>
|
||||
''' 下载信息是否可用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property DownloadAvailable As Boolean
|
||||
Get
|
||||
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 文件名。
|
||||
''' </summary>
|
||||
Public FileName As String = Nothing
|
||||
''' <summary>
|
||||
''' 对应文件的所有可能的下载 URL。
|
||||
''' </summary>
|
||||
Public DownloadUrls As List(Of String)
|
||||
''' <summary>
|
||||
''' 对应文件的 SHA1 或 MD5。
|
||||
''' </summary>
|
||||
Public Hash As String = Nothing
|
||||
''' <summary>
|
||||
''' 文件大小。不可用时为 -1。
|
||||
''' </summary>
|
||||
Public Size As Integer = -1
|
||||
''' <summary>
|
||||
''' 作为该版本依赖项的项目 ID。
|
||||
''' 它们可能没有加载，在加载后会添加到 Dependencies 中（主要是因为 Modrinth 返回的是字符串 ID 而非 Slug，导致 Project.Id 查询不到）。
|
||||
''' </summary>
|
||||
Private RawDependencies As New List(Of String)
|
||||
''' <summary>
|
||||
''' 作为该版本依赖项的项目 ID。
|
||||
''' </summary>
|
||||
Public Dependencies As New List(Of String)
|
||||
|
||||
'初始化
|
||||
|
||||
''' <summary>
|
||||
''' 从平台 API 返回的 JSON 中初始化实例。若出错会抛出异常。
|
||||
''' </summary>
|
||||
Public Shared Function FromPlatformJson(Data As JObject, ExpectedResourceType As ResourceTypes) As ResourceVersion
|
||||
Dim Result As New ResourceVersion
|
||||
With Result
|
||||
.ResourceType = ExpectedResourceType
|
||||
If Data.ContainsKey("gameId") Then
|
||||
#Region "CurseForge"
|
||||
'简单信息
|
||||
.Id = Data("id")
|
||||
.Display = Data("displayName").ToString.Replace(" ", "").Trim(" ")
|
||||
.Version = Nothing
|
||||
.ReleaseDate = Data("fileDate")
|
||||
.ReleaseType = CType(Data("releaseType").ToObject(Of Integer), ReleaseTypes)
|
||||
.DownloadCount = Data("downloadCount")
|
||||
.FileName = Data("fileName")
|
||||
.Size = Data("fileLength")
|
||||
.Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
|
||||
If .Hash Is Nothing Then .Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
|
||||
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, StringUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
.DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
|
||||
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") Then
|
||||
.RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
|
||||
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
|
||||
Select(Function(d) d("modId").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.Lower).ToList
|
||||
.GameVersions = RawVersions.
|
||||
Where(Function(v) McVersion.IsFormatFit(v)).
|
||||
Select(Function(v) v.Replace("-snapshot", " 预览版")).
|
||||
Distinct.ToList
|
||||
If .GameVersions.IsSingle Then
|
||||
.GameVersions = .GameVersions.ToList
|
||||
ElseIf .GameVersions.Count > 1 Then
|
||||
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
|
||||
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = { .GameVersions(0)}.ToList '整合包理应只 “支持” 一个版本
|
||||
Else
|
||||
.GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
'ModLoaders
|
||||
.ModLoaders = ModLoaders.None
|
||||
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
|
||||
If RawVersions.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
|
||||
Next
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
.Id = Data("id")
|
||||
.Display = Data("name").ToString.Replace(" ", "").Trim(" ")
|
||||
.Version = Data("version_number")
|
||||
.ReleaseDate = Data("date_published")
|
||||
.ReleaseType = If(Data("version_type").ToString = "release", ReleaseTypes.Release, If(Data("version_type").ToString = "beta", ReleaseTypes.Beta, ReleaseTypes.Alpha))
|
||||
.DownloadCount = Data("downloads")
|
||||
If CType(Data("files"), JArray).Any() Then '可能为空
|
||||
Dim File As JToken = Data("files")(0)
|
||||
.FileName = File("filename")
|
||||
.DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
|
||||
.Size = File("size")
|
||||
.Hash = File("hashes")("sha1")
|
||||
End If
|
||||
'类别与 Loaders
|
||||
'结果可能混杂着 Mod、数据包和服务端插件
|
||||
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
|
||||
.ModLoaders = ModLoaders.None
|
||||
For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
|
||||
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
|
||||
Next
|
||||
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
|
||||
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
|
||||
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
|
||||
If .ModLoaders.Flags().Any() Then .ResourceType = ResourceTypes.Mod
|
||||
Else
|
||||
'使用传入的类别，不作修改（#8377）
|
||||
End If
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") Then
|
||||
.RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
|
||||
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
|
||||
d("project_id").ToString.Length > 0). '有时候真的会空……
|
||||
Select(Function(d) d("project_id").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.Lower).ToList
|
||||
.GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
|
||||
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
|
||||
Distinct.ToList
|
||||
If .GameVersions.IsSingle Then
|
||||
'无需处理
|
||||
ElseIf .GameVersions.Count > 1 Then
|
||||
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
|
||||
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = New List(Of String) From { .GameVersions(0)} '整合包理应只 “支持” 一个版本
|
||||
ElseIf RawVersions.Any(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")) Then
|
||||
.GameVersions = RawVersions.Where(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")).ToList
|
||||
Else
|
||||
.GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
#End Region
|
||||
End If
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从项目 ID 获取其下的全部版本列表，并获取其前置项目信息。
|
||||
''' </summary>
|
||||
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms, Optional LoadDependencies As Boolean = True) As List(Of ResourceVersion)
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
|
||||
'获取项目对象的文件列表
|
||||
If Not ProjectFilesCache.ContainsKey(ProjectId) Then
|
||||
Logger.Info($"开始获取项目版本列表：{ProjectId}")
|
||||
Dim ResultJsonArray As JArray = Nothing
|
||||
If Platform = ResourcePlatforms.CurseForge Then
|
||||
For RetryCount As Integer = 0 To 2
|
||||
Dim ResultJson As JObject = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=" &
|
||||
(10000 + RetryCount)) '每次重试多请求一个文件，以避免触发 CDN 缓存
|
||||
'HMCL 一次性请求了 10000 个文件，虽然不知道会不会出问题但先这样吧……（#5522）
|
||||
'之前只请求一部分文件的方法备份如下：
|
||||
'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
|
||||
' ResultJsonArray = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json")("data")
|
||||
'Else '否则使用全部文件
|
||||
' ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999")("data")
|
||||
'End If
|
||||
If ResultJson("pagination")("resultCount").ToObject(Of Integer) = ResultJson("pagination")("totalCount").ToObject(Of Integer) Then
|
||||
ResultJsonArray = ResultJson("data")
|
||||
Exit For
|
||||
ElseIf RetryCount < 2 Then
|
||||
Logger.Warn($"CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试") '#6224
|
||||
Logger.Info($"返回的原始内容如下：{vbCrLf}{ResultJson}")
|
||||
Else
|
||||
Logger.Info($"CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}")
|
||||
Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
|
||||
End If
|
||||
Next
|
||||
Else 'Modrinth
|
||||
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
|
||||
End If
|
||||
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) FromPlatformJson(a, TargetProject.Types)).
|
||||
Where(Function(a) a.DownloadAvailable).
|
||||
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项（#1330）
|
||||
End If
|
||||
Dim Result As List(Of ResourceVersion) = ProjectFilesCache(ProjectId)
|
||||
If Not LoadDependencies Then Return Result
|
||||
'加载前置信息
|
||||
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
|
||||
If Dependencies.Any Then
|
||||
Logger.Info($"项目 {ProjectId} 中需要加载的前置：{Dependencies.Join("，")}")
|
||||
For Each DependencyProject In ResourceProject.FromProjectIds(Dependencies, TargetProject.Platform)
|
||||
For Each File In Result
|
||||
If File.RawDependencies.Contains(DependencyProject.Id) AndAlso DependencyProject.Id <> ProjectId AndAlso Not File.Dependencies.Contains(DependencyProject.Id) Then
|
||||
File.Dependencies.Add(DependencyProject.Id)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
End If
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 项目 ID 对应的版本信息的缓存。不会保存到文件。
|
||||
''' </summary>
|
||||
Protected Friend Shared ProjectFilesCache As New Dictionary(Of String, List(Of ResourceVersion))
|
||||
|
||||
'序列化
|
||||
|
||||
''' <summary>
|
||||
''' 从缓存 JSON 读取字段数据。
|
||||
''' </summary>
|
||||
Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion
|
||||
Dim Result As New ResourceVersion
|
||||
With Result
|
||||
.ResourceType = Data("ResourceType").ToObject(Of ResourceTypes)
|
||||
.Id = Data("Id").ToString
|
||||
.Display = Data("DisplayName").ToString
|
||||
If Data.ContainsKey("Version") Then .Version = Data("Version").ToString
|
||||
.ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
|
||||
.DownloadCount = Data("DownloadCount").ToObject(Of Integer)
|
||||
.ReleaseType = Data("ReleaseType").ToObject(Of ReleaseTypes)
|
||||
If Data.ContainsKey("FileName") Then .FileName = Data("FileName").ToString
|
||||
If Data.ContainsKey("DownloadUrls") Then .DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("ModLoaders") Then .ModLoaders = Data("ModLoaders").ToObject(Of ModLoaders)
|
||||
If Data.ContainsKey("Size") Then .Size = Data("Size").ToObject(Of Integer)
|
||||
If Data.ContainsKey("Hash") Then .Hash = Data("Hash").ToString
|
||||
If Data.ContainsKey("GameVersions") Then .GameVersions = Data("GameVersions").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("RawDependencies") Then .RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("Dependencies") Then .Dependencies = Data("Dependencies").ToObject(Of List(Of String))
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 转为缓存 JSON。
|
||||
''' </summary>
|
||||
Public Function ToCacheJson() As JObject
|
||||
Dim Result As New JObject
|
||||
With Result
|
||||
.Add("ResourceType", CInt(ResourceType))
|
||||
.Add("Id", Id)
|
||||
If Version IsNot Nothing Then .Add("Version", Version)
|
||||
.Add("DisplayName", Display)
|
||||
.Add("ReleaseDate", ReleaseDate)
|
||||
.Add("DownloadCount", DownloadCount)
|
||||
.Add("ModLoaders", CInt(ModLoaders))
|
||||
.Add("GameVersions", New JArray(GameVersions))
|
||||
.Add("ReleaseType", CInt(ReleaseType))
|
||||
If FileName IsNot Nothing Then .Add("FileName", FileName)
|
||||
If DownloadUrls IsNot Nothing Then .Add("DownloadUrls", New JArray(DownloadUrls))
|
||||
If Hash IsNot Nothing Then .Add("Hash", Hash)
|
||||
If Size >= 0 Then .Add("Size", Size)
|
||||
.Add("RawDependencies", New JArray(RawDependencies))
|
||||
.Add("Dependencies", New JArray(Dependencies))
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
'杂项
|
||||
|
||||
''' <summary>
|
||||
''' 转为列表项。
|
||||
''' </summary>
|
||||
Public Function ToListItem(ClickHandler As MyListItem.ClickEventHandler, Optional SaveAsButtonHandler As MyIconButton.ClickEventHandler = Nothing,
|
||||
Optional IsBadDisplay As Boolean = False) As MyVirtualizingElement(Of MyListItem)
|
||||
Return New MyVirtualizingElement(Of MyListItem)(
|
||||
Function()
|
||||
Dim Result As New MyListItem
|
||||
With Result
|
||||
|
||||
'基础属性
|
||||
.SnapsToDevicePixels = True
|
||||
.Height = 42
|
||||
.Type = MyListItem.CheckType.Clickable
|
||||
.Tag = Me
|
||||
.Title = If(IsBadDisplay, FileName, Display)
|
||||
.Logo = $"{PathImage}ReleaseTypes/{ReleaseType}.png"
|
||||
AddHandler .Click, ClickHandler
|
||||
'描述
|
||||
.Info =
|
||||
Iterator Function()
|
||||
If ModLoaders <> ModLoaders.None Then Yield ModLoaders.Flags.Join("、"c)
|
||||
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
|
||||
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
|
||||
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
|
||||
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount.ToString() + " ")}次" 'CurseForge 的下载次数经常错误地返回 0
|
||||
Yield $"更新于 {StringUtils.FormatTimeSpan(ReleaseDate - Date.Now, False)}"
|
||||
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
|
||||
End Function().Join("，"c)
|
||||
|
||||
'另存为按钮
|
||||
If SaveAsButtonHandler IsNot Nothing Then
|
||||
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
|
||||
AddHandler BtnSave.Click, SaveAsButtonHandler
|
||||
.Buttons = {BtnSave}
|
||||
End If
|
||||
|
||||
End With
|
||||
Return Result
|
||||
End Function) With {.Height = 42}
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 获取下载信息。
|
||||
''' </summary>
|
||||
''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
|
||||
Public Function ToNetFile(LocalFileOrFolder As String,
|
||||
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
|
||||
Return New NetFile(
|
||||
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
|
||||
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
|
||||
New FileChecker With {.Hash = Hash, .ActualSize = Size},
|
||||
SimulateBrowserHeaders:=True)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 添加 Modrinth 追踪参数。
|
||||
''' </summary>
|
||||
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String),
|
||||
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
|
||||
Dim Arguments As New Dictionary(Of String, String)
|
||||
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
|
||||
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
|
||||
If TrackLoader.Flags.Any Then Arguments.Add("mr_loader", TrackLoader.Flags.First.ToString.Lower)
|
||||
Dim Argument = Arguments.Select(Function(a) $"{a.Key}={a.Value}").Join("&")
|
||||
For Each Url In Urls
|
||||
If Not Url.ContainsIgnoreCase("cdn.modrinth.com/") Then Yield Url
|
||||
Yield $"{Url}{If(Url.Contains("?"), "&", "?")}{Argument}"
|
||||
Next
|
||||
End Function
|
||||
Public Enum DownloadReason
|
||||
Standalone
|
||||
Dependency
|
||||
ModPack
|
||||
Update
|
||||
End Enum
|
||||
''' <summary>
|
||||
''' 重新整理 CurseForge 的下载地址。
|
||||
''' </summary>
|
||||
Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String)
|
||||
Return {
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
|
||||
Url.Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
|
||||
Url.Replace("://media.", "://edge."),
|
||||
Url
|
||||
}.Distinct.ToList
|
||||
End Function
|
||||
Public Overrides Function ToString() As String
|
||||
Return $"{Id}: {FileName}"
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,151 @@
|
||||
'来源：https://blog.csdn.net/simpleman2000/article/details/140952294
|
||||
|
||||
Imports System.ComponentModel
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Windows.Interop
|
||||
|
||||
Public Class DragHelper
|
||||
|
||||
Public Event DragDrop As EventHandler
|
||||
|
||||
Public Property DropFilePaths As String()
|
||||
Get
|
||||
Return _DropFilePathsBackingField
|
||||
End Get
|
||||
Private Set(value As String())
|
||||
_DropFilePathsBackingField = value
|
||||
End Set
|
||||
End Property
|
||||
Private _DropFilePathsBackingField As String()
|
||||
|
||||
Public Property DropPoint As POINT
|
||||
Get
|
||||
Return _DropPointBackingField
|
||||
End Get
|
||||
Private Set(value As POINT)
|
||||
_DropPointBackingField = value
|
||||
End Set
|
||||
End Property
|
||||
Private _DropPointBackingField As POINT
|
||||
|
||||
Public Property HwndIntPtrSource As HwndSource
|
||||
|
||||
Public Sub AddHook()
|
||||
RemoveDragHook()
|
||||
HwndIntPtrSource.AddHook(AddressOf WndProc)
|
||||
Dim handle As IntPtr = HwndIntPtrSource.Handle
|
||||
If IsUserAnAdmin() Then RevokeDragDrop(handle)
|
||||
DragAcceptFiles(handle, True)
|
||||
ChangeMessageFilter(handle)
|
||||
End Sub
|
||||
|
||||
Public Sub RemoveDragHook()
|
||||
HwndIntPtrSource.RemoveHook(AddressOf WndProc)
|
||||
DragAcceptFiles(HwndIntPtrSource.Handle, False)
|
||||
End Sub
|
||||
|
||||
Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
|
||||
Dim filePaths As String() = Nothing
|
||||
Dim point As New POINT()
|
||||
|
||||
If TryGetDropInfo(msg, wParam, filePaths, point) Then
|
||||
DropPoint = point
|
||||
DropFilePaths = filePaths
|
||||
RaiseEvent DragDrop(Me, EventArgs.Empty)
|
||||
handled = True
|
||||
End If
|
||||
Return IntPtr.Zero
|
||||
End Function
|
||||
|
||||
<DllImport("user32.dll", SetLastError:=True)>
|
||||
Private Shared Function ChangeWindowMessageFilterEx(hWnd As IntPtr, msg As UInteger, action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
|
||||
End Function
|
||||
|
||||
<DllImport("user32.dll", SetLastError:=True)>
|
||||
Private Shared Function ChangeWindowMessageFilter(msg As UInteger, flags As UInteger) As Boolean
|
||||
End Function
|
||||
|
||||
<DllImport("shell32.dll")>
|
||||
Private Shared Sub DragAcceptFiles(hWnd As IntPtr, fAccept As Boolean)
|
||||
End Sub
|
||||
|
||||
<DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
|
||||
Private Shared Function DragQueryFile(hWnd As IntPtr, iFile As UInteger, lpszFile As StringBuilder, cch As Integer) As UInteger
|
||||
End Function
|
||||
|
||||
<DllImport("shell32.dll")>
|
||||
Private Shared Function DragQueryPoint(hDrop As IntPtr, ByRef lppt As POINT) As Boolean
|
||||
End Function
|
||||
|
||||
<DllImport("shell32.dll")>
|
||||
Private Shared Sub DragFinish(hDrop As IntPtr)
|
||||
End Sub
|
||||
|
||||
<DllImport("ole32.dll")>
|
||||
Private Shared Function RevokeDragDrop(hWnd As IntPtr) As Integer
|
||||
End Function
|
||||
|
||||
<DllImport("shell32.dll")>
|
||||
Private Shared Function IsUserAnAdmin() As Boolean
|
||||
End Function
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)>
|
||||
Public Structure POINT
|
||||
Public X As Integer
|
||||
Public Y As Integer
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)>
|
||||
Private Structure CHANGEFILTERSTRUCT
|
||||
Public cbSize As UInteger
|
||||
Public ExtStatus As UInteger
|
||||
End Structure
|
||||
|
||||
Private Const WM_COPYGLOBALDATA As UInteger = &H49
|
||||
Private Const WM_COPYDATA As UInteger = &H4A
|
||||
Private Const WM_DROPFILES As UInteger = &H233
|
||||
Private Const MSGFLT_ALLOW As UInteger = 1
|
||||
Private Const MSGFLT_ADD As UInteger = 1
|
||||
Private Const MAX_PATH As Integer = 260
|
||||
|
||||
Private Shared Sub ChangeMessageFilter(handle As IntPtr)
|
||||
Dim ver As Version = Environment.OSVersion.Version
|
||||
Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
|
||||
Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
|
||||
|
||||
If isVistaOrHigher Then
|
||||
Dim status As New CHANGEFILTERSTRUCT With {.cbSize = 8}
|
||||
For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
|
||||
Dim [error] As Boolean = False
|
||||
If isNt61OrHiger Then
|
||||
[error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
|
||||
Else
|
||||
[error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
|
||||
End If
|
||||
|
||||
If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Shared Function TryGetDropInfo(msg As Integer, wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
|
||||
dropFilePaths = Nothing
|
||||
dropPoint = New POINT()
|
||||
|
||||
If msg <> WM_DROPFILES Then Return False
|
||||
|
||||
Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
|
||||
ReDim dropFilePaths(CInt(fileCount) - 1)
|
||||
|
||||
For i As UInteger = 0 To CInt(fileCount) - 1
|
||||
Dim sb As New StringBuilder(MAX_PATH)
|
||||
Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
|
||||
If result > 0 Then dropFilePaths(i) = sb.ToString()
|
||||
Next
|
||||
|
||||
DragQueryPoint(wParam, dropPoint)
|
||||
DragFinish(wParam)
|
||||
Return True
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -9,10 +9,10 @@ Imports System.Runtime.InteropServices
|
||||
'查看程序集特性的值
|
||||
|
||||
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
|
||||
<Assembly: AssemblyDescription("Minecraft 启动器 (制作：龙腾猫跃)")>
|
||||
<Assembly: AssemblyDescription("Minecraft 启动器")>
|
||||
<Assembly: AssemblyCompany("")>
|
||||
<Assembly: AssemblyProduct("Plain Craft Launcher")>
|
||||
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
|
||||
<Assembly: AssemblyCopyright("Copyright © 成都瓜皮龙科技有限公司")>
|
||||
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
|
||||
<Assembly: ComVisible(False)>
|
||||
|
||||
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
|
||||
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
|
||||
' 方法是按如下所示使用“*”
|
||||
|
||||
<Assembly: AssemblyVersion("2.10.0.0")>
|
||||
<Assembly: AssemblyFileVersion("2.10.0.0")>
|
||||
<Assembly: AssemblyVersion("2.13.0.1")>
|
||||
<Assembly: AssemblyFileVersion("2.13.0.1")>
|
||||
<Assembly: NeutralResourcesLanguage("")>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
#If _MyType <> "Empty" Then
|
||||
#If _MyType <> "Empty" Then
|
||||
|
||||
Namespace My
|
||||
''' <summary>
|
||||
|
||||
+98
-18
@@ -1,4 +1,4 @@
|
||||
'------------------------------------------------------------------------------
|
||||
'------------------------------------------------------------------------------
|
||||
' <auto-generated>
|
||||
' 此代码由工具生成。
|
||||
' 运行时版本:4.0.30319.42000
|
||||
@@ -63,9 +63,9 @@ Namespace My.Resources
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Custom() As Byte()
|
||||
Friend ReadOnly Property CacheCow_Client() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
|
||||
Dim obj As Object = ResourceManager.GetObject("CacheCow.Client", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
@@ -73,9 +73,39 @@ Namespace My.Resources
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Dialogs() As Byte()
|
||||
Friend ReadOnly Property CacheCow_Client_FileStore() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Dialogs", resourceCulture)
|
||||
Dim obj As Object = ResourceManager.GetObject("CacheCow.Client.FileStore", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property CacheCow_Common() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("CacheCow.Common", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property ThrottleDebounce() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("ThrottleDebounce", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Custom() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
@@ -105,7 +135,7 @@ Namespace My.Resources
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Imazen_WebP() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture)
|
||||
Dim obj As Object = ResourceManager.GetObject("Imazen.WebP", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
@@ -120,16 +150,6 @@ Namespace My.Resources
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Json() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
@@ -143,9 +163,29 @@ Namespace My.Resources
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property ModData() As Byte()
|
||||
Friend ReadOnly Property LUA() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("ModData", resourceCulture)
|
||||
Dim obj As Object = ResourceManager.GetObject("LUA", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property MeloongCore() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("MeloongCore", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property MeloongCore_Wpf() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("MeloongCore.Wpf", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
@@ -160,6 +200,46 @@ Namespace My.Resources
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Newtonsoft_Json() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Newtonsoft.Json", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property Ookii_Dialogs_Wpf() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("Ookii.Dialogs.Wpf", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property PCLCS() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("PCLCS", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
Friend ReadOnly Property System_Net_Http_Formatting() As Byte()
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("System.Net.Http.Formatting", resourceCulture)
|
||||
Return CType(obj,Byte())
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' 查找 System.Byte[] 类型的本地化资源。
|
||||
'''</summary>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
@@ -118,37 +118,61 @@
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
|
||||
<data name="CacheCow.Client" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\CacheCow.Client.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="CacheCow.Client.FileStore" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\CacheCow.Client.FileStore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="ThrottleDebounce" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\ThrottleDebounce.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Dialogs" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="ForgeInstaller" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Imazen_WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<data name="Imazen.WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
<data name="LUA" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\lwjgl-unsafe-agent.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="MeloongCore" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\..\PCLCS\bin\MeloongCore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="MeloongCore.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\..\PCLCS\bin\MeloongCore.Wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Newtonsoft.Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Ookii.Dialogs.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="PCLCS" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\..\PCLCS\bin\PCLCS.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</data>
|
||||
</root>
|
||||
</root>
|
||||
|
||||
+1
-1
@@ -1,4 +1,4 @@
|
||||
'------------------------------------------------------------------------------
|
||||
'------------------------------------------------------------------------------
|
||||
' <auto-generated>
|
||||
' 此代码由工具生成。
|
||||
' 运行时版本:4.0.30319.42000
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<?xml version='1.0' encoding='utf-8'?>
|
||||
<?xml version='1.0' encoding='utf-8'?>
|
||||
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
|
||||
<Profiles>
|
||||
<Profile Name="(Default)" />
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1">
|
||||
<assemblyIdentity version="1.0.0.0" name="MyApplication.app" />
|
||||
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
|
||||
|
||||
@@ -1,444 +0,0 @@
|
||||
Public Class PageDownloadCompDetail
|
||||
Private CompItem As MyCompItem = Nothing
|
||||
|
||||
#Region "加载器"
|
||||
|
||||
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
|
||||
"Comp File",
|
||||
Sub(Task)
|
||||
LoadTargetFromAdditional()
|
||||
Task.Output = CompFilesGet(Project.Id, Project.FromCurseForge)
|
||||
End Sub)
|
||||
|
||||
'初始化加载器信息
|
||||
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
|
||||
LoadTargetFromAdditional()
|
||||
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
|
||||
End Sub
|
||||
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
|
||||
Project = FrmMain.PageCurrent.Additional(0)
|
||||
TargetVersion = FrmMain.PageCurrent.Additional(2)
|
||||
TargetLoader = FrmMain.PageCurrent.Additional(3)
|
||||
PageType = FrmMain.PageCurrent.Additional(4)
|
||||
End Sub
|
||||
Private Project As CompProject
|
||||
Private TargetVersion As String, TargetLoader As CompModLoaderType
|
||||
''' <summary>
|
||||
''' 当前页面应展示的内容类别。可能为 Any。
|
||||
''' </summary>
|
||||
Private PageType As CompType
|
||||
'自动重试
|
||||
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
|
||||
Select Case CompFileLoader.State
|
||||
Case LoadState.Failed
|
||||
Dim ErrorMessage As String = ""
|
||||
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
|
||||
If ErrorMessage.Contains("不是有效的 json 文件") Then
|
||||
Log("[Comp] 下载的文件 json 列表损坏，已自动重试", LogLevel.Debug)
|
||||
PageLoaderRestart()
|
||||
End If
|
||||
End Select
|
||||
End Sub
|
||||
'结果 UI 化
|
||||
Private Class CardSorter
|
||||
Implements IComparer(Of String)
|
||||
Public Topmost As String = ""
|
||||
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
|
||||
'相同
|
||||
If x = y Then Return 0
|
||||
'置顶
|
||||
If x = Topmost Then Return -1
|
||||
If y = Topmost Then Return 1
|
||||
'特殊版本
|
||||
Dim IsXSpecial As Boolean = x.EndsWithF("版本")
|
||||
Dim IsYSpecial As Boolean = y.EndsWithF("版本")
|
||||
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
|
||||
If IsXSpecial Then Return 1
|
||||
If IsYSpecial Then Return -1
|
||||
'比较版本号
|
||||
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
|
||||
If VersionCodeSort <> 0 Then Return VersionCodeSort
|
||||
'比较全部
|
||||
Return -VersionSortInteger(x, y)
|
||||
End Function
|
||||
Public Sub New(Optional Topmost As String = "")
|
||||
Me.Topmost = If(Topmost, "")
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
Private VersionFilter As String
|
||||
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选（1.21 / 1.20 / 1.19 / ...）而非小版本号（1.21.1 / 1.21 / 1.20.4 / ...）
|
||||
'筛选类型相同的结果（Modrinth 会返回 Mod、服务端插件、数据包混合的列表）
|
||||
Private Function GetResults() As List(Of CompFile)
|
||||
Dim Results As List(Of CompFile) = CompFileLoader.Output
|
||||
If PageType = CompType.Any Then
|
||||
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
|
||||
Else
|
||||
Results = Results.Where(Function(r) r.Type = PageType).ToList
|
||||
End If
|
||||
Return Results
|
||||
End Function
|
||||
Private Sub Load_OnFinish()
|
||||
Dim Results = GetResults()
|
||||
|
||||
'初始化筛选器
|
||||
Dim VersionFilters As List(Of String)
|
||||
|
||||
'按小版本号筛选？
|
||||
IsMajorVersionFilter = False
|
||||
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
|
||||
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
|
||||
'按大版本号筛选？
|
||||
If VersionFilters.Count >= 9 Then
|
||||
IsMajorVersionFilter = True
|
||||
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
|
||||
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
|
||||
End If
|
||||
|
||||
'UI 化筛选器
|
||||
PanFilter.Children.Clear()
|
||||
If VersionFilters.Count < 2 Then
|
||||
CardFilter.Visibility = Visibility.Collapsed
|
||||
VersionFilter = Nothing
|
||||
Else
|
||||
CardFilter.Visibility = Visibility.Visible
|
||||
VersionFilters.Insert(0, "全部")
|
||||
'转化为按钮
|
||||
For Each Version As String In VersionFilters
|
||||
Dim NewButton As New MyRadioButton With {
|
||||
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
|
||||
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0)
|
||||
AddHandler NewButton.Check,
|
||||
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
|
||||
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
|
||||
UpdateFilterResult()
|
||||
End Sub
|
||||
PanFilter.Children.Add(NewButton)
|
||||
Next
|
||||
'自动选择
|
||||
Dim ToCheck As MyRadioButton = Nothing
|
||||
If TargetVersion <> "" Then
|
||||
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
|
||||
If TargetFile IsNot Nothing Then
|
||||
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
|
||||
For Each Button As MyRadioButton In PanFilter.Children
|
||||
If Button.Text <> TargetGroup Then Continue For
|
||||
ToCheck = Button
|
||||
Exit For
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0)
|
||||
ToCheck.Checked = True
|
||||
End If
|
||||
|
||||
'更新筛选结果（文件列表 UI 化）
|
||||
UpdateFilterResult()
|
||||
End Sub
|
||||
Private Sub UpdateFilterResult()
|
||||
Dim Results = GetResults()
|
||||
|
||||
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
|
||||
$"所选版本：{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
|
||||
'归类到卡片下
|
||||
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
|
||||
Dict.Add("其他版本", New List(Of CompFile))
|
||||
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
|
||||
For Each Version As CompFile In Results
|
||||
For Each GameVersion In Version.GameVersions
|
||||
'检查是否符合版本筛选器
|
||||
If VersionFilter IsNot Nothing AndAlso
|
||||
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
|
||||
'决定添加到哪个卡片
|
||||
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
|
||||
'遍历加入的加载器列表
|
||||
Dim Loaders As New List(Of String)
|
||||
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
|
||||
Version.Type = CompType.Mod AndAlso '是 Mod
|
||||
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
|
||||
For Each Loader In Version.ModLoaders
|
||||
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
|
||||
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
|
||||
Next
|
||||
End If
|
||||
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里
|
||||
'实际添加
|
||||
For Each Loader In Loaders
|
||||
Dim TargetCard As String = Loader & VerName
|
||||
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
|
||||
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
|
||||
Next
|
||||
Next
|
||||
Next
|
||||
'添加筛选的版本的卡片
|
||||
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then
|
||||
Dict.Add(TargetCardName, New List(Of CompFile))
|
||||
For Each Version As CompFile In Results
|
||||
If Version.GameVersions.Contains(TargetVersion) AndAlso
|
||||
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
|
||||
'检查是否符合版本筛选器
|
||||
If VersionFilter IsNot Nothing AndAlso
|
||||
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For
|
||||
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
'转化为 UI
|
||||
Try
|
||||
PanResults.Children.Clear()
|
||||
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装，8 是另存为
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
NewCard.Children.Add(NewStack)
|
||||
NewCard.SwapControl = NewStack
|
||||
PanResults.Children.Add(NewCard)
|
||||
'确定卡片是否展开
|
||||
If Pair.Key = TargetCardName OrElse
|
||||
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
|
||||
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
|
||||
MyCard.StackInstall(NewStack, If(PageType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装，8 是另存为
|
||||
Else
|
||||
NewCard.IsSwaped = True
|
||||
End If
|
||||
'增加提示
|
||||
If Pair.Key = "其他版本" Then
|
||||
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢，可能无法识别刚更新的 MC 版本，只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
|
||||
End If
|
||||
Next
|
||||
'如果只有一张卡片，展开第一张卡片
|
||||
If PanResults.Children.Count = 1 Then
|
||||
CType(PanResults.Children(0), MyCard).IsSwaped = False
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
|
||||
If Name Is Nothing Then
|
||||
Return "其他版本"
|
||||
ElseIf Name.Contains("w") Then
|
||||
Return "快照版本"
|
||||
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
|
||||
Return "远古版本"
|
||||
Else
|
||||
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
|
||||
End If
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
Private IsFirstInit As Boolean = True
|
||||
Public Sub Init() Handles Me.PageEnter
|
||||
AniControlEnabled += 1
|
||||
Project = FrmMain.PageCurrent.Additional(0)
|
||||
PanBack.ScrollToHome()
|
||||
|
||||
'重启加载器
|
||||
If IsFirstInit Then
|
||||
'在 Me.Initialized 已经初始化了加载器，不再重复初始化
|
||||
IsFirstInit = False
|
||||
Else
|
||||
PageLoaderRestart(IsForceRestart:=True)
|
||||
End If
|
||||
|
||||
'放置当前工程
|
||||
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
|
||||
CompItem = Project.ToCompItem(True, True)
|
||||
CompItem.CanInteraction = False
|
||||
CompItem.Margin = New Thickness(-7, -7, 0, 8)
|
||||
PanIntro.Children.Insert(0, CompItem)
|
||||
|
||||
'决定按钮显示
|
||||
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
|
||||
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
|
||||
|
||||
AniControlEnabled -= 1
|
||||
End Sub
|
||||
|
||||
'整合包安装
|
||||
Public Sub Install_Click(sender As MyListItem, e As EventArgs)
|
||||
Try
|
||||
|
||||
'获取基本信息
|
||||
Dim File As CompFile = sender.Tag
|
||||
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载：{Project.TranslatedName} "
|
||||
|
||||
'获取版本名
|
||||
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
|
||||
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})
|
||||
If String.IsNullOrEmpty(VersionName) Then Exit Sub
|
||||
|
||||
'构造步骤加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
|
||||
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
|
||||
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
|
||||
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
|
||||
Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
|
||||
Sub(MyLoader)
|
||||
Select Case MyLoader.State
|
||||
Case LoadState.Failed
|
||||
Hint(MyLoader.Name & "失败：" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
|
||||
Case LoadState.Aborted
|
||||
Hint(MyLoader.Name & "已取消！", HintType.Info)
|
||||
Case LoadState.Loading
|
||||
Exit Sub '不重新加载版本列表
|
||||
End Select
|
||||
McInstallFailedClearFolder(MyLoader)
|
||||
End Sub}
|
||||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
'资源下载；整合包另存为
|
||||
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
|
||||
Public Sub Save_Click(sender As Object, e As EventArgs)
|
||||
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim Desc As String = Nothing
|
||||
Select Case File.Type
|
||||
Case CompType.ModPack : Desc = "整合包"
|
||||
Case CompType.Mod : Desc = "Mod "
|
||||
Case CompType.ResourcePack : Desc = "资源包"
|
||||
Case CompType.Shader : Desc = "光影包"
|
||||
Case CompType.DataPack : Desc = "数据包"
|
||||
End Select
|
||||
'确认默认保存位置
|
||||
Dim DefaultFolder As String = Nothing
|
||||
If File.Type = CompType.Mod Then
|
||||
'获取 Mod 所需的加载器种类
|
||||
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
|
||||
If File.ModLoaders.Any Then '从文件中获取
|
||||
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
|
||||
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
|
||||
ElseIf Project.ModLoaders.Any Then '从工程中获取
|
||||
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
|
||||
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
|
||||
End If
|
||||
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
|
||||
AllowFabric IsNot Nothing AndAlso Not AllowFabric Then
|
||||
AllowForge = Nothing : AllowFabric = Nothing
|
||||
End If
|
||||
Log("[Comp] 允许 Forge：" & If(AllowForge, "未知") & "，允许 Fabric：" & If(AllowFabric, "未知"))
|
||||
'判断某个版本是否符合要求
|
||||
Dim IsVersionSuitable As Func(Of McVersion, Boolean) =
|
||||
Function(Version)
|
||||
If Not Version.IsLoaded Then Version.Load()
|
||||
If Not Version.Modable Then Return False
|
||||
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
|
||||
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
|
||||
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
|
||||
If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
|
||||
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
|
||||
Return False
|
||||
End Function
|
||||
'获取 Mod 默认下载位置
|
||||
If CachedFolder IsNot Nothing Then
|
||||
DefaultFolder = CachedFolder
|
||||
Log("[Comp] 使用上次下载时的文件夹作为默认下载位置")
|
||||
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
|
||||
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
|
||||
Directory.CreateDirectory(DefaultFolder)
|
||||
Log("[Comp] 使用当前版本的 mods 文件夹作为默认下载位置（" & McVersionCurrent.Name & "）")
|
||||
Else
|
||||
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
|
||||
If NeedLoad Then
|
||||
Hint("正在查找适合的游戏版本……")
|
||||
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||||
End If
|
||||
Dim SuitableVersions As New List(Of McVersion)
|
||||
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
|
||||
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
|
||||
Next
|
||||
If Not SuitableVersions.Any() Then
|
||||
DefaultFolder = PathMcFolder
|
||||
If NeedLoad Then
|
||||
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本！")
|
||||
Else
|
||||
Log("[Comp] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
|
||||
End If
|
||||
Else '选择 Mod 数量最多的版本
|
||||
Dim SelectedVersion = SuitableVersions.OrderBy(
|
||||
Function(v)
|
||||
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
|
||||
Return If(Info.Exists, Info.GetFiles().Length, -1)
|
||||
End Function).LastOrDefault()
|
||||
DefaultFolder = SelectedVersion.PathIndie & "mods\"
|
||||
Directory.CreateDirectory(DefaultFolder)
|
||||
Log("[Comp] 使用适合的游戏版本作为默认下载位置（" & SelectedVersion.Name & "）")
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
'获取基本信息
|
||||
Dim FileName As String
|
||||
If Project.TranslatedName = Project.RawName Then
|
||||
FileName = File.FileName
|
||||
Else
|
||||
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
|
||||
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
|
||||
Select Case Setup.Get("ToolDownloadTranslateV2")
|
||||
Case 0
|
||||
FileName = $"【{ChineseName}】{File.FileName}"
|
||||
Case 1
|
||||
FileName = $"[{ChineseName}] {File.FileName}"
|
||||
Case 2
|
||||
FileName = $"{ChineseName}-{File.FileName}"
|
||||
Case 3
|
||||
FileName = $"{File.FileName}-{ChineseName}"
|
||||
Case Else
|
||||
FileName = File.FileName
|
||||
End Select
|
||||
End If
|
||||
RunInUi(
|
||||
Sub()
|
||||
'弹窗要求选择保存位置
|
||||
Dim Target As String
|
||||
Target = SelectSaveFile("选择保存位置", FileName,
|
||||
Desc & "文件|" &
|
||||
If(File.Type = CompType.Mod,
|
||||
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
|
||||
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
|
||||
If Not Target.Contains("\") Then Exit Sub
|
||||
'构造步骤加载器
|
||||
Dim LoaderName As String = Desc & "下载：" & GetFileNameWithoutExtentionFromPath(Target) & " "
|
||||
If Target <> DefaultFolder AndAlso File.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
|
||||
Loader.Start(1)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub)
|
||||
Catch ex As Exception
|
||||
Log(ex, "保存资源文件失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Download CompDetail Save")
|
||||
End Sub
|
||||
|
||||
Private Sub BtnIntroWeb_Click(sender As Object, e As EventArgs) Handles BtnIntroWeb.Click
|
||||
OpenWebsite(Project.Website)
|
||||
End Sub
|
||||
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
|
||||
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
|
||||
End Sub
|
||||
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
|
||||
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user