Merge branch 'main' into main

This commit is contained in:
龙腾猫跃
2026-07-17 12:34:06 +08:00
committed by GitHub
264 changed files with 28550 additions and 22601 deletions
+20 -1
View File
@@ -1,4 +1,23 @@
[*.{cs,vb}]
# 如果要从更高级别的目录继承 .editorconfig 设置,请删除以下行
root = true
[*]
charset = utf-8
[*.cs]
# IDE0320: 使匿名函数成为静态函数
csharp_prefer_static_anonymous_function = false
# CS8618: 在退出构造函数时,不可为 null 的字段必须包含非 null 值。请考虑添加 "required" 修饰符或声明为可为 null。
dotnet_diagnostic.CS8618.severity = suggestion
# IDE0305: 使用 [.. ] 简化集合初始化
dotnet_diagnostic.IDE0305.severity = none
# CS8524: switch 表达式不会处理其输入类型的某些值(它不是穷举),这包括未命名的枚举值。
dotnet_diagnostic.CS8524.severity = suggestion
[*.{cs,vb}]
# IDE0028: 简化集合初始化
dotnet_style_collection_initializer = true:silent
# IDE0130: 命名空间与文件夹结构不匹配
dotnet_diagnostic.IDE0130.severity = silent
+1 -1
View File
@@ -1,3 +1,3 @@
# These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat']
custom: ['https://meloong.com/afd/a/LTCat']
+2 -2
View File
@@ -8,11 +8,11 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的游戏崩溃基本不是 PCL 的原因,请 **不要** 提交反馈。你可以在论坛或社区找人求助,但这里并不是你求助的地方。"
- label: "**我所启动的游戏不是整合包,且未安装任何 Mod。** 安装 Mod 后的崩溃基本不是 PCL 导致的,请 **不要** 提交反馈。你可以前往 [PCL 汉医堂](https://qm.qq.com/q/JJTzwEAmcw) 等民间 QQ 群求助,但这里不是求助的地方……"
required: false
- label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+1 -1
View File
@@ -12,7 +12,7 @@ body:
required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+1 -1
View File
@@ -8,7 +8,7 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true
- type: textarea
id: "yml-2"
+2 -2
View File
@@ -8,9 +8,9 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一建议未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一建议未被提交过。"
required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
- label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
required: true
- type: textarea
id: "yml-2"
+3 -3
View File
@@ -1,14 +1,14 @@
blank_issues_enabled: false
contact_links:
- name: 主页预设反馈
url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页
url: https://github.com/Meloong-Git/PCL/discussions/categories/自定义主页
about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈
- name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
- name: 提问
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE
url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE
about: 我想问一些 PCL 相关的问题……
- name: 讨论
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E8%AE%A8%E8%AE%BA
url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E8%AE%A8%E8%AE%BA
about: 我想讨论一些 PCL 相关的事情……
+2 -2
View File
@@ -8,9 +8,9 @@ body:
label: "检查项"
description: "请逐个检查下列项目,并勾选确认。"
options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一提案未被提交过。"
- label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一提案未被提交过。"
required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
- label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
required: true
- label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
required: true
+10 -7
View File
@@ -21,9 +21,10 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v4
uses: actions/checkout@v6
with:
fetch-depth: 0
fetch-depth: 1
submodules: true
- name: Set Describe
shell: bash
@@ -32,13 +33,12 @@ jobs:
echo "describe=$describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2
uses: microsoft/setup-msbuild@v3
with:
msbuild-architecture: x64
- name: Update Help
run: |
$workpath = [System.Environment]::CurrentDirectory
Set-Location ..
git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
Set-Location PCL2Help
@@ -52,15 +52,18 @@ jobs:
- name: Replace
run: |
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")', 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "${{ secrets.CLIENT_ID }}")' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")', 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "${{ secrets.CURSEFORGE_API_KEY }}")' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb"
- name: Restore NuGet Packages
run: dotnet restore PCLCS\PCLCS.csproj
- name: Build
run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }}
- name: Upload a Build Artifact
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v7
with:
name: ${{ matrix.configuration }} ${{ env.describe }}
path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe
+3
View File
@@ -0,0 +1,3 @@
[submodule "MeloongCore"]
path = MeloongCore
url = https://github.com/Meloong-Git/MeloongCore.git
+30 -14
View File
@@ -1,11 +1,30 @@
一、声明
《PCL 分发有限许可》
本文件仅作为指南,不是法律文件或协议。但开发者在此承诺,在您遵守本指南且善意、合理使用的情况下,不会追究您的责任。
法律上,开发者仍保留所有权利(All Rights Reserved),若情况恶劣,仍可能将诉讼作为最终手段。
版权所有 © 成都瓜皮龙科技有限公司(以下简称 “许可方”)。
除本许可明确授予的权利外,许可方保留软件及其相关知识产权中的全部权利。
一、定义
“软件” 是指 Plain Craft Launcher(以下简称 “PCL”)及许可方有权许可的相关源代码、二进制文件、资源文件、文档和随附内容。软件不包括已明确标注为第三方内容的部分,本许可亦不限制第三方内容原有许可证所明确授予的权利。
“原样副本” 是指未经任何方式改变的软件副本。传输、存储、镜像、压缩或解压原样副本,不视为改变。
“以软件为收费主体” 是指以获得、下载、复制、分发、安装、预装或使用原样副本本身为主要对价或条件,直接或间接向接收者收取费用,包括但不限于付费下载、会员访问门槛、强制赞助或其他变相收费方式。
- 若软件仅作为其他相对于软件具有完全独立的价值的内容、产品或服务的附带组成部分,且收费主要针对该内容、产品或服务,则不视为以软件为收费主体。
- 承载平台通过一般广告、一般赞助、平台服务或其他独立业务取得收入,则不视为以软件为收费主体。
二、轻度使用
二、权利
本许可适用于对软件进行复制、分发或其他被明确授权的行为。您行使本许可明确授予的任何权利,即表示同意遵守本许可。
在不以软件为收费主体的前提下,许可方授予您一项全球范围内、非排他、免版税、不得再许可的有限许可:您可以存储、镜像、备份、上传、下载、向公众提供、传播和再分发原样副本。
每一位从您处获得原样副本的接收者,均可在遵守本许可的前提下,直接从许可方获得本许可明确授予的相应权利。
————————————————————————————————————
《PCL 存储库合理使用指南》
本指南仅作为说明,不是法律文件或协议。
除《PCL 分发有限许可》明确授予的权利外,开发者保留软件及其相关知识产权中的全部权利。但开发者承诺,在遵守本指南,且善意、合理使用的情况下,不会追究责任。
一、轻度使用
若您仅参考了本存储库中极小部分的内容,或您在制作与 PCL 的实质功能不存在任何重叠的软件,则为轻度使用。
其常见情形例如:
@@ -15,11 +34,9 @@
若属于轻度使用,您需要:
1、以适当的形式给出署名。
2、不得将您的内容与 PCL 混淆,或暗示您的内容与 PCL 有关。
 例如:您的内容不得使用 Planting Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
 例如:您的内容不得使用 Potato Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
三、重度使用
二、重度使用
若不符合轻度使用的情形,即为重度使用。
其常见情形例如:
@@ -31,19 +48,18 @@
2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。
 允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。
 禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。
3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SC 协议)。
4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致的 Minecraft 正版购买弹窗与赞助弹窗。
3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SA 协议)。
4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致(或更激进)的 Minecraft 正版购买劝导与赞助劝导。
5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
 例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
————————————
————————————————————————————————————
说人话的备注:
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
这些规则主要是为了阻止恶意的使用、倒卖和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是参考了一小段代码,署个名就行啦,不用担心。
如果对具体细节有疑问,欢迎在 https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
如果对具体细节有疑问,或是希望修改这些规则,欢迎在 https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE 发帖!
多谢大家啦!
Submodule
+1
Submodule MeloongCore added at e5c8e65e2b
+11
View File
@@ -0,0 +1,11 @@
namespace PCLCS;
public static class Configs {
/// <summary>当前 Java 相关配置的版本。0 代表尚未从老的 Settings 系统中迁移。</summary>
public static readonly ConfigEntry<int> JavaConfigVersion = new(nameof(JavaConfigVersion), 0);
public static readonly ConfigEntry<ConcurrentList<Java>> JavaList = new(nameof(JavaList), []);
public static readonly ConfigEntry<List<string>> JavaRemovedList = new(nameof(JavaRemovedList), []);
public static readonly ConfigEntry<bool> InstanceMigratedJava = new(nameof(InstanceMigratedJava), false);
public static readonly ConfigEntry<Java> InstanceForcedJava = new(nameof(InstanceForcedJava), null);
}
+79
View File
@@ -0,0 +1,79 @@
namespace PCLCS;
/// <summary>
/// 社区资源的类型。
/// </summary>
[Flags]
public enum ResourceTypes {
/// <summary>Mod。</summary>
Mod = 1,
/// <summary>整合包。</summary>
ModPack = 2,
/// <summary>资源包。</summary>
ResourcePack = 4,
/// <summary>光影包。</summary>
Shader = 8,
/// <summary>数据包。</summary>
DataPack = 16,
/// <summary>服务端插件。</summary>
Plugin = 32,
/// <summary>同时包含数据包以及 Mod。</summary>
ModOrDataPack = Mod | DataPack,
/// <summary>允许任意种类,或种类未知。</summary>
Any = Mod | ModPack | ResourcePack | Shader | DataPack | Plugin,
}
/// <summary>
/// 社区资源的来源平台。
/// </summary>
[Flags]
public enum ResourcePlatforms {
CurseForge = 1,
Modrinth = 2,
Any = CurseForge | Modrinth,
}
/// <summary>
/// Mod 加载器的类型。
/// </summary>
[Flags]
public enum ModLoaders {
None = 0,
Forge = 1,
LiteLoader = 2,
Fabric = 4,
Quilt = 8,
NeoForge = 16,
All = Forge | LiteLoader | Fabric | Quilt | NeoForge,
}
/// <summary>
/// 在爱发电中的赞助等级。
/// </summary>
public enum DonationRank {
None = 0,
Rank6 = 6,
Rank12 = 12,
Rank23 = 23,
Rank54 = 54,
Rank98 = 98,
}
public static class Versions {
/// <summary>
/// 土豆码版本号。
/// </summary>
public const char PotatoVersion = '1';
/// <summary>
/// 版本管理中 Mod 信息缓存的版本号。
/// </summary>
public const int LocalModCacheVersion = 17;
/// <summary>
/// Minecraft 本地实例信息缓存的版本号。
/// </summary>
public const int McInstanceCacheVersion = 38;
/// <summary>
/// Java 相关配置的版本号。
/// </summary>
public const int JavaConfigVersion = 1;
}
+218
View File
@@ -0,0 +1,218 @@
namespace PCLCS;
/// <summary>
/// 单个 Java 的实例。
/// </summary>
[Serializable] public class Java(string folder, Version? version = null) : IEquatable<Java> {
/// <summary>
/// java.exe 文件所在的文件夹路径,这通常是 bin 文件夹。以 \ 结尾。
/// </summary>
public readonly string Folder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(folder));
/// <summary>
/// java.exe 文件的完整路径。
/// </summary>
[JsonIgnore] public string JavaExePath => Path.Combine(Folder, "java.exe");
/// <summary>
/// Java 的版本号(例如 16.0.1),保证 <see cref="Version.Major"/> 为其主版本。
/// <para/> 若为 null,则还需要调用 <see cref="CheckAsync"/> 以获取版本号。
/// </summary>
public Version? Version = version;
/// <summary>
/// 检查该 Java 是否存在问题,并获取其版本号。
/// 返回其是否通过了检查。
/// </summary>
public async Task<bool> CheckAsync(CancellationToken cancellationToken = default) {
if (Interlocked.Exchange(ref isChecked, 1) == 1 && available != null) return available!.Value; // 已检查过
string? output = null;
try {
if (!FileUtils.Exists(JavaExePath)) throw new FileNotFoundException("未找到 java.exe 文件", JavaExePath);
// 运行 -version
output = (await TaskUtils.RunProgramAsync(JavaExePath, "-version", 15000, cancellationToken: cancellationToken).NoCapture()).Output.Lower();
if (output == "") throw new InvalidOperationException("尝试运行该 Java 失败");
Logger.Trace($"Java 检查输出:{JavaExePath}{Environment.NewLine}{output}");
if (output.Contains("/lib/ext exists")) throw new InvalidOperationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试");
if (output.Contains("a fatal error") || output.Contains("error: ")) throw new InvalidOperationException("无法运行该 Java,该 Java 或系统存在问题");
// 获取版本号
var versionString = (output.RegexSeek(@"(?<=version "")[^""]+") ?? output.RegexSeek("(?<=openjdk )[0-9]+"))?.Replace("_", ".").Replace("+", ".").BeforeFirst("-");
if (string.IsNullOrEmpty(versionString)) throw new InvalidOperationException($"未找到该 Java 的版本号{(output.Length < 500 ? $"\n原始输出为:\n{output}" : "")}");
if (versionString.StartsWithF("1.")) versionString = versionString!.AfterFirst("."); // 去除开头的 1.
var segments = versionString!.Split(".", true).ToList();
while (segments.Count < 4) segments.Add("0");
Version = new Version(segments.Take(4).Join("."));
if (Version.Major is <= 4 or >= 100) throw new InvalidOperationException($"分析详细信息失败,获取的版本为 {Version}{(output.Length < 500 ? $"\n原始输出为:\n{output}" : "")}");
if (!output.Contains("64-bit")) throw new InvalidOperationException("该 Java 为 32 位版本,请安装 64 位的 Java");
Logger.Info($"检查 Java 成功:{this}");
available = true;
} catch (Exception ex) {
if (ex.IsCanceled()) {
isChecked = 0;
throw;
}
Logger.Warn($"检查 Java 失败({JavaExePath}),其输出为:\n{output ?? "无程序输出"}");
available = false;
}
return available!.Value;
}
[JsonIgnore] private int isChecked = 0;
/// <summary>若已进行过检查,表示该检查是否成功。若未检查,则为 null。</summary>
[JsonIgnore] internal bool? available = null;
// 相同检查
public bool Equals(Java? other)
=> other is not null && string.Equals(Folder, other.Folder, StringComparison.OrdinalIgnoreCase);
public override bool Equals(object? obj) => obj is Java other && Equals(other);
public override int GetHashCode() => StringComparer.OrdinalIgnoreCase.GetHashCode(Folder);
/// <summary>用户友好的描述文本。</summary>
public override string ToString()
=> $"Java {Version?.Major.ToString() ?? "尚未检查"} ({Version}):{Folder}";
}
public static class JavaUtils {
/// <summary>
/// 检查所有指定的 Java 是否存在问题,并获取其版本号。
/// </summary>
/// <returns>所有通过检查的 Java。</returns>
public static async Task<List<Java>> CheckAllAsync(IEnumerable<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
await TaskUtils.WhenAll(javas.Where(j => j.available == null).Select(
async java => await java.CheckAsync(cancellationToken).NoCapture()
), progress).NoCapture();
return javas.Where(j => j.available == true).ToList();
}
/// <summary>
/// 将 Java 列表进行排序。
/// 这同时会检查所有未检查的 Java。
/// </summary>
public static async Task<List<Java>> SortAsync(List<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
javas = await JavaUtils.CheckAllAsync(javas, cancellationToken, progress).NoCapture();
javas.Sort((left, right) => {
// 优先使用带完整 Java 的文件夹列表中的 Java
var isLeftInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, left.Folder));
var isRightInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, right.Folder));
if (isLeftInCandidateFolder != isRightInCandidateFolder) return isLeftInCandidateFolder ? -1 : 1;
// 其次优先使用主版本号接近 21 的 Java
var leftDistance = left.Version is null ? int.MaxValue : Math.Abs(left.Version.Major - 21);
var rightDistance = right.Version is null ? int.MaxValue : Math.Abs(right.Version.Major - 21);
return leftDistance.CompareTo(rightDistance);
});
return javas;
}
#region 搜索
/// <summary>
/// 存在完整 Java 的文件夹列表。
/// </summary>
internal static readonly List<string> CandidateFolders = [
Paths.AppData + @".minecraft\runtime\", // 这也是 PCL 下载 Java 的路径
Paths.AppData + @".hmcl\java\",
Paths.AppData + @"ATLauncher\runtimes\minecraft\",
Paths.AppData + @"ModrinthApp\meta\java_versions\",
Paths.AppData + @"PrismLauncher\java\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\curseforge\minecraft\Install\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.jdks\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.sdkman\candidates\java\",
Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\.ftba\bin\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\Packages\Microsoft.4297127D64EC6_8wekyb3d8bbwe\LocalCache\Local\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft Launcher\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) + @"\Curse\Minecraft\Install\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Java\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Eclipse Adoptium\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Amazon Corretto\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Zulu\",
..DirectoryUtils.EnumerateDirectories(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Microsoft\", searchPattern: "jdk-*"),
// 环境变量
..(Environment.GetEnvironmentVariable("JDK_HOME") + ";" + Environment.GetEnvironmentVariable("JAVA_HOME")).
Split(";", true).Select(path => path.Trim(' ', '"'))
];
/// <summary>
/// 从常见文件夹和环境变量中搜索 Java,并将搜索结果写入设置。
/// </summary>
public static async Task RefreshListAsync(CancellationToken c = default, ProgressProvider? p = null) {
// 搜索
List<Java> javaList = await SearchFoldersAsync(true, CandidateFolders, c, p?.SplitTo(0.5)).NoCapture();
// 将新发现的 Java 排在最前,原有列表保留既有顺序排在后面
var oldJavaList = Configs.JavaList.Get()!;
oldJavaList = await JavaUtils.CheckAllAsync(oldJavaList, c, p?.SplitTo(0.9)).NoCapture(); // 检查原有列表中的 Java
javaList.RemoveAll(oldJavaList); // 此时 javaList 中只剩下新发现的 Java
javaList = await JavaUtils.SortAsync(javaList, c).NoCapture(); // 将所有新发现的 Java 按优先级排序
javaList.AddRange(oldJavaList);
javaList = javaList.Distinct().ToList();
// 删掉已被移除的 Java
javaList.RemoveIf(j => Configs.JavaRemovedList.Get()!.Contains(j.Folder, StringComparer.OrdinalIgnoreCase));
// 写入设置
Configs.JavaList.Set([..javaList]);
Logger.Info($"Java 搜索完成,发现 {javaList.Count} 个 Java");
}
/// <summary>
/// 并行搜索所有指定的文件夹及其子文件夹中的 Java,并检查其有效性。
/// </summary>
public static async Task<List<Java>> SearchFoldersAsync(bool includeSubDirectories, IEnumerable<string> folders, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
// 并行搜索
ConcurrentBag<(string Folder, bool HasReparsePoint, bool IsSpecialPath)> results = [];
await TaskUtils.ForEachAsync(folders.Distinct(StringComparer.OrdinalIgnoreCase), 4, async (folder, cp) => {
await Task.Run(() => {
try {
foreach (var file in DirectoryUtils.EnumerateFiles(folder, includeSubDirectories, "java.exe")) {
cancellationToken.ThrowIfCancellationRequested();
string targetFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(PathUtils.RemoveLastPart(file)));
// 判断文件夹是否包含重解析点(例如符号链接)
static bool HasReparsePoint(FileSystemInfo info) {
do {
if (info.Attributes.HasFlag(FileAttributes.ReparsePoint)) return true;
info = info is FileInfo fileInfo ? fileInfo.Directory : ((DirectoryInfo) info).Parent;
} while (info is not null);
return false;
}
// 结果
var hasReparsePoint = HasReparsePoint(FileUtils.GetInfo(Path.Combine(targetFolder, "java.exe")));
var isSpecialPath = targetFolder.Contains("java8path_target_") || targetFolder.Contains("javapath_target_") || targetFolder.Contains("javatmp") || targetFolder.Contains("system32");
results.Add((targetFolder, hasReparsePoint, isSpecialPath));
}
} catch (UnauthorizedAccessException) {
Logger.Info($"快速查找 Java 时没有权限({folder})");
} catch (Exception ex) {
ex.ThrowIfCanceled();
Logger.Warn(ex, $"快速查找 Java 时出错({folder})");
}
}, cancellationToken).NoCapture();
}, cancellationToken, progress?.SplitTo(0.2)).NoCapture();
if (!results.Any()) return [];
// 筛除重解析点
if (results.All(r => r.HasReparsePoint)) {
Logger.Warn("找到的所有 Java 都包含重解析点,保留全部结果");
} else if (results.Any(r => r.HasReparsePoint)) {
Logger.Info($"找到以下的 Java 包含重解析点,将它们从列表中排除:{results.Where(r => r.HasReparsePoint).Select(r => r.Folder).Join('、')}");
results = [..results.Where(r => !r.HasReparsePoint)];
}
// 筛除特殊路径
if (results.All(r => r.IsSpecialPath)) {
Logger.Warn("找到的所有 Java 都包含特殊路径,保留全部结果");
} else if (results.Any(r => r.IsSpecialPath)) {
Logger.Info($"找到以下的 Java 包含特殊路径,将它们从列表中排除:{results.Where(r => r.IsSpecialPath).Select(r => r.Folder).Join('、')}");
results = [..results.Where(r => !r.IsSpecialPath)];
}
// 检查并返回
List<Java> javaList = results.Select(r => r.Folder).Distinct(StringComparer.OrdinalIgnoreCase).Select(folder => new Java(folder)).ToList();
javaList = (await JavaUtils.CheckAllAsync(javaList, cancellationToken, progress?.SplitTo(1)).NoCapture()).ToList();
javaList = await JavaUtils.SortAsync(javaList, cancellationToken).NoCapture();
Logger.Info($"快速查找 Java 完成,共有 {javaList.Count} 个候选:{javaList.Join('、')}");
return javaList;
}
#endregion
}
+68
View File
@@ -0,0 +1,68 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net48</TargetFramework>
<OutputType>Library</OutputType>
<AllowUnsafeBlocks>True</AllowUnsafeBlocks>
<OutDir>bin\</OutDir>
<AppendTargetFrameworkToOutputPath>false</AppendTargetFrameworkToOutputPath>
<AppendRuntimeIdentifierToOutputPath>false</AppendRuntimeIdentifierToOutputPath>
<Configurations>Debug;Release;Snapshot</Configurations>
<Deterministic>true</Deterministic>
<LangVersion>13.0</LangVersion>
<Nullable>enable</Nullable>
<ImplicitUsings>enable</ImplicitUsings>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="PolySharp" Version="1.15.0">
<PrivateAssets>all</PrivateAssets>
<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
</PackageReference>
</ItemGroup>
<ItemGroup>
<Using Include="System.Diagnostics.CodeAnalysis" />
<Using Include="System.Collections" />
<Using Include="System.Collections.Generic" />
<Using Include="System.Collections.Concurrent" />
<Using Include="System.Text" />
<Using Include="System.Net" />
<Using Include="System.Runtime.CompilerServices" />
<Using Include="System.Runtime.InteropServices" />
<Using Include="Newtonsoft.Json" />
<Using Include="Newtonsoft.Json.Linq" />
<Using Include="MeloongCore" />
<Using Include="MeloongCore.Extensions" />
<Using Include="MeloongCore.Wpf" />
<Using Include="MeloongCore.Wpf.Extensions" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MeloongCore\Shared\MeloongCore.csproj" />
<ProjectReference Include="..\MeloongCore\Wpf\MeloongCore.Wpf.csproj" />
</ItemGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'">
<DefineConstants>$(DefineConstants);SNAPSHOT</DefineConstants>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|AnyCPU'" />
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Snapshot|AnyCPU'">
<Optimize>True</Optimize>
</PropertyGroup>
<!-- 内嵌的资源 -->
<ItemGroup>
<None Remove="Resource\WikiEntries.txt" />
<EmbeddedResource Include="Resource\WikiEntries.txt" LogicalName="Resource\WikiEntries.txt" />
</ItemGroup>
<ItemGroup>
<Reference Include="Microsoft.VisualBasic" />
<Reference Include="Newtonsoft.Json">
<HintPath>..\Plain Craft Launcher 2\Resources\Newtonsoft.Json.dll</HintPath>
</Reference>
</ItemGroup>
</Project>
+33
View File
@@ -0,0 +1,33 @@
namespace PCLCS;
public static class Resource {
/// <summary>
/// 将 CurseForge 的 ModLoaderType 映射为 <see cref="ModLoaders"/> 枚举。
/// </summary>
public static ModLoaders FromCurseForgeModLoaderType(int modLoaderType) => modLoaderType switch {
// https://docs.curseforge.com/rest-api/#tocS_ModLoaderType
1 => ModLoaders.Forge,
3 => ModLoaders.LiteLoader,
4 => ModLoaders.Fabric,
5 => ModLoaders.Quilt,
6 => ModLoaders.NeoForge,
_ => ModLoaders.None,
};
/// <summary>
/// 将 <see cref="ModLoaders"/> 映射为 CurseForge 的单一 ModLoaderType。
/// </summary>
public static int ToCurseForgeModLoaderType(ModLoaders loaders) {
if (loaders == ModLoaders.None) return 0;
if (!loaders.Flags().IsSingle()) throw new ArgumentException($"传入的枚举值 {loaders} 并非单个 Mod Loader", nameof(loaders));
return loaders switch {
ModLoaders.Forge => 1,
ModLoaders.LiteLoader => 3,
ModLoaders.Fabric => 4,
ModLoaders.Quilt => 5,
ModLoaders.NeoForge => 6,
_ => 0,
};
}
}
File diff suppressed because one or more lines are too long
+83
View File
@@ -0,0 +1,83 @@
namespace PCLCS;
/// <summary>
/// MC 百科条目。
/// <para/>使用 <see cref="WikiEntry.All"/> 获取所有条目。
/// </summary>
public class WikiEntry {
/// <summary>
/// 在 MC 百科中的对应 ID。
/// </summary>
public int Id;
/// <summary>
/// 中文译名。
/// <c>null</c> 代表没有翻译。
/// </summary>
public string? ChineseName;
/// <summary>
/// 各个 Mod 平台的 Slug(例如 advanced-solar-panels)。
/// 若没有对应键则为不在该平台上。
/// </summary>
public Dictionary<ResourcePlatforms, string> Slugs = [];
/// <summary>
/// MC 百科的浏览量逆序排行,1 代表浏览量最低。
/// </summary>
public int Popularity;
/// <summary>
/// 内置数据库中的所有 MC 百科条目。
/// </summary>
public static readonly Lazy<List<WikiEntry>> All = new(() => {
var dataLines = FileUtils.ReadAsLines(@"Resource\WikiEntries.txt", type: typeof(WikiEntry)).ToList();
// 读取最后一行的浏览量
Queue<int> popularities = [];
for (int i = 0; i < dataLines[^1].Length; i += 3) { // 将每 3 个字符切割成一个元素
popularities.Enqueue(int.Parse(dataLines[^1].Substring(i, 3).ConvertRadix(86, 10)));
}
dataLines.RemoveAt(dataLines.Count - 1);
// 解析每一行
List<WikiEntry> results = [];
var lineNumber = 0;
foreach (var lineData in dataLines) {
lineNumber++;
if (lineData == "") continue;
var popularity = popularities.Dequeue();
foreach (var entryData in lineData.Split('¨')) {
var entry = new WikiEntry();
var parts = entryData.Split('|');
var slugs = parts[0];
if (slugs.StartsWithF("@")) {
entry.Slugs.Add(ResourcePlatforms.Modrinth, slugs.Replace("@", ""));
} else if (slugs.EndsWithF("@")) {
entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs.TrimEnd('@'));
entry.Slugs.Add(ResourcePlatforms.Modrinth, entry.Slugs[ResourcePlatforms.CurseForge]);
} else if (slugs.Contains("@")) {
var splitSlugs = slugs.Split('@');
entry.Slugs.Add(ResourcePlatforms.CurseForge, splitSlugs[0]);
entry.Slugs.Add(ResourcePlatforms.Modrinth, splitSlugs[1]);
} else {
entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs);
}
entry.Id = lineNumber;
entry.Popularity = popularity;
if (parts.Length >= 2) {
entry.ChineseName = parts[^1]; // 最后一项
if (entry.ChineseName.Contains("*")) { // 处理 *
var englishName = entry.Slugs.Values.First().Replace("-", " ").Capitalize();
entry.ChineseName = entry.ChineseName.Replace("*", $" ({englishName})");
}
}
results.Add(entry);
}
}
return results;
});
public override string ToString()
=> $"{Slugs.GetOrDefault(ResourcePlatforms.CurseForge)}&{Slugs.GetOrDefault(ResourcePlatforms.Modrinth)}|{Id}|{ChineseName},浏览量 {Popularity}";
}
+33 -6
View File
@@ -5,22 +5,49 @@ VisualStudioVersion = 17.2.32616.157
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "PCLCS", "PCLCS\PCLCS.csproj", "{32DE4AAF-F4D6-42C5-9604-19236DE96C69}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore", "MeloongCore\Shared\MeloongCore.csproj", "{D22BBF3C-2177-0208-4E29-8466AA41AC6F}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore.Wpf", "MeloongCore\Wpf\MeloongCore.Wpf.csproj", "{2DFFE2A0-1101-816B-D240-F644B2D74A68}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Beta|Any CPU = Beta|Any CPU
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
Snapshot|Any CPU = Snapshot|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.Build.0 = Debug|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.ActiveCfg = Release|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.Build.0 = Release|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.Build.0 = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.Build.0 = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.Build.0 = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.Build.0 = Release|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.Build.0 = Debug|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.ActiveCfg = Release|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.Build.0 = Release|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
+2 -5
View File
@@ -9,9 +9,6 @@
<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>
@@ -27,8 +24,8 @@
<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"/>
<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>
+14 -20
View File
@@ -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">
+179 -176
View File
@@ -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)
Else
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()
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
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
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
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
'动态 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
'切换窗口
'控件模板事件
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
+135 -106
View File
@@ -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
+43 -7
View File
@@ -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,8 +118,8 @@
'修复 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
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
@@ -125,7 +127,6 @@
Text = RawText
TextBox.SelectionStart = RawSelectionStart
IsTextChanging = False
End If
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
@@ -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,9 +51,10 @@
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(Sub()
RunInUi(
Sub()
If value Then
'有了
Visibility = Visibility.Visible
@@ -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,7 +201,8 @@
''' 发出一圈波浪效果提示。
''' </summary>
Public Sub Ribble()
RunInUi(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)
@@ -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)
If Not IsLeftMouseHeld Then Return
Logger.Info($"按下附加图标按钮:{Text}")
RaiseEvent Click(sender, e)
e.Handled = True
RaiseCustomEvent()
Button_LeftMouseUp()
End If
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
+5 -13
View File
@@ -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>
+69 -49
View File
@@ -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,35 +124,18 @@ 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()
AaCode(
Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
@@ -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)
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,12 +140,11 @@
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)
If IsEnabled Then
Select Case Theme
Case Themes.Color
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
@@ -175,18 +157,20 @@
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
+37 -70
View File
@@ -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,14 +177,15 @@ 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()
AaCode(
Sub()
PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1
@@ -203,14 +198,12 @@ Public Class MyLoading
AaOpacity(PathRight, -1, 100, 50),
AaX(PathRight, 5, 180,, New AniEaseOutFluent),
AaY(PathRight, -6, 180,, New AniEaseOutFluent),
AaCode(Sub()
AaCode(
Sub()
IsLooping = False
AniLoop()
End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid())
If ShowProgress Then
End If
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
+15 -17
View File
@@ -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()
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
+100 -49
View File
@@ -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,14 +89,60 @@
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
'上下两个重载只有这里不一样
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
End If
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成,直接触发事件
End If
@@ -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,12 +64,7 @@ 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 CheckedCount > 1 Then
If Checked Then
'如果本控件选中,则取消其他所有控件的选中
For Each Control As MyRadioBox In RadioboxList
@@ -87,18 +83,19 @@ Public Class MyRadioBox
End If
Next
End If
End Select
'触发事件
If IsChanged Then
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
End If
If IsChanged Then
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
RaiseCustomEvent()
'更改动画
SyncUI()
End If
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 -1
View File
@@ -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
+37 -9
View File
@@ -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,14 +22,14 @@
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
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 If
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
If Not IsMouseDown Then Return
IsMouseDown = False
Log("[Control] 按下文本按钮:" & Text)
Logger.Info($"按下文本按钮:{Text}")
RaiseEvent Click(Me, Nothing)
ModEvent.TryStartEvent(EventType, EventData)
RaiseCustomEvent()
e.Handled = True
End If
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
+11 -12
View File
@@ -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 -1
View File
@@ -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,21 +804,22 @@ Public Module ModAnimation
''' </summary>
Public Sub AniStart()
'初始化计时器
AniLastTick = GetTimeTick()
AniLastTick = GetTimeMs()
AniFPSTimer = AniLastTick
AniRunning = True '标记动画执行开始
RunInNewThread(Sub()
RunInNewThread(
Sub()
Try
Log("[Animation] 动画线程开始")
Logger.Info("动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
AniLastTick = GetTimeMs()
'记录 FPS
If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If (AniLastTick - AniFPSTimer).Clamp(0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -790,16 +827,17 @@ Public Module ModAnimation
AniFPSCounter += 2
End If
'执行动画
RunInUiWait(Sub()
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)")
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:
@@ -807,7 +845,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Assert)
Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
@@ -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
+205 -113
View File
@@ -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, "强制", "")}启动")
Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsAborted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Else
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 = 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
LastFinishedTime = GetTimeMs() '未中断,本次输出有效
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
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) With {.Name = Name, .Priority = ThreadPriority}
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
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
+23 -22
View File
@@ -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
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Throw New Exception($"加载 MyBitmap 意外失败({FilePathOrResourceName})", ex)
End If
Else
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

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