Compare commits

...
703 Commits
Author SHA1 Message Date
龙腾猫跃 6f6744dfd2 2.10.8 2025-09-12 23:40:01 +08:00
龙腾猫跃 2210da6fda 2.10.7 2025-09-10 01:07:30 +08:00
龙腾猫跃 ee385912f8 Merge pull request #6933 from pynickle/fix/issue-6876
imp(VersionOverall): 优化版本重命名处理逻辑
2025-09-09 20:31:50 +08:00
龙腾猫跃 47c3c163ed Merge pull request #6664 from shatyuka/fix/setup-binding
fix: 动画绑定失败
2025-09-09 20:18:27 +08:00
龙腾猫跃 45b6582f30 Merge branch 'main' into fix/setup-binding 2025-09-09 20:18:18 +08:00
龙腾猫跃 6f9262ef4f Merge pull request #7020 from PCL-Community/#7003
chore(ModCrash): 崩溃识别增加
2025-09-07 04:31:39 +08:00
龙腾猫跃 46fd4c1e8d Merge pull request #7031 from PCL-Community/#6908
fix(ModModpack): 安装整合包时忽略配置中设置的 IsStar 值
2025-09-04 23:13:19 +08:00
龙腾猫跃 c3d79e1f18 Merge pull request #7028 from PCL-Community/#6978
feat(PageVersionExport): 打包整合包时支持添加 TaCZ 枪包
2025-09-04 23:11:29 +08:00
龙腾猫跃 f63e9a896c Merge pull request #7043 from PCL-Community/#7030
feat(PageSelectLeft): 将要删除的游戏文件夹是系统关键目录时警告用户
2025-09-04 23:01:38 +08:00
龙腾猫跃 9c9d98084a Merge pull request #7052 from pynickle/imp/issue-7032-official
imp(mod-crash): 优化玩家实体导致崩溃的提示信息
2025-09-04 21:21:31 +08:00
龙腾猫跃 cfbde4ad1c Merge pull request #7056 from Open-KFC/IsSwaped-delegate
fix(MyCard): IsSwaped 未正确转发
2025-09-04 21:14:23 +08:00
龙腾猫跃 46b96d6408 Merge pull request #7050 from pynickle/style/chinese-official
style: 去除中文逗号
2025-09-04 21:05:40 +08:00
龙腾猫跃 6f3bad680c Merge pull request #7057 from PCL-Community/#7025
fix(ModLaunch): 未将部分错误识别为超时
2025-09-04 17:58:10 +08:00
龙腾猫跃 ad5207470d Merge pull request #7058 from pynickle/fix/issue-7023-official
fix(mod-launch): 修复刷新登录时出现 400 报错,未进行错误处理
2025-09-04 17:50:36 +08:00
龙腾猫跃 b936608ec7 Merge pull request #7071 from PCL-Community/#7070
fix(ModCrash): 错误分析误报 night config 存在问题,但实际上是配置文件损坏
2025-09-04 00:19:47 +08:00
龙腾猫跃 dc7f01dfdd Merge pull request #7151 from lingting/main
Java搜索 支持jet 的基础sdk 以及 ~/.jdks 没匹配到可用项修复
2025-09-02 20:52:38 +08:00
龙腾猫跃 3528bf5a3d Merge pull request #6866 from LuoYun-Team/MusicCount
fix(music): 计算音乐文件数量逻辑有误
2025-09-01 20:57:39 +08:00
龙腾猫跃 f211df1ea2 Merge pull request #6648 from PCL-Community/feat#6610
feat: 允许为单个版本关闭 Mod 更新功能
2025-09-01 20:33:07 +08:00
lingting 9a3df4adec feat(java): Java搜索支持 Jet的sdk且同时忽略jet 的jcef sdk 2025-08-27 16:35:46 +08:00
lingting b09750ffff fix(java): 尝试修复从 ~/.jdks 中搜索Java时未匹配到任何可用项 2025-08-27 16:32:56 +08:00
wyc-26 2f74640de5 fix(ModCrash): 忘写 Then 2025-08-16 18:45:02 +08:00
wyc-26 78a5536bc7 fix(ModCrash): 错误分析误报 night config 存在问题,但实际上是配置文件损坏 2025-08-16 16:12:52 +08:00
ENC_Euphony 54c45ff54b 加入封号处理 2025-08-15 20:37:30 +08:00
ENC_Euphony fe39495f2e Update ModLaunch.vb 2025-08-15 16:25:03 +08:00
ENC_Euphony e2c24a7d44 fix(mod-launch): 修复刷新登录时出现 400 报错,未进行错误处理 2025-08-15 15:18:03 +08:00
wyc-26 37b069c572 fix(ModLaunch): 未将部分错误识别为超时 2025-08-15 14:33:10 +08:00
Open-KFC 5622e50a54 fix(MyCard): IsSwaped 未正确转发 2025-08-15 12:29:27 +08:00
ENC_Euphony 86d1d387a5 imp(mod-crash): 优化玩家实体导致崩溃的提示信息 2025-08-15 01:08:27 +08:00
ENC_Euphony 7f2f7df05f style: 去除中文逗号 2025-08-15 00:44:50 +08:00
wyc-26 b285ffa401 feat(PageSelectLeft): 将要删除的游戏文件夹是系统关键目录时警告用户 2025-08-14 15:36:32 +08:00
龙腾猫跃 8e095ddaed 2.10.6 正式版 2025-08-14 01:29:27 +08:00
wyc-26 afc08cc243 fix(ModModpack): 安装整合包时忽略配置中设置的 IsStar 值 2025-08-13 16:15:32 +08:00
wyc-26 bac349a54c feat(PageVersionExport): 打包整合包时支持添加 TaCZ 枪包 2025-08-13 16:04:18 +08:00
wyc-26 02c766ac08 chore(ModCrash): 崩溃识别增加 2025-08-13 10:12:38 +08:00
龙腾猫跃 273cee69e5 fix: IsSwaped 在加壳后失效 2025-08-13 01:33:11 +08:00
龙腾猫跃 adf52d56b7 2.10.6 2025-08-13 01:08:21 +08:00
龙腾猫跃 1d0947181f Merge pull request #6970 from youzi-3222/auto-repl-colon
feat(PageVersionSetup): 自动将服务器地址替换为半角冒号
2025-08-12 19:47:21 +08:00
龙腾猫跃 f67ef9c2c5 Merge pull request #6904 from MoYuan-CN/pr/term-optimize
imp: 修改参数展示名
2025-08-12 19:11:57 +08:00
龙腾猫跃 28640dcdf5 Merge pull request #6942 from LuoYun-Team/MMC-Modpack-Fix
fix(Launch): 修复 HMCL 安装的部分整合包没法启动
2025-08-12 18:59:49 +08:00
龙腾猫跃 88e87011af Merge pull request #6971 from pynickle/style/swapped
style: 一个 typo 修复
2025-08-12 04:17:46 +08:00
龙腾猫跃 c22f925807 Merge pull request #6976 from LuoYun-Team/inst-tip
chore(tip): 移除提示
2025-08-12 04:14:30 +08:00
龙腾猫跃 5785ffdfb3 Merge pull request #6980 from Light-Beacon/main
主页按钮加入非加密设置的写入功能
2025-08-12 04:11:13 +08:00
龙腾猫跃 59857c3391 Merge pull request #6984 from Light-Beacon/change-news-homepage-link
新闻主页链接使用SSL
2025-08-12 03:31:06 +08:00
龙腾猫跃 c90d96e65d Merge pull request #6709 from ABA2396/pcl2
fix: 规避 WPF 剪贴板卡顿,修复剪切不清除文本的问题
2025-08-11 22:04:01 +08:00
Nattiden 838cb3c842 news homepage use ssl 2025-08-08 21:37:53 +08:00
Nattiden d133138984 实现 #6973 2025-08-08 14:55:38 +08:00
薄奚梦灵 128b8001ff chore(tip): 移除注册表项目 2025-08-08 11:02:50 +08:00
薄奚梦灵 c7e0dd3816 chore(tip): 移除提示 2025-08-08 10:59:56 +08:00
龙腾猫跃 8e0f53c881 2.10.5 正式版 2025-08-08 03:11:24 +08:00
youzi-3222 68483876f3 feat(PageVersionSetup): 替换中文冒号不弹窗提示 2025-08-07 21:20:42 +08:00
ENC_Euphony 10a5a30968 Update Plain Craft Launcher 2.vbproj 2025-08-07 19:30:37 +08:00
ENC_Euphony fdc56a2a4b style: 一个 typo 修复 2025-08-07 16:15:40 +08:00
youzi-3222 490626a293 feat(PageVersionSetup): 自动将服务器地址替换为半角冒号 2025-08-07 12:53:25 +08:00
薄奚梦灵 ce91fe6245 fix(launch): missing " 2025-08-03 13:29:35 +08:00
薄奚梦灵 5a841de3ba fix(Launch): 修复 HMCL 安装的部分整合包没法启动 2025-08-03 13:26:16 +08:00
ENC_Euphony fc910b1955 ref(VersionOverall): 优化代码 2025-08-02 18:33:43 +08:00
ENC_Euphony 340e7457f8 imp(VersionOverall): 优化版本重命名处理逻辑 2025-08-01 23:27:22 +08:00
墨渊 b76266a69d imp: 修改参数展示名 2025-07-29 02:07:54 +08:00
墨渊 5fc0693892 imp: 修改参数展示名
JVM 参数头部 → Java 虚拟机参数
2025-07-29 02:06:41 +08:00
薄奚梦灵 73d9eed9a9 fix(music): 计算音乐文件数量逻辑有误 2025-07-24 20:03:04 +08:00
龙腾猫跃 28ef67ee0f 2.10.5 2025-07-22 23:49:12 +08:00
龙腾猫跃 add4153067 2.10.4 2025-07-22 21:09:24 +08:00
龙腾猫跃 3e474b89ef Merge pull request #6845 from LuoYun-Team/actions
ci(build): 让工作流支持新版本代码的自动替换
2025-07-22 19:23:58 +08:00
薄奚梦灵 b5cfebe8aa ci(build): 让工作流支持新版本代码的自动替换 2025-07-22 12:54:02 +08:00
龙腾猫跃 4486e7ea2c Merge pull request #6445 from PCL-Community/fix#6443
fix(PageVersionOverall): 重命名版本时会修改后缀名且会修改不应重命名的文件或文件夹
2025-07-22 00:41:09 +08:00
龙腾猫跃 4d91d0b27e Merge pull request #6706 from shatyuka/fix/search-forge-mods
fix: 搜索旧版本 Forge mod 崩溃
2025-07-20 19:20:26 +08:00
龙腾猫跃 14e14b9810 Merge pull request #6772 from LuoYun-Team/Drop
fix(Drop): 文件拖拽修复
2025-07-20 18:57:17 +08:00
龙腾猫跃 d6575df6ab Merge pull request #6685 from MoYuan-CN/issue/6673
imp(download): 改进可选组件互斥逻辑
2025-07-20 03:19:48 +08:00
龙腾猫跃 eed6c92f5a Merge pull request #6594 from PCL-Community/fix#6588
fix(ModSecret): 开源版本龙猫蓝配色错误
2025-07-19 04:30:54 +08:00
龙腾猫跃 ae8de397ae Merge pull request #6717 from xrlzu-Community/main
feat:去掉“刷新头像”和“修改披风”之间的线
2025-07-18 19:39:53 +08:00
龙腾猫跃 2de22b780c Merge pull request #6795 from lingting/main
chore: 自动搜索java路径添加 ~/.jdks
2025-07-18 19:36:34 +08:00
龙腾猫跃 4d954ae45d Merge pull request #6701 from LuoYun-Team/skin-url
fix(skin): 可能尝试使用 HTTPS 协议从没有 SSL 证书的服务器下载皮肤文件
2025-07-18 19:27:53 +08:00
龙腾猫跃 3d63ceba57 Merge pull request #6644 from PCL-Community/optimize-1
feat(PageDownloadCompDetail): 为每种资源区分 CachedFolder
2025-07-18 19:16:46 +08:00
龙腾猫跃 8b234d8e4f Merge pull request #6635 from zkitefly/patch-4
fix: 修复微软登录提示语句问题
2025-07-18 19:11:02 +08:00
龙腾猫跃 d6a5a8b83e Merge pull request #6626 from Light-Beacon/main
chore: 更新仓库指向仓库的链接
2025-07-18 19:10:15 +08:00
龙腾猫跃 885b3eada6 Merge pull request #6587 from LuoYun-Team/java-version
fix(java): JVM 崩溃导致错误将版本号识别为 JDK/JRE 64
2025-07-18 05:09:34 +08:00
龙腾猫跃 deb902904b Merge pull request #6585 from hongggggv/fix
chore: 修改资源筛选版本
2025-07-18 04:58:44 +08:00
龙腾猫跃 1458ce95ce Merge pull request #6527 from Baiyuexiao-Studio/security-interrupt
feat: 支持识别因为微软账号被标记为可疑活动导致登陆失败
2025-07-18 04:39:20 +08:00
龙腾猫跃 d8efb76bf0 Merge pull request #6505 from LuoYun-Team/CustomKey
feat(Secret):允许使用环境变量覆盖部分内容
2025-07-18 04:37:46 +08:00
hongggggv a843b22f38 Merge branch 'Meloong-Git:main' into fix 2025-07-17 23:14:58 +08:00
Luo 08e4414f34 将版本号改为 1.21.8 2025-07-17 23:13:23 +08:00
lingtingand龙腾猫跃 ff225e9f37 chore: 文件夹以\结尾
Co-authored-by: 龙腾猫跃 <[email protected]>
2025-07-14 10:21:42 +08:00
龙腾猫跃 96b6ef294b Merge pull request #6473 from PCL-Community/fix#6439
fix(PageDownloadCompDetail): 部分原版可用的光影无法显示可下载的游戏版本
2025-07-14 04:38:53 +08:00
龙腾猫跃 f271d7212c Merge pull request #6797 from PCL-Community/#6774
fix: 选择图片不能选择 jpeg 格式
2025-07-14 01:44:43 +08:00
wyc-26 ad583c29c2 fix: 选择图片不能选择 jpeg 格式 2025-07-13 22:08:27 +08:00
龙腾猫跃 f98dcd8fef Merge pull request #6407 from LuoYun-Team/HttpClient
Refactor(Network):用 HttpClient 代替已经过时的 WebRequest、WebClient、ServicePointManager
2025-07-13 20:53:35 +08:00
龙腾猫跃 9b49235cda Merge pull request #6287 from PCL-Community/fix#5252
fix(ModLaunch): 证书不信任导致无法登录皮肤站
2025-07-13 20:42:46 +08:00
龙腾猫跃 f090a63c54 Merge pull request #6216 from LuoYun-Team/dialog
fix:文件删除没有无法放入回收站的提示
2025-07-13 20:39:50 +08:00
龙腾猫跃 c332a4dc94 Merge pull request #6027 from PCL-Community/feat#6026
feat: 点击“下载新 Mod”按钮跳转到下载页面时自动填充搜索框的内容
2025-07-13 20:23:32 +08:00
龙腾猫跃 6770e55214 Merge pull request #5798 from CiiLu/music
解决 #5762 :仅合法音乐纳入背景音乐数量统计
2025-07-13 20:03:51 +08:00
lingting dd028bb6d8 chore: 自动搜索java路径添加 ~/.jdks 2025-07-13 17:40:18 +08:00
薄奚梦灵 5126b257f8 chore: 将旧代码还原获取 2025-07-11 18:04:03 +08:00
薄奚梦灵 35398052bb fix(Drop): 文件拖拽修复 2025-07-11 17:57:46 +08:00
xrlzu 17031e1a65 feat:去掉“刷新头像”和“修改披风”之间的线 2025-07-04 20:14:42 +08:00
uye 5aad129121 fix: 规避 WPF 剪贴板卡顿,修复剪切不清除文本的问题
支持 (Rich)TextBox 复制/剪切/粘贴 和 DataGrid 复制,TextBox默认生效,可通过附加属性 ClipboardInterceptor.EnableSafeClipboard 启用
2025-07-03 22:44:56 +08:00
shatyuka e40a41a761 fix: 搜索旧版本 Forge mod 崩溃 2025-07-02 21:56:46 +08:00
薄奚梦灵 5ae813825c fix(skin): 可能尝试使用 HTTPS 协议从没有 SSL 证书的服务器下载皮肤文件 2025-07-01 21:42:01 +08:00
hongggggv 48684f8f85 将版本号改为 1.21.7 2025-07-01 21:05:18 +08:00
墨渊 3f5392d76d fix(version): 应当是 1.20.5+ 2025-06-30 05:21:18 +00:00
MoYuan-CN 9af03d499a imp(download): 改进可选组件互斥逻辑
在 1.21.5 及以后的版本中不允许同时选择 OptiFine 和 Fabric
选择了 Fabric 时会给出 Blue 等级的提示以帮助用户理解和寻找光影加载代替方案
2025-06-30 12:25:40 +08:00
shatyuka 065b69b346 fix: 动画绑定失败 2025-06-28 05:44:00 +08:00
wyc-26 c708aca3fb refactor: 移到高级启动选项里面 2025-06-27 09:32:47 +08:00
wyc-26 e188f7392c feat: 允许为单个版本关闭 Mod 更新功能 2025-06-26 16:01:29 +08:00
wyc-26 d6043c7d32 feat(PageDownloadCompDetail): 为每种资源区分 CachedFolder 2025-06-25 21:52:27 +08:00
Luo a38e20870b 回退上次更改 2025-06-25 16:22:19 +08:00
Luo 72a2b5da8c 修改 Mod 支持所有常用版本的描述 2025-06-25 16:18:22 +08:00
Zkitefly f3017b6b62 Update MyMsgLogin.xaml.vb 2025-06-25 16:02:26 +08:00
Nattiden 5274ae8499 chore: 链接更新 2025-06-23 21:10:38 +08:00
薄奚梦灵andtangge233 83e34b84fa Update Plain Craft Launcher 2/Modules/Base/ModNet.vb
Co-authored-by: tangge233 <[email protected]>
2025-06-23 20:45:34 +08:00
薄奚梦灵 65812b8754 chore: 删除无用代码 2025-06-20 18:38:28 +08:00
wyc-26 6616afde6d chore: 一不小心动了注释位置 2025-06-20 15:15:54 +08:00
wyc-26 7cd5747f4f fix(ModSecret): 开源版本龙猫蓝配色错误 2025-06-20 15:14:34 +08:00
薄奚梦灵 70ec0b66f9 fix(java): JVM 崩溃导致错误将版本号识别为 JDK/JRE 64 2025-06-19 12:36:47 +08:00
Luo 74e5eb82f5 修改筛选版本 2025-06-19 11:14:30 +08:00
龙腾猫跃 fdf5407ea3 2.10.3 2025-06-17 16:51:31 +08:00
龙腾猫跃 ebc9f5e31f 2.10.2 2025-06-17 05:25:51 +08:00
龙腾猫跃 4585f31082 2.10.2 正式版 2025-06-17 05:19:00 +08:00
龙腾猫跃 a63c5b46a6 Merge pull request #5872 from Open-KFC/feat4311
Feat:模组管理页面无需点击右侧控件即可触发全选快捷键
2025-06-17 03:20:14 +08:00
龙腾猫跃 01b26cdf3c Merge pull request #6472 from PCL-Community/fix#6451
fix(ModWatcher): Quilt 加载器错误窗口关闭后提示启动成功
2025-06-17 03:13:12 +08:00
龙腾猫跃 27b4df0e85 Merge pull request #6117 from LuoYun-Team/ModComp
pref(ModComp):提高代码可维护性
2025-06-17 03:11:21 +08:00
龙腾猫跃 a219eca488 Merge pull request #6440 from MoYuan-CN/issue/6438
typo: unexpected "s" appear in shader filter options
2025-06-17 03:06:29 +08:00
龙腾猫跃 666243e072 Merge pull request #6249 from PCL-Community/feat#6244
feat(ModDownloadLib): 自动创建资源包文件夹
2025-06-17 02:56:33 +08:00
龙腾猫跃 66bf71a7f3 Merge pull request #6456 from CreeperIsASpy/main
fix(PageSetupSystem.xaml.vb): 修复弹窗中页面名称错误的问题
2025-06-17 02:48:46 +08:00
龙腾猫跃 f1c046986c Merge pull request #6482 from tangge233/fix/HRKill
chore: 修复火绒的特征查杀
2025-06-17 02:40:37 +08:00
龙腾猫跃 d1fa7109ed Merge pull request #6570 from LuoYun-Team/curseforge-link
chore(CurseForge): 增加新的 Fallback
2025-06-17 02:36:27 +08:00
龙腾猫跃 6c426b09cc Merge pull request #6437 from LuoYun-Team/Skin
fix:可能在获取正版皮肤时失败
2025-06-17 02:29:27 +08:00
薄奚梦灵 cbf038d51f chore(CurseForge): 增加新的 Fallback 2025-06-16 22:39:37 +08:00
白月晓 5e31a1d937 Update MyMsgLogin.xaml.vb 2025-06-09 21:44:24 +08:00
白月晓 81619cbfc7 feat: 支持识别因为微软账号被标记为可疑活动导致登陆失败
From https://github.com/PCL-Community/PCL2-CE/issues/769
2025-06-09 18:51:58 +08:00
薄奚梦灵 300d1ecf66 feat(Secret):允许使用环境变量覆盖部分内容 2025-06-07 17:01:16 +08:00
薄奚梦灵andbaiyuexiao496 6dbb5c98cc fix: 少了特定标头和异常抛出
CO-Authored-By: baiyuexiao496 <[email protected]>
2025-06-07 14:18:00 +08:00
wyc-26 2991e43b45 chore: 小改 2025-06-05 19:52:27 +08:00
wyc-26 0c1b9e389a fix(ModWatcher): 忘写对应的 WatcherLog 2025-06-05 19:40:09 +08:00
tangge233 809a281a7e style: 修改变量名称 2025-06-04 22:54:56 +08:00
wyc-26 da8a50abd3 fix(PageDownloadCompDetail): 给资源包也加上 2025-06-04 21:06:48 +08:00
tangge233 cddcd9e8b2 chore: 修复火绒的特征查杀 (感谢火绒论坛的 UnknownOoo 老哥) 2025-06-04 18:43:38 +08:00
薄奚梦灵 7ecf306445 chore: 弄错了 2025-06-02 13:44:17 +08:00
薄奚梦灵andjiangyanyue 3adf47aa2c fix: 编译错误
CO-Authored-by: jiangyanyue <[email protected]>
2025-06-02 13:40:43 +08:00
薄奚梦灵 70a2f28073 revert: 错误的文件更改 2025-06-02 13:27:23 +08:00
薄奚梦灵 9c9216c02c revert: 错误的文件更改 2025-06-02 13:20:21 +08:00
wyc-26 f2ae0fbaa9 fix(PageDownloadCompDetail): 部分原版可用的光影无法显示可下载的游戏版本 2025-06-02 12:20:50 +08:00
wyc-26 c2a476feff fix(ModWatcher): Quilt 加载器错误窗口关闭后提示启动成功 2025-06-02 11:55:18 +08:00
wyc-26 36c03d1654 fix(PageComp): 重复的代码 2025-06-02 11:03:36 +08:00
wyc-26 ebd20195be Merge branch 'main' into feat#6026 2025-06-02 10:59:14 +08:00
薄奚梦灵andqiuyue712 5a94854809 Refactor(ModNet): 使用 HttpClient 代替过失函数 Feat(ModNet): 支持 GZip 等压缩格式响应的读取
CO-authored-by: qiuyue712 <[email protected]>
2025-06-02 00:08:22 +08:00
仿生猫梦见苦力怕 dcac683bfd Update PageSetupLeft.xaml.vb 2025-06-01 21:25:40 +08:00
薄奚梦灵 d2e210320b Merge pull request #51 from Hex-Dragon/main
sync
2025-06-01 15:45:07 +08:00
wyc-26 73d705aa5b fix(PageVersionOverall): 重命名版本时会修改后缀名且会修改不应重命名的文件或文件夹 2025-05-31 23:08:11 +08:00
墨渊 878ff980dc Update PageDownloadShader.xaml 2025-05-31 20:49:49 +08:00
薄奚梦灵 e19f910251 fix:可能在获取正版皮肤时失败 2025-05-31 18:41:48 +08:00
龙腾猫跃 6b0c923777 2.10.1 2025-05-31 16:53:00 +08:00
龙腾猫跃 03a64108d9 Merge pull request #5771 from Open-KFC/fix5665
fix(PageVersionMod): 在模组列表中划动鼠标选择时如果鼠标在列表之外松开会导致无法与悬浮卡片交互
2025-05-30 23:10:26 +08:00
龙腾猫跃 bf121009ae Merge pull request #4401 from tmdakm/main
读取MCBBS整合包文件中的Jvm和Launch参数
2025-05-29 23:08:49 +08:00
龙腾猫跃 971db70ae9 Merge pull request #6347 from Open-KFC/default-mcwindow-size
fix(LaunchArg): 默认窗口大小错误
2025-05-29 02:28:03 +08:00
龙腾猫跃 2359776803 Merge pull request #6257 from LuoYun-Team/enforce-https
fix:使用 HTTP 协议获取皮肤导致被劫持
2025-05-28 17:15:56 +08:00
龙腾猫跃 8f8819d0f0 Merge pull request #6321 from Open-KFC/title-bar-pic
fix(ImageTitleLogo): 保证在重新设置标题栏图片时得到刷新
2025-05-28 17:02:42 +08:00
龙腾猫跃 8e383ed436 Merge pull request #6318 from PCL-Community/fix#6317
fix(PageSetupUI): 修正功能隐藏中的选项卡名称
2025-05-28 17:00:53 +08:00
龙腾猫跃 34123d5944 Merge pull request #6300 from written143/cape
添加普通披风、薄煎饼披风和创始人披风的翻译
2025-05-28 17:00:03 +08:00
龙腾猫跃 0c8ccafd46 Merge pull request #6227 from CreeperIsASpy/main
fix: 极小概率在主页卡片卡出“内容见 ModSetup” 的 Hint
2025-05-28 16:57:00 +08:00
龙腾猫跃 deefff4504 Merge pull request #6234 from LuoYun-Team/resourcepack
chore:修改命名
2025-05-28 16:52:55 +08:00
龙腾猫跃 83856e5192 Merge pull request #6247 from PCL-Community/feat#6246
feat(PageDownloadCompDetail): 支持为资源包和光影包选择默认下载位置
2025-05-28 16:23:55 +08:00
龙腾猫跃 81d6e501cd Merge pull request #6340 from Open-KFC/drag-over-flowdocument
fix(FileDrag): 鼠标位于可编辑文字控件上无法完成向窗口的文件拖放
2025-05-28 15:34:40 +08:00
龙腾猫跃 65f17ba6f5 Merge pull request #6369 from PCL-Community/fix#2294
fix(PageVersionOverall): 缓存问题导致切换语言失败
2025-05-28 15:26:23 +08:00
龙腾猫跃 cc81df2e26 Merge pull request #6397 from Pigeon0v0/export
imp(export): 排除 HMCL 版本配置与自定义 Log4j2 文件
2025-05-28 15:18:17 +08:00
薄奚梦灵 9a0ad08498 Merge pull request #49 from LuoYun-Team/modnet
pref(ModNet):使用 HttpClient 替代过时的 WebRequest 和 WebClient
2025-05-26 13:44:49 +08:00
Pigeon0v0 3ce005b06b imp(export): 排除 HMCL 版本配置与自定义 Log4j2 文件 2025-05-25 11:10:46 +08:00
Open-KFC 30556c2347 fix #5665 在模组列表中划过鼠标时如果鼠标在模组条目列表之外松开会导致无法与悬浮卡片的按钮交互 2025-05-24 20:12:09 +08:00
wyc-26 fa2d66cc45 fix(PageVersionOverall): 缓存问题导致切换语言失败 2025-05-18 10:15:30 +08:00
Open-KFC ae8b807ad8 fix(LaunchArg): 默认窗口大小错误 2025-05-14 10:43:09 +08:00
Open-KFC b15c3e1da2 fix(FileDrag): 用户无法将文件拖放到可编辑文字控件上 2025-05-13 06:52:26 +08:00
Open-KFC 1c0bd6d02a fix(ImageTitleLogo): 保证在重新设置标题栏图片时得到刷新 2025-05-09 23:29:15 +08:00
wyc-26 ca3eb311b6 fix(PageSetupUI): 修正功能隐藏中的选项卡名称 2025-05-09 18:13:21 +08:00
written143 0f8632a10b Fix 2025-05-09 17:53:49 +08:00
written143 5594dbdb8e 添加薄煎饼披风和创始人披风的翻译 2025-05-08 20:04:13 +08:00
written143 c72cf1e3d5 添加普通披风的翻译 2025-05-07 00:30:18 +08:00
wyc-26 443d306d31 fix(ModLaunch): 证书不信任导致无法登录皮肤站*2 2025-05-05 14:30:09 +08:00
wyc-26 acaff10bf0 fix(ModLaunch): 证书不信任导致无法登录皮肤站 2025-05-05 14:15:36 +08:00
龙腾猫跃 bf6fa718c8 2.10.0 正式版 2025-05-04 20:49:18 +08:00
薄奚梦灵 85bd89fbc0 fix(PageSetupUI):错误显示了内容见 ModSetup 的提示 2025-05-03 14:13:13 +08:00
薄奚梦灵 825334cb9d Revert(88be968866): fix Hex-Dragon#6222 2025-05-03 14:10:30 +08:00
wyc-26 e6d7c06f29 refactor(PageDownloadCompDetail): 优化选择默认保存位置部分代码 2025-05-01 20:32:59 +08:00
薄奚梦灵 cfa7ce16bd fix:强制使用 HTTPS 避免获取皮肤错误 2025-05-01 18:43:03 +08:00
wyc-26 fa12897ea9 feat(ModDownloadLib): 自动创建资源包文件夹 2025-05-01 10:41:25 +08:00
wyc-26 1a71b72ab9 feat(PageDownloadCompDetail): 支持为资源包和光影包选择默认下载位置 2025-05-01 09:33:39 +08:00
薄奚梦灵 124f5c2f8b Merge pull request #43 from Hex-Dragon/main
u
2025-04-30 14:49:34 +08:00
薄奚梦灵 c492d74568 chore:修改命名 2025-04-30 07:00:24 +08:00
CreeperIsASpy 88be968866 fix #6222 2025-04-29 21:36:19 +08:00
龙腾猫跃 44aea3e962 2.10.0 2025-04-29 18:18:46 +08:00
龙腾猫跃 9c8be3a22e Merge pull request #5976 from PCL-Community/fix#5848
fix(PageDownloadInstall): 打断安装预览页面进入动画后再次切换至下载页面时显示错误
2025-04-29 01:18:29 +08:00
龙腾猫跃 da71d25a8c Merge pull request #5776 from Open-KFC/fix4677
Fix:通过网络获取到更多可更新模组时未同步至‘可更新’模组列表视图
2025-04-29 01:11:45 +08:00
龙腾猫跃 1cd42280de Merge pull request #5775 from Open-KFC/fix4596
Fix: 在点击刷新按钮后对应的MyListItem显示不正确
2025-04-29 01:08:39 +08:00
龙腾猫跃 967ff2a9c8 Merge pull request #6197 from LuoYun-Team/abuse
feat(MyMsgLogin):增加账号被封禁时的错误提示
2025-04-29 01:03:01 +08:00
龙腾猫跃 7d0b4b72c1 Merge pull request #6137 from Open-KFC/task-bar-progress
fix(ModLoader): 不应当显示的加载器的进度也被计入到显示的总进度中
2025-04-29 00:59:44 +08:00
龙腾猫跃 b29977ee2f Merge pull request #6019 from PCL-Community/fix#6000
fix(ModLaunch): 启动脚本乱码
2025-04-29 00:57:35 +08:00
薄奚梦灵 f3680f0b78 fix:大文件删除没有无法放入回收站的提示 2025-04-28 11:52:19 +08:00
薄奚梦灵 67197bfa94 Merge pull request #33 from Hex-Dragon/main
u
2025-04-28 11:41:35 +08:00
薄奚梦灵 effdf5a3a9 Merge pull request #32 from Hex-Dragon/main
u
2025-04-28 11:41:04 +08:00
龙腾猫跃 e51a5cb6c2 fix: 编译错误 2025-04-28 02:53:53 +08:00
龙腾猫跃 5177d3ca0b fix: 哪儿来的 FormLoginOAuth 2025-04-28 02:49:05 +08:00
龙腾猫跃 e7bb3d2261 Merge pull request #4360 from Pigeon0v0/datapacks
支持下载数据包
2025-04-28 02:42:51 +08:00
龙腾猫跃 cc850c8850 Merge branch 'main' into datapacks 2025-04-28 02:42:43 +08:00
龙腾猫跃 aee0ea9147 Merge pull request #4359 from Pigeon0v0/shaders
支持下载光影包
2025-04-28 02:39:30 +08:00
龙腾猫跃 0b214f20e4 Merge branch 'main' into shaders 2025-04-28 02:39:20 +08:00
龙腾猫跃 3abb4493a2 Merge pull request #4020 from Pigeon0v0/resourcepacks
支持下载资源包
2025-04-28 02:36:25 +08:00
龙腾猫跃 580a76ab8e Merge branch 'main' into resourcepacks 2025-04-28 02:36:17 +08:00
薄奚梦灵 4823a834c6 Merge pull request #24 from Hex-Dragon/main
uuu
2025-04-27 16:23:35 +08:00
薄奚梦灵 1e98e91d4a Merge pull request #19 from Hex-Dragon/main
v10�u�B�Jh24.���ʛ�qށ����(�je��N�'�?j��������o^��*
2025-04-27 07:34:08 +08:00
龙腾猫跃 9b9d138e40 Merge pull request #5773 from LuoYun-Team/check-rename
fix(BtnDisplayRename_Click):在重命名前检查路径
2025-04-25 21:50:01 +08:00
薄奚梦灵 d33cbdc3e0 chore:先丢回去 2025-04-25 21:21:24 +08:00
薄奚梦灵 c8f9066ef2 style(PageVersionOverall):移除无用代码 2025-04-25 21:10:52 +08:00
薄奚梦灵 c44d1f066c Merge branch 'main' into check-rename 2025-04-25 21:09:38 +08:00
龙腾猫跃 38b22c5242 Merge pull request #5781 from LuoYun-Team/skip-download-folder
fix(ModJava):错误将下载目录的 Java 当作特定路径 Java
2025-04-25 19:48:55 +08:00
wyc-26 7cc3595e75 fix(ModLaunch): 同步 #5909 中修改的选择编码的方式 2025-04-25 19:43:51 +08:00
龙腾猫跃 41334e69b3 Merge pull request #5896 from LuoYun-Team/tips
fix(PageSetupUI):修改显示文本
2025-04-25 19:29:10 +08:00
龙腾猫跃 31434a9b47 Merge pull request #5912 from LuoYun-Team/uac
fix:为可能出错的部分加个 Try Catch
2025-04-25 19:15:46 +08:00
龙腾猫跃 5353c109b7 Merge pull request #6101 from PCL-Community/fix#6070
fix(ModModPack): 解压压缩包进度可能超过 100%
2025-04-25 19:04:11 +08:00
龙腾猫跃 59bdc75342 Merge pull request #5792 from Open-KFC/fix5655
Fix:鼠标保持移动时抬起仍可继续改变窗口大小
2025-04-25 19:01:57 +08:00
龙腾猫跃 fd5b64bffc Merge pull request #6150 from LuoYun-Team/ignore-system32
chore:忽略 system32 的 Java
2025-04-25 18:37:04 +08:00
龙腾猫跃 5d3b1786d7 Merge pull request #6116 from LuoYun-Team/2025
fix:识别问题
2025-04-25 18:36:15 +08:00
龙腾猫跃 03b5f79d44 Merge pull request #6138 from Open-KFC/dl-spd-lim
fix(Setup): 下载速度限制的配置项不会在打开程序时被读取
2025-04-25 18:31:49 +08:00
龙腾猫跃 8b16e1fe90 Merge pull request #6076 from PCL-Community/fix#6073
fix(PageVersionExport): 无法导出某些版本的 Xearo 文件
2025-04-25 18:31:14 +08:00
龙腾猫跃 c2b4c5bb6b Merge pull request #6053 from PCL-Community/fix#6049
chore:  筛选器增加版本 1.21.5
2025-04-25 18:28:37 +08:00
龙腾猫跃 3d1833fd38 Merge pull request #5967 from PCL-Community/fix#5966
chore(MySkin): 增加渴望披风的翻译
2025-04-25 18:28:13 +08:00
龙腾猫跃 0c553219b2 Merge pull request #6042 from PCL-Community/fix#6041
fix(FormMain): 2.9.3 没有更新日志
2025-04-25 18:09:58 +08:00
薄奚梦灵 a197845749 fix: 少了 $ 2025-04-23 20:30:03 +08:00
薄奚梦灵andMichaelshenmo de7dffefe8 style(MyMsgLogin):统一格式
Co-authored-by: Michaelshenmo <[email protected]>
2025-04-23 20:28:24 +08:00
薄奚梦灵 a13a8dd83f feat(MyMsgLogin):增加账号被封禁时的错误提示 2025-04-22 07:14:45 +08:00
龙腾猫跃 acde605ce5 Update LICENCE 2025-04-22 05:43:25 +08:00
龙腾猫跃 ec06c310db 修正 3.5 的歧义 2025-04-22 05:38:23 +08:00
龙腾猫跃 dc611a982f Update LICENCE 2025-04-21 19:28:20 +08:00
薄奚梦灵 7cdada22a9 chore:忽略 system32 的 Java 2025-04-14 16:32:18 +08:00
薄奚梦灵 74657d54c7 pref(ModNet):使用 HttpClient 替代过时的 WebRequest 和 WebClient 2025-04-13 15:21:57 +08:00
Open-KFC 68f07aa6c2 fix(Setup): 下载速度限制的配置项不会在打开程序时被读取 2025-04-13 07:31:41 +08:00
Open-KFC 2775ccc4fe fix(ModLoader): 不应当显示的加载器的进度也被计入到显示的总进度中 2025-04-13 06:24:31 +08:00
薄奚梦灵andallMagic 683410743a style:空格
Co-authored-by: allMagic <[email protected]>
2025-04-12 21:45:24 +08:00
薄奚梦灵andallMagic 5302b405b7 style:空格
Co-authored-by: allMagic <[email protected]>
2025-04-12 21:45:14 +08:00
薄奚梦灵 35c5b69747 fix:shao'o'e 2025-04-11 20:28:43 +08:00
薄奚梦灵 8dc1148ebc pref(ModComp):提高代码可读性 2025-04-11 20:25:30 +08:00
薄奚梦灵 4ef328e595 fix:版本名称写错了 2025-04-11 17:27:44 +08:00
薄奚梦灵 a849c3cfd1 fix:识别问题 2025-04-11 08:49:13 +08:00
wyc-26 bd24d4c304 fix(ModModpack): 初始值不为 0 2025-04-10 16:36:01 +08:00
wyc-26 0604427492 Merge branch 'main' into fix#5966 2025-04-09 19:33:14 +08:00
wyc-26 d915fc2362 fix(ModModPack): 解压压缩包进度可能超过 100% 2025-04-09 18:21:16 +08:00
wyc-26 2f0958afb7 fix(PageVersionExport): 无法导出某些版本的 Xearo 文件 2025-04-06 20:10:56 +08:00
wyc-26 e038911973 chore: 筛选器增加版本 1.21.5 2025-04-06 00:38:32 +00:00
wyc-26 9021e96684 fix(FormMain): 2.9.3 没有更新日志 2025-04-05 19:01:32 +08:00
龙腾猫跃 16e09c792c 2.9.3 2025-04-05 18:22:00 +08:00
wyc-26 52ddb97938 chore(PageDownloadMod): 还是这样好了…… 2025-04-05 07:46:04 +08:00
wyc-26 31f0b81652 fix(PageDownloadMod): 小问题 2025-04-04 18:05:14 +08:00
wyc-26 ca729067c1 feat: 点击“下载新 Mod”按钮跳转到下载页面时自动填充搜索框的内容 2025-04-04 08:25:22 +08:00
龙腾猫跃 36cc718efb Merge pull request #6025 from PCL-Community/fix#6024
fix(ModDownloadLib): #5920 造成的无法下载 OptiFine
2025-04-03 23:57:48 +08:00
wyc-26 13340edaf0 fix(ModDownloadLib): #5920 造成的无法下载 OptiFine 2025-04-03 22:16:09 +08:00
龙腾猫跃 ca19c3cb35 Merge pull request #5899 from Open-KFC/fix5886
Fix:重选Fabric后FabricAPI不再自动选择
2025-04-03 03:58:35 +08:00
龙腾猫跃 8d85bb47c9 Merge pull request #6017 from LuoYun-Team/2025
支持识别 2025 年愚人节版本
2025-04-02 20:18:12 +08:00
wyc-26 56cf544bb8 fix(ModLaunch): 启动脚本乱码 2025-04-02 18:34:41 +08:00
薄奚梦灵 dcab78dcc4 黑历史+1 2025-04-02 13:46:58 +08:00
薄奚梦灵 c2a7882a4d pref(ModMinecraft):增加 2025 年愚人节版本的识别支持 2025-04-02 12:10:32 +08:00
wyc-26 c00d4e2bd6 Merge branch 'main' into fix#5966 2025-04-01 20:18:43 +08:00
薄奚梦灵 4cd8840385 style(modbase):无用换行 2025-04-01 13:41:30 +08:00
龙腾猫跃 e00e78c88c Merge pull request #5888 from shanlisi567/main
添加家园披风和入侵披风的翻译
2025-03-31 23:46:14 +08:00
龙腾猫跃 d1a6a88a7f Merge pull request #5938 from PCL-Community/fix#2294
fix(ModLaunch): 缓存问题导致切换语言失败
2025-03-31 23:43:46 +08:00
龙腾猫跃 1746b16da3 Merge pull request #5920 from PCL-Community/fix#5917
fix(ModDownloadLib): 1.14 及以上版本无法下载 OptiFine
2025-03-31 23:09:29 +08:00
龙腾猫跃 f518d12c0a Merge pull request #5996 from tangge233/fix/ValidServerCheck
chore: 防止小白无脑复制上面的 LittleSkin 地址到自动进入服务器
2025-03-31 23:00:19 +08:00
tangge233 0b888f7b01 chore: 防止小白无脑复制上面的 LittleSkin 地址 2025-03-31 22:35:09 +08:00
wyc-26 d91515c27d fix(PageDownloadInstall): 打断安装预览页面进入动画后再次切换至下载页面时显示错误*2 2025-03-28 22:35:47 +08:00
wyc-26 38c5f5e9a1 fix(PageDownloadInstall): 打断安装预览页面进入动画后再次切换至下载页面时显示错误 2025-03-28 20:35:35 +08:00
wyc-26 7d9923908b chore(MySkin): 增加渴望披风的翻译 2025-03-26 20:19:35 +08:00
wyc-26 59e93114a9 fix(ModLaunch): 缓存问题导致切换语言失败 2025-03-23 21:33:39 +08:00
wyc-26 d546528904 chore(ModDownloadLib): 按意见进行修改 2025-03-22 15:21:33 +00:00
wyc-26 f2b6ef27ed chore(ModMain): 优化代码 2025-03-22 15:11:33 +00:00
wyc-26 207ebb4e27 chore(ModMain): 修改描述 2025-03-22 22:30:51 +08:00
wyc-26 6b9bfbf4f6 fix(ModDownloadLib): 1.14 及以上版本无法下载 OptiFine 2025-03-22 22:28:12 +08:00
薄奚梦灵 4e14427349 fix(ModModPack):还不让用 Finally 了是吧 2025-03-22 15:53:01 +08:00
薄奚梦灵 0aabb69e16 fix(ShellOnly):只为可能出错的部分弹出提示 2025-03-22 15:43:56 +08:00
薄奚梦灵 d1d19a4bb3 fix(ModBase):加个 Try Catch 2025-03-22 09:14:23 +08:00
shanlisi567 5f7c5b2770 更改“威胁披风”为“入侵披风” 2025-03-21 12:35:08 +08:00
Open-KFC 502af24cec fix: 重选Fabric后FabricAPI不再自动选择 2025-03-21 09:07:00 +08:00
薄奚梦灵 44be631d4a fix(PageSetupUI):修改显示文本 2025-03-21 07:36:59 +08:00
Open-KFC 1f48948ca6 fix: 通过网络获取到更多可更新模组时未同步至‘可更新’模组列表视图 2025-03-20 22:52:51 +08:00
OpenKFC 443cffa285 Merge branch 'Hex-Dragon:main' into fix5655 2025-03-20 16:28:44 +08:00
OpenKFC 7eb3591353 Merge branch 'Hex-Dragon:main' into fix4596 2025-03-20 16:18:31 +08:00
OpenKFC ba3ed00e4b Merge branch 'Hex-Dragon:main' into feat4311 2025-03-20 16:09:44 +08:00
shanlisi567 c41b6b361e cape 2025-03-19 22:54:31 +08:00
单莉斯 34697c0d27 Ctrl+C Ctrl+V MySkin.xaml.vb 2025-03-19 20:32:52 +08:00
单莉斯 a4284dbc50 从全角更改到半角MySkin.xaml.vb 2025-03-19 20:21:59 +08:00
单莉斯 fce8781b22 Update MySkin.xaml.vb 2025-03-19 19:25:48 +08:00
龙腾猫跃 05d51a1336 fix: 重命名 Result 枚举为 ProcessReturnValues 2025-03-18 22:16:47 +08:00
龙腾猫跃 6ed967281b 2.9.2 2025-03-18 21:58:55 +08:00
薄奚梦灵 d42f67066a Merge pull request #10 from Hex-Dragon/main
111
2025-03-18 09:31:32 +08:00
薄奚梦灵 b8ce4ec899 Merge pull request #8 from Hex-Dragon/main
awa
2025-03-18 09:30:53 +08:00
龙腾猫跃 4c8174d6db Merge pull request #5847 from Hill23333/modname-new-style
feat: Mod命名默认值增加“【】xxx”
2025-03-17 23:11:34 +08:00
龙腾猫跃 de303f4c8b Merge pull request #5845 from nanhuajiaren/main
新功能:自动修改显卡设置
2025-03-17 22:37:59 +08:00
龙腾猫跃 ad8eb32ad9 Merge branch 'main' into main 2025-03-17 22:37:51 +08:00
薄奚梦灵 92eeba5fff fix(MyMsgInput):validate 输入
不要相信用户输入
2025-03-17 12:01:47 +08:00
Open-KFC aa3f0cd432 feat #4311: 模组管理页面无需点击右侧控件即可触发全选快捷键 2025-03-17 10:03:52 +08:00
龙腾猫跃 0b181baf6f Merge pull request #5795 from hadesanc1/hadesanc1/issue5721
Fix:在特定情况下,即使可用内存大于预计分配的内存,仍出现“(可用 xx GB)“字样
2025-03-17 01:59:43 +08:00
龙腾猫跃 47969e62dd Merge pull request #5863 from LuoYun-Team/Not-Refresh-Export-Config
Fix(PageVersionExport):没有刷新配置
2025-03-17 01:50:41 +08:00
龙腾猫跃 3b80d5915e Merge pull request #5861 from LuoYun-Team/fix-tip
fix(PageSetupLaunch):提示错误
2025-03-16 17:04:50 +08:00
薄奚梦灵 2fd1235a99 Fix(PageVersionExport):没有刷新配置 2025-03-16 11:55:33 +08:00
薄奚梦灵 5e24f91029 style(PageSetupLaunch):语法错误 2025-03-16 11:01:06 +08:00
薄奚梦灵 e6ba658e16 fix(PageSetupLaunch):提示错误 2025-03-16 10:58:02 +08:00
龙腾猫跃 e7034db134 Merge pull request #5415 from tangge233/NAudio
优化:自动切换到默认音频设备
2025-03-15 17:43:19 +08:00
tangge233 482d6f71fc fix(ModMusic): 千年播放老问题 2025-03-15 01:24:57 +08:00
tangge233 bf86b0732a fix: 默认音频设备的代号应该是 -1 2025-03-15 01:07:23 +08:00
tangge233 39b84e8701 style: 切换逻辑移位 2025-03-15 00:36:06 +08:00
龙腾猫跃 415188c962 Merge pull request #5785 from LuoYun-Team/allow-disable-jlw
feat(ModLaunch):允许不使用 JLW
2025-03-14 23:42:33 +08:00
龙腾猫跃 7bac28edd9 Merge pull request #5818 from allMagicNB/encoding-fix
修复编码
2025-03-14 22:47:53 +08:00
龙腾猫跃 4d25a3d61f Merge pull request #5777 from LuoYun-Team/ins-opt-as-mod
refactor(McInstallLoader):始终将 OptiFine 作为 Mod 安装
2025-03-14 20:58:41 +08:00
Hill23333 bccb2901ed feat: Mod命名默认值增加“【】xxx” 2025-03-13 21:48:32 +08:00
nanhuajiaren 715c4666f3 新增显示设置功能,通过写入注册表将MC设置为“高性能” 2025-03-13 15:41:37 +08:00
nanhuajiaren 482812ce85 Revert "新增显示设置功能,通过写入注册表将MC设置为“高性能”"
This reverts commit 2e9ca1345c.
2025-03-13 15:39:27 +08:00
nanhuajiaren 2e9ca1345c 新增显示设置功能,通过写入注册表将MC设置为“高性能” 2025-03-13 15:33:01 +08:00
allMagic 49a1016da5 fix space 2025-03-09 15:04:13 +08:00
allMagic 5c70a594b0 Encoding Fixed 2025-03-09 14:32:03 +08:00
Ciilu 855ff55495 扩展名排除 2025-03-08 07:18:05 +08:00
Ciilu a174c4856a update 2025-03-07 22:12:58 +08:00
hadesanc1 d0b6e54b29 在特定情况下,即使可用内存大于预计分配的内存,仍出现“(可用 xx GB)“字样
Fixes #5721
2025-03-07 18:41:00 +08:00
Open-KFC 16755cd4a9 fix #5655: 鼠标保持移动时抬起仍可继续改变窗口大小 2025-03-07 03:43:21 +08:00
薄奚梦灵 d88509018d Revert(ModSetup):删除调试痕迹 2025-03-05 18:38:27 +08:00
薄奚梦灵 2f6b283e0d Revert(Setup&Launch):撤销更改 2025-03-05 18:37:13 +08:00
薄奚梦灵 013c64ba4f fix(PageVersionSetup):没有增加对应内容
chore(Setup): 修改描述
2025-03-05 18:29:12 +08:00
薄奚梦灵 c24fb4ee6a fix(ModLaunch):逻辑错误导致版本设置的使用 JLW 选项无效 2025-03-05 18:23:35 +08:00
薄奚梦灵 60d14e8594 feat(setup):允许禁用 jlw 2025-03-05 13:57:09 +08:00
薄奚梦灵 7c3d820f12 chore(ModJava):删掉多余的让龙猫写 2025-03-04 21:59:30 +08:00
薄奚梦灵 045c378526 chore(ModJava):注释 2025-03-04 21:57:38 +08:00
薄奚梦灵 287d3aeb45 fix(ModJava):排除下载目录的 Java 2025-03-04 21:47:43 +08:00
薄奚梦灵 e973b1174b fix(McInstallLoader):始终将 OptiFine 作为 Mod 安装 2025-03-04 12:32:23 +08:00
薄奚梦灵 da6b64c9bc fix(btnDisplayDesc_Click):少了个标记 2025-03-04 12:30:43 +08:00
薄奚梦灵 80a004ceef fix(BtnDisplayRename_Click):在重命名前检查路径 2025-03-04 12:04:17 +08:00
Open-KFC 0ee9215b8e fix #4596: 在点击刷新按钮后对应的MyListItem显示不正确 2025-03-03 23:32:05 +08:00
薄奚梦灵 40e0afefdd fix(ModValidate):未检查路径是否存在 2025-03-03 16:30:02 +08:00
龙腾猫跃 503244a0de 2.9.1 2025-02-22 01:20:08 +08:00
龙腾猫跃 1a0c7b0520 Merge pull request #4758 from youzi-3222/feat-98
导出整合包 复活
2025-02-22 00:15:16 +08:00
龙腾猫跃 a6ebf3b43d Merge pull request #5650 from tangge233/FixModrinthApi
修复:没读取 loaders 字段
2025-02-12 23:14:20 +08:00
tangge233 bbb8e97712 fix: not read loader info on modrinth 2025-02-12 21:27:11 +08:00
龙腾猫跃 bcc63bebe9 Merge pull request #5634 from 3gf8jv4dv/fix-dirtpath-term
Revise GrassPath translation
2025-02-12 18:41:19 +08:00
龙腾猫跃 dbe09a3283 Merge pull request #5526 from Txt-Text/main
读取MMC整合包instance.cfg中的JvmArgs参数
2025-02-12 18:32:46 +08:00
龙腾猫跃 b7e7126572 Merge pull request #5523 from Silverteal/patch-1
修改 Referer 的字段顺序以符合正常语义
2025-02-12 18:18:08 +08:00
龙腾猫跃 51490a637a Merge pull request #5508 from LuoYo-Team/Remove-ClientToken
Chore:移除 ClientToken & 对 ModLaunch 刷新请求部分进行解耦合
2025-02-12 18:12:33 +08:00
龙腾猫跃 406d19b678 Merge pull request #5647 from Muqingxue-Studio/main
Fix:硬编码路径导致编译问题
2025-02-12 17:37:04 +08:00
慕轻雪 1db1323273 Merge pull request #1 from Muqingxue-Studio/mqingxue-patch-1
ci:use context
2025-02-12 15:31:53 +08:00
慕轻雪andallMagicNB f31a5b14bc ci:use context
Co-authored-by: allMagicNB <[email protected]>
2025-02-12 15:31:35 +08:00
慕轻雪 b5407ad644 Fix:Self-hosted runner 不会自动清理文件导致编译失败 2025-02-12 14:44:59 +08:00
慕轻雪 5740b16325 Fix:使用了错误的变量名 2025-02-12 14:18:59 +08:00
慕轻雪 9ff7f89f86 Update build.yml 2025-02-12 14:09:47 +08:00
慕轻雪 c27dfff84c Fix:使用字符串模板插入&修改命名以避免与自带变量冲突 2025-02-12 14:06:15 +08:00
慕轻雪 25f9363170 Fix:路径拼接 2025-02-12 14:02:10 +08:00
慕轻雪 74730f6102 Chore:自动获取工作目录 2025-02-12 13:55:42 +08:00
3gf8jv4dv 2441c52526 Revise GrassPath translation
Ref: History section on https://minecraft.wiki/w/Dirt_Path

Resolves Hex-Dragon#5633
2025-02-10 19:01:22 +08:00
龙腾猫跃 aa7ee23039 Merge pull request #5611 from Muqingxue-Studio/main
Feat:优化 Actions 文件
2025-02-07 17:55:29 +08:00
慕轻雪 e48f39ef5b Test 2025-02-07 13:19:34 +08:00
慕轻雪 df2cc61c27 Add Description 2025-02-06 22:39:44 +08:00
慕轻雪 4f2e20ff4e Format Code 2025-02-06 22:35:00 +08:00
慕轻雪 cde644c1e1 done 2025-02-06 22:22:43 +08:00
慕轻雪 aa3e08a7fb test 2025-02-06 22:10:39 +08:00
慕轻雪 4c1e9ccf72 Fix bug 2025-02-06 22:04:44 +08:00
慕轻雪 f8cbbf8092 test 2025-02-06 22:01:35 +08:00
无聊的小洛 b0e4ca9cbc Chore:格式化源代码 2025-02-06 21:29:30 +08:00
无聊的小洛and慕轻雪 9118b1d20e Update Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
Co-authored-by: 慕轻雪 <[email protected]>
2025-02-06 21:05:03 +08:00
youzi-3222 fc1519e9b1 👌 🐛 ✨ 修改 @MoYuan-CN 的 Review,修复已知问题 2025-02-03 21:53:49 +08:00
龙腾猫跃 c5197e2f2d 2.8.13 正式版 2025-01-27 23:39:43 +08:00
huangyu 63d36f6595 Merge branch 'Hex-Dragon:main' into main 2025-01-27 15:47:35 +08:00
Txt-Text 72a33fe2cc Update ModModpack.vb
读取JvmArgs参数,删除一些废话注释
2025-01-27 11:18:37 +08:00
Txt-Text 847c433310 Update ModModpack.vb
让PCL能够正确读取MMC整合包instance.cfg中的JvmArgs
2025-01-27 09:52:00 +08:00
Silverteal 30579e6f41 修改Referer的字段顺序以符合正常语义 2025-01-26 22:41:05 +08:00
无聊的小洛 feade470a4 移除 LittleSkin OAuth 代码 2025-01-25 22:34:51 +08:00
无聊的小洛 3eed7c5b7f 移除 ClientToken 2025-01-25 22:24:56 +08:00
龙腾猫跃 70636a9a77 2.8.13 2025-01-25 03:00:46 +08:00
youzi-3222 86b0e6d459 🔥 删除 Logo 相关代码 2025-01-23 08:56:44 +08:00
youzi-3222 1b8d164061 🐛 修复已知问题 2025-01-23 08:00:59 +08:00
龙腾猫跃 107a5ae016 再次明确第六条 2025-01-22 18:38:13 +08:00
龙腾猫跃 391d50ce34 明确“相似功能”的限制 2025-01-21 22:11:07 +08:00
youzi-3222 74a9d18fc5 ♿ 👌 导出整合包改用 Loader 2025-01-17 14:02:08 +08:00
youzi-3222 08ad8e6682 ✨ 👌 允许多个链接 2025-01-16 18:24:25 +08:00
youzi-3222 1e5d5f0377 🐛 👌 Mod 文件保留原始文件名 2025-01-16 17:33:40 +08:00
youzi-3222 e6e9ebd5dc 💄 👌 合并预览与信息卡片 2025-01-16 16:27:56 +08:00
龙腾猫跃 604bcd0997 Merge pull request #5404 from hadesanc1/hadesanc1/issue5402
当在版本设置中连续按下mod右侧的“删除”按钮时,g概率导致PCL2崩溃。
2025-01-16 00:25:57 +08:00
龙腾猫跃 96a4bd05bd Merge pull request #5400 from hadesanc1/hadesanc1/issue5366
“设置/个性化/功能隐藏”字样在PCL2小窗口时不能完整显示文本
2025-01-16 00:18:26 +08:00
龙腾猫跃 36df43ad8a Merge pull request #5414 from hadesanc1/hadesanc1/issue5241
加载图标过于靠下
2025-01-16 00:07:16 +08:00
龙腾猫跃 46713b3870 Merge pull request #5398 from hadesanc1/hadesanc1/issue5259
搜索部分mod时未在mod下载详情页出现MC版本筛选
2025-01-16 00:04:53 +08:00
龙腾猫跃 58dfc9a25d Merge pull request #5413 from hadesanc1/hadesanc1/issue5248
[mod前置数量显示错误]在有前置的mod详情界面,离开再回来,mod前置显示增加
2025-01-16 00:02:03 +08:00
龙腾猫跃 51751f2464 Merge pull request #5354 from wuliaodexiaoluo/main
Fix:语言标头问题
2025-01-15 23:59:52 +08:00
龙腾猫跃 eaf7a93b52 Merge pull request #5337 from Silverteal/dpi-patch-1
通过修改 DPI 配置增强多屏幕 DPI 体验
2025-01-15 23:58:06 +08:00
龙腾猫跃 718d61af29 Merge pull request #5293 from PlayMcBKuwu/main
修复: 判断语言是否为中文 -> 判断语言是否为中文(中国大陆)
2025-01-15 23:51:58 +08:00
龙腾猫跃 49c2318ece Merge pull request #5260 from Pigeon0v0/office-cape
添加办公室披风翻译
2025-01-15 23:50:13 +08:00
龙腾猫跃 3a90962001 Merge pull request #5412 from hadesanc1/hadesanc1/issue5255
[可视化mod列表出错...]搜索Sand Filter时必报错
2025-01-15 22:44:58 +08:00
youzi-3222 838cb79420 🎨 取消测试时的注释 2025-01-14 16:50:51 +08:00
youzi-3222 f6cbb0f986 ♻️ 🐛 修复关闭版本隔离时的问题 2025-01-14 16:47:28 +08:00
youzi-3222 1dd235d313 Merge branch 'feat-98' of https://github.com/youzi-3222/PCL2 into feat-98 2025-01-14 15:12:53 +08:00
youzi-3222 fa778eedb7 🔀 合并上游分支 2025-01-14 14:21:40 +08:00
tangge233 7dff62aebf feat: output device change 2025-01-13 21:46:12 +08:00
tangge233 5034866c8f Merge branch 'main' into NAudio 2025-01-13 21:22:52 +08:00
hadesanc1 836260478c 加载图标过于靠下
Fixes #5241
2025-01-13 20:33:13 +08:00
hadesanc1 96c35a3bed [mod前置数量显示错误]在有前置的mod详情界面,离开再回来,mod前置显示增加
Fixes #5248
2025-01-13 20:06:41 +08:00
hadesanc1 81cf8c1901 [可视化mod列表出错...]搜索Sand Filter时必报错
Fixes #5255
2025-01-13 19:36:28 +08:00
hadesanc1 3b1ab78fb9 当在版本设置中连续按下mod右侧的“删除”按钮时,g概率导致PCL2崩溃。
Fixes #5402
2025-01-12 12:21:00 +08:00
hadesanc1 df83b248f8 “设置/个性化/功能隐藏”字样在PCL2小窗口时不能完整显示文本
Fixes #5366
2025-01-12 03:05:19 +08:00
hadesanc1 8b0694fdd0 搜索部分mod时未在mod下载详情页出现MC版本筛选
Fixes #5259
2025-01-12 00:31:09 +08:00
无聊的小洛 28c32765ce Fix:语言标头问题 2025-01-01 13:48:29 +08:00
Silverteal 5e55e48259 Update App.config 2024-12-26 15:18:00 +08:00
Silverteal ed72973cef Update app.manifest 2024-12-26 15:13:46 +08:00
鹿目 まどか Advancedand3gf8jv4dv a1da68a8c2 修复: 判断语言是否为中文 -> 判断语言是否为中文(中国大陆)
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-12-15 22:11:18 +08:00
鹿目 まどか Advanced 53f7aa0b40 修复: 判断语言是否为中文 -> 判断语言是否为中文(中国) 2024-12-15 22:06:33 +08:00
Pigeon0v0 68bb80fc81 add: 办公室披风翻译 2024-12-14 08:59:38 +08:00
龙腾猫跃 a8bb82b033 2.8.12 正式版 2024-12-13 18:16:06 +08:00
龙腾猫跃 7083b0f4f4 2.8.12 2024-12-11 20:16:31 +08:00
龙腾猫跃 6ed0c6e4fe 2.8.11(重新上传) 2024-12-08 22:09:43 +08:00
龙腾猫跃 f678dfe853 fix: #5238 2024-12-08 21:11:57 +08:00
龙腾猫跃 b37c264e32 Update PageOtherTest.xaml.vb 2024-12-08 20:58:40 +08:00
龙腾猫跃 68f8b3eeac 2.8.11 2024-12-08 20:21:23 +08:00
龙腾猫跃 37354d15f7 Merge pull request #5229 from allMagicNB/main
自动编译时添加 Help.zip
2024-12-08 19:40:47 +08:00
allMagicNB 38b3cefa89 fix 2024-12-08 19:29:23 +08:00
allMagicNB bce8e71571 fix 2024-12-08 06:59:23 +08:00
allMagicNB f300858ced fix 2024-12-07 23:39:29 +08:00
allMagicNB bdcbab700e + PCL2Help.zip 2024-12-07 23:07:41 +08:00
龙腾猫跃 b8eb669351 Merge pull request #5225 from Ad-closeNN/main
[优化] 为 option.txt 加上 s
2024-12-07 19:28:02 +08:00
Ad-closeNN b9d69a3258 为 option.txt 加上 s 2024-12-07 19:17:46 +08:00
龙腾猫跃 e454f0c640 Merge pull request #5212 from 3gf8jv4dv/download-page-version-filter
Change the download page version filter item
2024-12-05 23:55:05 +08:00
龙腾猫跃 454c9ea377 Merge pull request #5129 from Hill23333/main
修复32位Java提示错误
2024-12-05 21:29:21 +08:00
龙腾猫跃 4f258c8078 Merge pull request #5098 from lactobionicAcid/branch
Fix #5096
2024-12-05 20:41:24 +08:00
龙腾猫跃 4b2e2d8eef Merge pull request #5073 from tangge233/homepage
优化:请求头逻辑
2024-12-05 18:58:53 +08:00
龙腾猫跃 1242d97a1c Update LICENCE 2024-12-05 02:07:04 +08:00
龙腾猫跃 6225391afa Update LICENCE 2024-12-05 02:04:46 +08:00
龙腾猫跃 b1a0e9a79d 允许分发衍生内容 2024-12-05 01:28:49 +08:00
龙腾猫跃 347bc8fb82 Update README.md 2024-12-05 01:20:17 +08:00
3gf8jv4dv 6bdf7e235a Change the download page version filter item
- Remove 1.21.3
- Add 1.21.4
2024-12-03 21:45:43 +08:00
Hill23333 d7424d4d2b Merge branch 'Hex-Dragon:main' into main 2024-11-24 18:23:18 +08:00
龙腾猫跃 37561a842b Delete .github/workflows/issue_similarity.yml 2024-11-18 19:00:37 +08:00
Hill23333 e04e462737 少了个“Not” 2024-11-16 22:58:19 +08:00
Hill23333 ba262a1741 修复32位Java提示错误 2024-11-16 22:38:55 +08:00
乳糖酸酱 df11fa5a9d Merge branch 'Hex-Dragon:main' into branch 2024-11-16 02:39:57 +08:00
龙腾猫跃 b6a52f90f6 Update README.md 2024-11-12 14:53:32 +08:00
lactobionicAcid 531706e73b Update ModMusic.vb 2024-11-10 16:12:29 +08:00
lactobionicAcid 66a2406e0a Update ModMusic.vb 2024-11-10 16:10:03 +08:00
lactobionicAcid 6ec48abe77 Fix #5096 2024-11-10 15:51:07 +08:00
tangge233 9aecc1920a fix: 目录问题…… 2024-11-09 09:43:04 +08:00
tangge233 75cc86d2a2 feat: 自己下 2024-11-08 22:09:52 +08:00
tangge233 8abf4707a1 chore: 漏了一个,问题不大 2024-11-08 17:05:21 +08:00
tangge233 b6cc6c10c3 fix: 不是每个请求都需要的 Header 2024-11-08 16:54:29 +08:00
tangge233 5d16cf24bb chore: 换一个方式 2024-11-08 16:51:38 +08:00
tangge233 05acfc6b51 fix: B站图床 2024-11-08 16:19:14 +08:00
龙腾猫跃 2a46c9f5ce 2.8.10 2024-11-08 00:43:29 +08:00
龙腾猫跃 47585e5c9d Merge pull request #5030 from 3gf8jv4dv/minecraft.experience-cape-translation
Add translation for Minecraft Experience cape
2024-11-08 00:00:39 +08:00
龙腾猫跃 114d9dd079 Merge pull request #5043 from ZeroWolf233/main
按F5刷新自定义主页
2024-11-04 17:38:51 +08:00
龙腾猫跃 9aff4288b8 Merge pull request #4998 from 3gf8jv4dv/download-page-version-filter
Change the download page version filter item
2024-11-04 16:52:11 +08:00
ZeroWolf cb322b6fa0 chore: 删除没用的东西 2024-11-02 11:25:46 +08:00
ZeroWolf233 6f1db2d079 chore: 减少屎山 2024-11-01 21:41:21 +08:00
ZeroWolf233 07ac34dafe chore: 删掉莫名其妙的第7行 2024-11-01 21:37:24 +08:00
ZeroWolf233 4638ed72f2 Merge branch 'main' of github.com:ZeroWolf233/PCL2 2024-11-01 21:25:13 +08:00
ZeroWolf233 b04ee5f28f feat: 按F5刷新自定义主页 2024-11-01 21:24:35 +08:00
龙腾猫跃 7756187dee Merge pull request #5040 from tangge233/patch-1
chore: 微调 action 脚本参数...
2024-11-01 15:02:31 +08:00
tangge233 6a10bd5406 chore: 微调参数... 2024-11-01 10:09:22 +08:00
3gf8jv4dv 134857b62f Revise 2024-10-29 21:54:22 +08:00
3gf8jv4dv ade7bcff64 Add translation for Minecraft Experience cape 2024-10-28 21:27:29 +08:00
龙腾猫跃 d599245369 Merge pull request #5025 from MiyamizuSu/main
修正了一处bug
2024-10-28 02:08:33 +08:00
MiyamizuSu 70936254de 修正了一处bug:
版本隔离弹窗取消无效bug
issue#4995
2024-10-27 20:29:13 +08:00
tangge233 9786a447ca chore: 接口 2024-10-26 11:50:08 +08:00
龙腾猫跃 564ee333aa Merge pull request #5001 from tangge233/action
利用 action bot 进行 issue 查重
2024-10-24 15:09:48 +08:00
tangge233 4a2666a998 Create issue_similarity.yml 2024-10-23 21:32:00 +08:00
3gf8jv4dv cadb9bb4a0 Change the download page version filter item 2024-10-23 21:11:17 +08:00
龙腾猫跃 c2d20e422b 2.8.9 正式版 2024-10-21 00:46:14 +08:00
龙腾猫跃 3f8e64450a 编译修复 2024-10-16 03:34:19 +08:00
龙腾猫跃 c5ae532fd5 2.8.9 2024-10-16 03:24:00 +08:00
龙腾猫跃 fb1caf0c8f Merge pull request #4810 from tangge233/Server
新功能:原版服务端下载功能
2024-10-15 17:16:08 +08:00
龙腾猫跃 2ad1a6bae2 Merge pull request #4868 from tangge233/WebP
MyImage 控件
2024-10-14 03:51:47 +08:00
龙腾猫跃 6de59a7f5b Update MyImage.vb 2024-10-14 03:51:13 +08:00
tangge233and龙腾猫跃 8d266c8a0b chore: apply suggestions
Co-Authored-By: 龙腾猫跃 <[email protected]>
2024-10-13 22:43:31 +08:00
tangge233 e1d58151cf chore: add summary tip 2024-10-13 21:39:33 +08:00
tangge233 7ba082c3f2 chore: apply suggestions 2024-10-13 21:33:10 +08:00
游子柚子andPigeon0v0 f27822b005 💬 高级选项提示文案
Co-authored-by: Pigeon0v0 <[email protected]>
2024-10-13 20:51:52 +08:00
tangge233 494e4f6516 Merge branch 'Hex-Dragon:main' into WebP 2024-10-13 10:35:08 +08:00
tangge233 0a9d115fd5 Merge branch 'Hex-Dragon:main' into Server 2024-10-13 10:34:58 +08:00
Hex Dragon Bot 106be2fbaf Merge pull request #4506 from SALTWOOD/main
通过检测 NTFS 8.3 文件名修复 #4505
2024-10-13 04:41:47 +08:00
龙腾猫跃 ac9011a323 修改标签 2024-10-13 04:28:38 +08:00
tangge233 50112b70bd chore: Try Catch 2024-10-09 00:24:47 +08:00
tangge233 71d915f3ef feat: UseCache 选项和异步加载图片 2024-10-09 00:14:05 +08:00
tangge233 e6c1b192ce Revert MyBitmap.vb 2024-10-08 23:30:45 +08:00
tangge233 788f7c9a96 fix: 不使用磁盘缓存 2024-10-03 13:49:54 +08:00
tangge233 e782d0ed2d fix: apply suggestions 2024-10-02 17:22:20 +08:00
tangge233 a6aa7847c0 feat: 修改实现方式 2024-10-02 12:07:42 +08:00
tangge233 805a0e1544 fix: 测试忘记删了 2024-10-01 23:17:12 +08:00
tangge233 94476384bd feat: MyImage 控件 2024-10-01 23:12:40 +08:00
tangge233 b1c01873b7 Merge branch 'Hex-Dragon:main' into Server 2024-10-01 21:25:52 +08:00
Pigeon0v0 4a6a17e380 ui: 从#4770 偷来了一个 Icon 2024-10-01 14:39:08 +08:00
Pigeon0v0 4de4577103 ui: 从#4770 偷来了一个 Icon 2024-10-01 14:38:18 +08:00
龙腾猫跃 76bf3c40d0 2.8.8 2024-10-01 03:39:04 +08:00
龙腾猫跃 d48ab143be 添加主页预设反馈入口 2024-10-01 02:19:52 +08:00
龙腾猫跃 fad37c9b46 正式版 2.8.7 2024-09-28 17:58:43 +08:00
tangge233 ddb6ef9426 Merge branch 'Hex-Dragon:main' into Server 2024-09-24 19:09:44 +08:00
龙腾猫跃 b5c9736918 2.8.7 2024-09-24 17:04:14 +08:00
龙腾猫跃 30bc43bdb5 Merge pull request #4228 from allMagicNB/main
让工作流编译支持替换 client_id 和 x-api-key
2024-09-24 13:11:29 +08:00
龙腾猫跃 2dfa810431 Merge branch 'main' into main 2024-09-24 13:11:20 +08:00
allMagic 8e0368180c 更新 build.yml 2024-09-24 05:40:12 +08:00
tangge233 c9fb9b9eea feat: 下载器 2024-09-23 22:23:22 +08:00
tangge233 d2620297ca feat: 原版服务端下载功能 2024-09-23 21:23:36 +08:00
龙腾猫跃 778e5636ce Merge pull request #4779 from Pigeon0v0/fix-3868
Fix #3868
2024-09-22 15:37:34 +08:00
Pigeon0v0 0d8b8fc267 fix: 多打了一个 s 导致有些光影下不了 2024-09-22 13:14:10 +08:00
Pigeon0v0 cc46b29ba6 Fix #3868 2024-09-22 11:02:30 +08:00
Pigeon0v0 893f791bb2 chores: 同步 #4360 有关下载任务名称的修改 2024-09-22 10:30:14 +08:00
Pigeon0v0 f0b32ab6f2 chores: 同步 #4360 有关下载任务名称的修改 2024-09-22 10:24:01 +08:00
Pigeon0v0 ff6239bb89 Merge branch 'main' into shaders 2024-09-22 10:20:14 +08:00
Pigeon0v0 d1eac50d15 Merge branch 'main' into datapacks 2024-09-22 10:16:53 +08:00
Pigeon0v0 9d3be21090 fix: 修复了查看数据包工程时崩溃的问题,但可能会炸掉点别的东西,需要测试 2024-09-22 10:15:49 +08:00
龙腾猫跃 49fe40662f Merge pull request #3940 from Pigeon0v0/auth
微软登录设备代码流
2024-09-22 01:53:04 +08:00
龙腾猫跃 1aaf37f815 Merge pull request #4743 from tangge233/webp
新功能:支持加载 WebP 格式图片的资源图标
2024-09-19 20:24:56 +08:00
龙腾猫跃 3606a834c0 Merge pull request #4709 from OLDRedstone/main
修复因未使用模组列表搜索并尝试移除搜索结果导致的异常#4691
2024-09-19 18:14:27 +08:00
tangge233 08faaf1f46 feat: 支持转换 webp 图片 2024-09-16 16:48:43 +08:00
OLDREDSTONE 7afd002b85 Fix #4691 2024-09-10 14:14:32 +08:00
龙腾猫跃 4f69e9e2d2 2.8.6 正式版 2024-09-05 18:07:00 +08:00
龙腾猫跃 140b7effca 2.8.6 2024-09-05 05:55:55 +08:00
allMagic e51f6f0a66 Update .github/workflows/build.yml 2024-09-03 20:02:17 +08:00
allMagic b30ad60d99 Update Plain Craft Launcher 2/Modules/Base/ModBase.vb 2024-09-03 19:56:54 +08:00
allMagic 5bf3ce0105 Update Plain Craft Launcher 2/Application.xaml.vb 2024-08-31 18:26:47 +08:00
allMagic ae503a6945 更新 build.yml 2024-08-31 18:16:08 +08:00
allMagic dff5b4730e Merge branch 'main' into main 2024-08-31 18:05:50 +08:00
allMagic 4d28be2610 更新 ModBase.vb 2024-08-31 17:55:06 +08:00
allMagic 58ad193581 更新 Application.xaml.vb 2024-08-31 17:54:43 +08:00
allMagic 9fb45610bf 更新 Application.xaml.vb 2024-08-31 17:48:53 +08:00
allMagic 0d47b82c71 + CommitHash 2024-08-31 17:02:16 +08:00
龙腾猫跃 007b51b314 2.8.5 2024-08-31 02:39:45 +08:00
龙腾猫跃 a74b2d55c7 添加对复刻赞助功能的限制 2024-08-31 02:25:50 +08:00
龙腾猫跃 1d946cb675 Merge pull request #4498 from JingHai-Lingyun/issue3519
LittleSkin 登陆失败时使用 Json 返回的错误数据中的建议
2024-08-31 01:59:57 +08:00
龙腾猫跃 6dea3ffb9c Merge pull request #4621 from Pigeon0v0/neo-desc
修改 NeoForge 介绍
2024-08-31 01:42:12 +08:00
allMagic e32bc28510 漏个单引号 2024-08-31 00:46:15 +08:00
allMagic 9ed5f04f17 Update Plain Craft Launcher 2/Modules/ModSecret.vb 2024-08-31 00:44:40 +08:00
allMagic d390ce05d4 Update Plain Craft Launcher 2/Modules/ModSecret.vb 2024-08-31 00:44:33 +08:00
allMagic 6b041cd540 Update .github/workflows/build.yml 2024-08-31 00:42:45 +08:00
allMagic c917066e0b + Const 2024-08-31 00:40:21 +08:00
Pigeon0v0 bec86c0022 Merge branch 'main' into resourcepacks 2024-08-28 19:44:46 +08:00
Pigeon0v0 7b7ad7899a Merge branch 'main' into auth 2024-08-28 19:43:39 +08:00
Pigeon0v0 545ebd680f text: 修改 NeoForge 介绍,更严谨一点 2024-08-28 19:38:47 +08:00
allMagic 5ea5dc3164 Fix Replace client_id 2024-08-27 11:06:43 +08:00
allMagic 68c1deb2aa Merge branch 'main' into main 2024-08-27 10:15:09 +08:00
凌云 3d7cffbcde Merge branch 'Hex-Dragon:main' into issue3519 2024-08-26 18:02:00 +08:00
youzi-2333 10e4bc0bbb 🐛 Tag: resources -> resourcepacks
我是傻逼。
2024-08-20 15:33:14 +08:00
tangge233 37eacb00c5 comment: 同步下注释 2024-08-20 14:28:25 +08:00
tangge233 ef5b0ba1f7 fix: 搁这最强大脑呢? 2024-08-20 14:24:40 +08:00
youzi-2333 ddfc6897d7 🐛 修复一些问题 2024-08-20 12:27:12 +08:00
allMagic 2bdda5795a 更新 build.yml 2024-08-20 11:23:25 +08:00
allMagic 26c492b370 更新 build.yml 2024-08-20 11:15:08 +08:00
allMagic b6a06f8d8d 更新 build.yml 2024-08-20 11:13:04 +08:00
龙腾猫跃 f40a299010 Merge pull request #4404 from tangge233/ModFilter
新功能:简单的本地 Mod 筛选
2024-08-20 00:16:45 +08:00
龙腾猫跃 a509ac6337 Merge pull request #4541 from tangge233/ModPageUIImprove
优化:当有 Mod 选中时在下方空开一定空间方便操作
2024-08-19 19:57:00 +08:00
龙腾猫跃 cfdda03b35 Merge pull request #4533 from wuliaodexiaoluo/4532
Fix #4532
2024-08-19 19:53:14 +08:00
tangge233 894b36e746 style: 当有 Mod 选中时在下方空开一定空间方便操作 2024-08-18 21:41:14 +08:00
无聊的小洛 e42098171e 更新地址 2024-08-18 11:02:24 +08:00
凌云 76549b4039 Merge branch 'Hex-Dragon:main' into issue3519 2024-08-18 07:18:59 +08:00
tangge233 93574f60f4 Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-17 15:48:30 +08:00
龙腾猫跃 62394e0052 2.8.4 2024-08-17 01:46:19 +08:00
凌云andallMagic 0acd917e6b Use suggestion
Update Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

Co-authored-by: allMagic <[email protected]>
2024-08-16 19:09:22 +08:00
SALTWOOD 2427fb7619 refactor: 使用正则表达式检测 NTFS 8.3 文件名 2024-08-16 11:38:09 +08:00
SALTWOOD 3af99aca0a fix: 少了一个字 2024-08-15 17:24:42 +08:00
SALTWOOD 8b0d9e5a5c fix: 暂时使用波浪号检测修复 #4505 2024-08-15 17:12:27 +08:00
tangge233 05dc7a2650 fix: 窗口重获焦点后筛选项被重置 2024-08-15 17:03:41 +08:00
huangyu c0f8b5c701 End if 2024-08-15 15:07:37 +08:00
JingHai-Lingyun 881e79dfdf Fix 2024-08-14 22:38:24 +08:00
tangge233 20fcb59e36 Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-14 18:07:05 +08:00
allMagic f919ae49af Merge branch 'Hex-Dragon:main' into main 2024-08-14 18:06:44 +08:00
龙腾猫跃 c62ab46b99 Merge pull request #4485 from allMagicNB/Fix-#4482
Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482
2024-08-14 05:29:20 +08:00
龙腾猫跃 bdb19e1ae4 Merge pull request #4491 from LxHTT/main
fix: 下载 NeoForge 时,从未使用镜像源
2024-08-13 22:55:21 +08:00
Pigeon0v0 5598ff3239 fix: 新增的 otc 参数可能导致网页无法打开,解决方案是去掉了这个参数 2024-08-13 21:57:24 +08:00
LxHTT b11c8c5d96 fix: 下载 NeoForge 时,从未使用镜像源 2024-08-13 21:30:47 +08:00
allMagicNB 348472b3ca Revert 2024-08-13 19:33:15 +08:00
tangge233 918178d0bd Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-13 14:28:42 +08:00
allMagicNB 19fe4c03dc Fix #4482:+ "chcp 65001 > nul" & Encoding:=Encoding.UTF8 2024-08-13 14:00:26 +08:00
allMagicNB 06d92556b6 Fix 导出崩溃报告中的 “游戏崩溃前的输出.txt” 可能乱码 #4482 2024-08-13 11:57:46 +08:00
allMagic 1519c9038a Merge branch 'Hex-Dragon:main' into main 2024-08-13 10:46:07 +08:00
龙腾猫跃 4c1bfe9140 Merge pull request #4438 from 3gf8jv4dv/kitchen-sink
Revise the translation of Kitchen Sink
2024-08-13 03:46:08 +08:00
tangge233 9577e9946b Merge branch 'Hex-Dragon:main' into ModFilter 2024-08-12 09:54:33 +08:00
龙腾猫跃 a6d6c97fd7 Merge pull request #4415 from allMagicNB/Close-#4366
Close 添加对 MCC 15周年披风的翻译 #4366
2024-08-12 03:11:51 +08:00
龙腾猫跃 1c6af2caca Merge pull request #4291 from youzi-2333/feat-setup-modsrc
添加国内 Mod 镜像下载源
2024-08-12 03:08:47 +08:00
龙腾猫跃 12a3712524 Merge pull request #4449 from tangge233/VersionSortFix
fix: 检测愚人节版本所用时区不正确
2024-08-12 03:07:56 +08:00
龙腾猫跃 9d56a95dcb Merge pull request #4441 from 3gf8jv4dv/mod_modpack-download-filter-gameversion-1.21.1
Add 1.21.1 to Mod and Modpack downloadpage version filter
2024-08-12 03:02:35 +08:00
tangge233 e5a0eddcea fix: 检测愚人节版本所用时区不正确 2024-08-09 14:05:29 +08:00
3gf8jv4dv f7d2cd1cb6 Add 1.21.1 to Mod and Modpack downloadpage version filter 2024-08-08 08:27:58 +08:00
3gf8jv4dv ec3ebe3215 Update 2024-08-07 23:51:17 +08:00
3gf8jv4dv 084fb1248e Revise the translation of Kitchen Sink 2024-08-07 22:41:03 +08:00
tangge233 53743495ec fix: 全选逻辑不正确 2024-08-06 20:34:04 +08:00
tangge233 76adffffad fix: 鬼知道为什么没有初始化 2024-08-06 11:58:37 +08:00
tangge233 7721db131b fix: 刷新列表后全部选项不在 Checked 状态 2024-08-06 11:03:57 +08:00
allMagicNB f639435813 + "MCC 15th Year" Cape 2024-08-06 06:36:56 +08:00
tangge233 9fe1471f8e fix: 用枚举替代字符串 2024-08-05 23:43:31 +08:00
tangge233 eca89febf6 feat: 使用 MyRadioButton 2024-08-05 23:34:49 +08:00
tangge233 f9c4e5a752 fix: Ctrl+A 实现不合逻辑 2024-08-05 19:53:45 +08:00
tangge233 8972aec56a feat: Mod 管理卡片标题 2024-08-05 19:20:28 +08:00
tangge233 0007a0ac72 fix: 全选逻辑问题、UI问题 2024-08-05 18:57:52 +08:00
tangge233 d2ef7d7989 feat: 加个分割线 2024-08-05 18:15:16 +08:00
tangge233 3e06ea4502 fix: 错误的全部统计 2024-08-05 14:37:30 +08:00
tangge233and3gf8jv4dv 7cbdca12f3 Apply suggestions from 3gf8jv4dv
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-08-05 13:51:12 +08:00
tangge233 cfe925c667 feat: 改成龙猫想要的样子 2024-08-05 13:32:36 +08:00
tangge233 c0a966f212 fix: 禁用或启用模组没有改变其所在卡片 2024-08-05 00:52:08 +08:00
tangge233 d915cd48f6 feat: 无可更新 Mod 时隐藏对应卡片 2024-08-05 00:41:00 +08:00
tangge233 591421393f fix: 意料之外的内容加入 2024-08-05 00:31:52 +08:00
tangge233 ebfed4243b feat: 适当修改本地 Mod 管理界面与操作逻辑 2024-08-05 00:22:15 +08:00
tangge233 462f985cc3 初步实现分类展示 2024-08-04 23:24:20 +08:00
huangyuandallMagic 53578a8de9 Update Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
Co-authored-by: allMagic <[email protected]>
2024-08-03 21:46:42 +08:00
huangyu 40e421ee34 launchArgument to VersionAdvanceGame 2024-08-03 21:15:18 +08:00
huangyu 7534f9da1f Read JvmArgs and LaunchArgs in ModPack 2024-08-03 21:04:57 +08:00
allMagic 3f332fee8e X_API_KEY -> CURSEFORGE_API_KEY 2024-08-03 20:00:48 +08:00
allMagic 7be16a8906 Merge branch 'Hex-Dragon:main' into main 2024-08-03 19:49:06 +08:00
youzi-2333 86bace4d13 👌 修改 LTCatt 的审核 2024-07-31 08:57:26 +08:00
Pigeon0v0and3gf8jv4dv 22746c3ca9 fix: typo
Co-authored-by: 3gf8jv4dv <[email protected]>
2024-07-31 06:59:07 +08:00
Pigeon0v0 0bbb048c59 feat(auth): 打开的微软验证网页现在会自动填入设备代码 2024-07-30 21:42:42 +08:00
龙腾猫跃 8f49799c6d Merge pull request #3945 from Silverteal/patch-1
所有4月1日发布的版本自动视为愚人节版
2024-07-29 05:45:40 +08:00
youzi-2333 6c8a7a33b7 👌 💥 更新 LTCatt 的审核 2024-07-28 22:30:59 +08:00
龙腾猫跃 020ce330b5 https://github.com/Hex-Dragon/PCL2/discussions/4361#discussioncomment-10169901 2024-07-28 16:13:06 +08:00
龙腾猫跃 c8c981fd8c 放宽分发限制 2024-07-28 04:28:58 +08:00
Pigeon0v0 c1ba65783d feat: 支持加载数据包列表(但是下不了一点) 2024-07-27 18:33:04 +08:00
Pigeon0v0 51e3f47bac chores: 修改标签,消除歧义 2024-07-27 17:01:20 +08:00
Pigeon0v0 94ccc00f95 fix: 光影包列表加载动画文本错误
fix: 无法获取 Modrinth 上 Vanilla Shader 分类的光影(原 URL 写错了)
2024-07-27 16:45:04 +08:00
Pigeon0v0 f45322905f feat: 数据包下载 (WIP) 2024-07-27 12:54:27 +08:00
Pigeon0v0 c556dbb39c feat: 光影包下载 2024-07-27 11:03:59 +08:00
youzi-2333 89f537a00e 👌 更新一部分 LTCatt 的审核 2024-07-26 22:52:28 +08:00
龙腾猫跃 9c0ae93d7d Create FUNDING.yml 2024-07-26 17:02:43 +08:00
龙腾猫跃 016ff2c912 Merge pull request #4349 from Forks-Space/main
Readme 徽标更改爱发电 net->com
2024-07-26 16:35:09 +08:00
Ad_closeNN a4982c5ca7 进一步更改徽标 2024-07-26 16:22:23 +08:00
Ad_closeNN 6208a21b85 徽标更改爱发电 net->com 2024-07-26 16:21:32 +08:00
youzi-2333 690e73eab1 🚸 优化弹出 explorer 2024-07-25 17:29:21 +08:00
youzi-2333 6808620083 🐛 空文件夹造成选中判断错误 2024-07-23 09:05:48 +08:00
youzi-2333 1095a33a44 💥 🚸 显示部分选中的文件夹 2024-07-23 08:49:19 +08:00
youzi-2333 43511b0a49 🐛 空文件夹总是判定为被选中 2024-07-22 08:57:49 +08:00
youzi-2333 3d18a5acc5 🚧 UI 设计(未完成) 2024-07-21 22:18:48 +08:00
allMagicNB 2b57e1ec48 Merge branch 'main' of https://github.com/allMagicNB/PCL2 2024-07-20 18:10:18 +08:00
allMagicNB 7cf91d923e del Release 2024-07-20 17:55:36 +08:00
youzi-2333 de9afd3ece 🚧 UI 设计(未完成) 2024-07-19 22:46:09 +08:00
youzi-2333 e69b189c8b ✏️ MCLM -> MCIM
我是【该词语违禁】
2024-07-18 14:40:01 +08:00
youzi-2333andluolinlin768 898f53428f 🚸 修复一些问题
Co-authored-by: luolinlin768
2024-07-18 13:33:12 +08:00
youzi-2333 3bd39de728 🐛 修复整合包描述 Reload 时被覆盖的问题 2024-07-18 13:09:17 +08:00
youzi-2333 8ed02fe4d9 ✨ 为 Mod 列表、下载添加 MCLM 下载源 2024-07-18 12:38:45 +08:00
Pigeon0v0 4ae3e4aa20 feat: 支持复制设备代码和验证网址 2024-07-18 10:46:50 +08:00
allMagic 1bd7b717d0 - dir 2024-07-17 19:58:01 +08:00
allMagic fa9e1be4e2 更新 build.yml 2024-07-17 19:43:38 +08:00
allMagic 15f82f100c 更新 build.yml 2024-07-17 17:28:10 +08:00
allMagic cc18004c41 更新 build.yml 2024-07-17 17:25:04 +08:00
allMagic 227ceccb8f - .zip 2024-07-17 17:22:31 +08:00
allMagic 83a5370bad 更新 build.yml 2024-07-17 16:45:26 +08:00
allMagicNB 2348d3c8f3 + env 2024-07-17 15:13:15 +08:00
allMagicNB d7e649c44e Fix Replace 2024-07-17 15:00:23 +08:00
allMagicNB b10fc8c720 Fix something 2024-07-17 14:56:33 +08:00
youzi-2333 4547b81d68 🚧 添加整合包描述的设置 2024-07-16 13:18:41 +08:00
youzi-2333 aacaf792ef 🐛 修复图标设置的问题 2024-07-15 22:29:29 +08:00
allMagic ecf1fae8ff Merge branch 'Hex-Dragon:main' into main 2024-07-15 13:16:55 +08:00
youzi-2333 13d0cb725e 🐛 修复问题 2024-07-15 08:21:15 +08:00
龙腾猫跃 5bd8ac3870 2.8.3 2024-07-13 14:56:27 +08:00
youzi-2333 33581b5be9 Merge branch 'luolinlin768-feat-98' into feat-98 2024-07-12 21:46:15 +08:00
youzi-2333 00fdf1f3d3 🔀 Merge from luolinlin768/feat-98 to youzi-2333/feat-98 2024-07-12 21:45:18 +08:00
youzi-2333 ca07edc707 🚧 修改一些龙猫的审查 2024-07-12 21:42:07 +08:00
allMagic d52a4ec081 Update build.yml 2024-07-12 13:41:59 +08:00
allMagic a7a4838b96 [no ci]Update build.yml 2024-07-12 13:22:28 +08:00
淋淋 落 6850cd6764 修改了“包含启动器”和“启动器全局配置”的位置 2024-07-12 13:17:33 +08:00
allMagic c860ad26e2 [no ci]Update build.yml 2024-07-12 13:11:49 +08:00
allMagic 8423ef6371 Merge branch 'Hex-Dragon:main' into main 2024-07-12 11:38:36 +08:00
淋淋 落 a1b98308d4 Revert "修改了“导出整合包”的和边界的距离,21改为20"
This reverts commit 1284f464c1.
2024-07-12 11:11:19 +08:00
淋淋 落 1284f464c1 修改了“导出整合包”的和边界的距离,21改为20 2024-07-12 10:56:23 +08:00
淋淋 落 bc5b37cce5 修改了文案 2024-07-12 10:43:58 +08:00
淋淋 落 82c398dee0 更改了一些错误,修改了标题,添加了提示,修改了间距 2024-07-12 10:30:57 +08:00
淋淋 落 c4974bbf5a 删除了多余的换行 2024-07-12 09:31:03 +08:00
淋淋 落 465a38163b 在基础选项里添加了服务器文件的选择,优化了基础选项里的排版 2024-07-12 09:30:12 +08:00
淋淋 落 b28c707cb5 修改了导出整合包UI 2024-07-12 09:02:15 +08:00
龙腾猫跃 a3c419e76d 2.8.2 正式版 2024-07-12 01:39:26 +08:00
allMagic eaebd04bbb Merge branch 'Hex-Dragon:main' into main 2024-07-11 21:10:19 +08:00
Pigeon0v0 da56c5b44b Merge branch 'main' into resourcepacks 2024-07-11 20:38:14 +08:00
allMagic 2b55ed078b Update .gitignore 2024-07-11 20:13:08 +08:00
allMagicNB 4358058696 更换语气,让 “应该做” 变成 “可以做”。 2024-07-11 19:45:03 +08:00
allMagicNB d49a8f8717 Fix & + .gitignore & + Headers("x-api-key") 2024-07-11 19:40:46 +08:00
allMagic 59a05a8c71 Merge branch 'Hex-Dragon:main' into main 2024-07-11 16:41:50 +08:00
Silverteal a465807d0c Merge pull request #11 from PCL-Community/patch-1
Fix Bugs
2024-07-11 16:01:31 +08:00
allMagic e0bd274e0d 更新 build.yml 2024-07-11 15:58:19 +08:00
allMagic 4747c3dc68 更新 build.yml 2024-07-11 15:27:27 +08:00
allMagic 3c71a2cbf8 更新 build.yml 2024-07-11 15:21:43 +08:00
allMagic 678fc3b40c Update build.yml 2024-07-11 15:13:15 +08:00
youzi-2333 ae4f1b8672 👌 排除 log4j2.xml 2024-07-11 14:11:44 +08:00
youzi-2333 32803b1b67 👌 排除 HMCL 版本配置 2024-07-11 13:35:47 +08:00
youzi-2333 4c69defb42 ✨ 对齐 mr 整合包的输入框
强迫症快乐.jpg
2024-07-11 13:28:19 +08:00
youzi-2333 b7118be391 💬 修改包含存档的 Tooltip 2024-07-11 13:17:37 +08:00
youzi-2333 05b175b5ef ⏪ 回滚 vbproj 文件 2024-07-11 13:06:30 +08:00
youzi-2333 dce9892f61 🔀 Merge from remote 2024-07-11 13:02:28 +08:00
youzi-2333andPigeon0v0 a74e59baf4 💬 更新文案
Co-authored-by: Pigeon0v0 <[email protected]>
2024-07-11 13:00:28 +08:00
柚子柚子andPigeon0v0 bc58fdaf39 Update Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb
Co-authored-by: Pigeon0v0 <[email protected]>
2024-07-11 12:59:22 +08:00
youzi-2333 92f30181d5 ✨ 完成 UI 2024-07-11 12:58:48 +08:00
youzi-2333 49db56856d ✨ 导出整合包:Modrinth 2024-07-11 10:07:59 +08:00
youzi-2333 87e1fb0b1e 🐛 修复导出压缩包的问题 2024-07-10 22:14:55 +08:00
youzi-2333 ad41b4e377 🎨 修复工程设置问题 2024-07-09 11:49:49 +08:00
youzi-2333 09e896dc26 🚧 导出整合包:压缩包 2024-07-09 10:50:49 +08:00
Pigeon0v0 7b8cb73115 同步 #3319 修改 2024-07-04 22:59:18 +08:00
无聊的小洛 10e17d48c5 致命错误
败笔也
2024-07-04 11:37:12 +08:00
无聊的小洛 fa7deb7500 修正错误
为什么要大写啊
2024-07-04 11:36:00 +08:00
无聊的小洛 2f39c57e58 Update FormMain.xaml.vb
之前改的没改回来
2024-07-04 11:35:11 +08:00
wuliaodexiaoluo aa576e669d Fix Bugs 2024-07-04 11:23:15 +08:00
Pigeon0v0 e3c27678b6 fix: 合并了 Curse 和 Modrinth 的部分相似标签(去重) 2024-06-27 08:27:09 +08:00
Pigeon0v0 96b0018adf chores: 开源版本提示新增 2024-06-16 06:43:13 +08:00
Pigeon0v0 8e58cb0dc6 fix: 错误的 ComboBox 大小 2024-06-15 19:18:48 +08:00
Pigeon0v0 937f034a1b feat: 支持下载资源包 2024-06-13 22:23:36 +08:00
Pigeon0v0 536c309967 Merge branch 'Hex-Dragon:main' into auth 2024-06-13 20:22:08 +08:00
Pigeon0v0 dea21c27c5 改了改文案避免误解 2024-06-01 11:58:04 +08:00
Pigeon0v0 8b5187bff4 加了确认弹窗并支持取消,加了轮询频率,加了一些兜底 2024-06-01 11:44:15 +08:00
Pigeon0v0 236557ab9e 改了改提示,让用户知道一下设备代码复制到剪贴板了 2024-06-01 10:32:09 +08:00
Pigeon0v0 99b2adb646 feat: 微软登录设备代码流,并移除了浏览器验证方式 2024-06-01 10:00:48 +08:00
Silverteal 73f8bdf4e1 Delete .github/workflows/build-pr.yml 2024-06-01 06:53:20 +08:00
Silverteal a95e8e8bf7 Create build-pr.yml 2024-06-01 06:52:08 +08:00
Silverteal a4d2e21e1f Merge pull request #1 from Hex-Dragon/main
merge upstream
2024-05-31 18:21:05 +08:00
Silverteal 9402523e01 Merge branch 'Hex-Dragon:main' into main 2024-05-31 14:40:01 +08:00
Silverteal c99575c3f1 修改PageDownloadClient.xaml.vb和PageDownloadInstall.xaml.vb
对4月1日版本直接判定为愚人节版
2024-05-04 09:22:24 +08:00
199 changed files with 21378 additions and 11003 deletions

No files matched your search

+3
View File
@@ -0,0 +1,3 @@
# These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat']
+2 -2
View File
@@ -1,6 +1,6 @@
name: "Minecraft 崩溃"
description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
@@ -12,7 +12,7 @@ body:
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"
+2 -2
View File
@@ -1,6 +1,6 @@
name: "下载或登录时卡住或失败"
description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
@@ -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"
+2 -2
View File
@@ -1,6 +1,6 @@
name: "综合 Bug 反馈"
description: "遇见了没有细分选项的其他 Bug"
labels: [· Bug, 新反馈]
labels: [· Bug, 新提交]
body:
- type: checkboxes
id: "yml-1"
@@ -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"
+3 -3
View File
@@ -1,6 +1,6 @@
name: "优化建议"
description: "对已有功能的小幅度优化或改进建议"
labels: [· 优化, 新反馈]
labels: [· 优化, 新提交]
body:
- type: checkboxes
id: "yml-1"
@@ -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"
+5 -2
View File
@@ -1,11 +1,14 @@
blank_issues_enabled: false
contact_links:
- name: 主页预设反馈
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 相关的事情……
+3 -3
View File
@@ -1,6 +1,6 @@
name: "新功能提案"
description: "对已有功能的大幅度修改,或添加一个新内容或选项"
labels: [· 新功能, 新反馈]
labels: [· 新功能, 新提交]
body:
- type: checkboxes
id: "yml-1"
@@ -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
+27 -10
View File
@@ -1,5 +1,4 @@
name: Build
on:
push:
paths:
@@ -12,16 +11,15 @@ on:
workflow_dispatch:
jobs:
build:
strategy:
matrix:
configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate]
name: Build
runs-on: windows-latest
strategy:
matrix:
configuration: [Debug, Release]
steps:
- name: Checkout
uses: actions/checkout@v4
with:
@@ -30,19 +28,38 @@ jobs:
- name: Set Describe
shell: bash
run: |
Describe=`git describe --tags --always`
echo "Describe=$Describe" >> $GITHUB_ENV
describe=`git describe --tags --always`
echo "describe=$describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2
with:
msbuild-architecture: x64
- name: Update Help
run: |
Set-Location ..
git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
Set-Location PCL2Help
Remove-Item -Path *.* -Recurse -Force
Compress-Archive -Path .\* -DestinationPath .\Help.zip
Copy-Item -Path .\Help.zip -Destination "${{ GITHUB.WORKSPACE }}\Plain Craft Launcher 2\Resources\Help.zip" -Force
Set-Location ..
Remove-Item PCL2Help -Recurse -Force
Set-Location ${{ GITHUB.WORKSPACE }}
- name: Replace
run: |
(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: 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
with:
name: ${{ matrix.configuration }} ${{ env.Describe }}
name: ${{ matrix.configuration }} ${{ env.describe }}
path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe
+35 -17
View File
@@ -1,24 +1,40 @@
本文件仅作为指引您合理使用本存储库内容的指南,不是法律文件或协议。
一、声明
一、承诺与声明。
本文件仅作为指南,不是法律文件或协议。但开发者在此承诺,在您遵守本指南且善意、合理使用的情况下,不会追究您的责任。
法律上,开发者仍保留所有权利(All Rights Reserved),若情况恶劣,仍可能将诉讼作为最终手段。
  开发者承诺,在您遵守本指南的情况下,不会追究您的法律责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
二、轻度使用
三、大量使用情形。
若您仅参考了本存储库中极小部分的内容,或您在制作与 PCL 的实质功能不存在任何重叠的软件,则为轻度使用。
其常见情形例如:
· 使用或参考存储库中极小部分的内容,来开发启动器或其他软件。
· 虽参考了较大量的内容,但制作的软件与 PCL 的实质功能不存在任何重叠。
  如果您基于该存储库进行衍生创作,或合理使用了本存储库中的较大量内容,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。
  (三)给出适当的说明,表示这是第三方内容。在 GitHub 上直接进行 Fork 是允许的。
  (四)使用本指南文件作为协议,不得附加额外条款。
  (五)不得分发编译后的可执行文件。唯一的例外是,你可以在明确禁止再次分发的前提下,在小于 100 人的 QQ 群内分发编译后的可执行文件。
若属于轻度使用,您需要:
1、以适当的形式给出署名。
2、不得将您的内容与 PCL 混淆,或暗示您的内容与 PCL 有关。
 例如:您的内容不得使用 Planting Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
三、重度使用
若不符合轻度使用的情形,即为重度使用。
其常见情形例如:
· 基于本存储库进行修改。
· 参考存储库中较大量的内容,以制作或重新实现 PCL 的部分实质功能(例如启动或下载 Java 版 Minecraft,下载或管理 Mod 等)。
若属于重度使用,您需要:
1、明确表示您的内容是第三方基于 PCL 独立进行二次创作的产物。
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 正版购买弹窗与赞助弹窗。
5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
 例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
————————————
@@ -27,5 +43,7 @@
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。
如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。
如果你只是参考了一小段代码,署个名就行啦,不用担心。
如果对具体细节有疑问,欢迎在 https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
多谢大家啦!
+33 -27
View File
@@ -1,33 +1,39 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<system.net>
<settings>
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<system.net>
<settings>
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup>
<runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<generatePublisherEvidence enabled="false"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
<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>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-6.0.0.0" newVersion="13.0.0.0"/>
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>
+16 -11
View File
@@ -1,6 +1,7 @@
<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:sys="clr-namespace:System;assembly=mscorlib"
StartupUri="FormMain.xaml"
@@ -8,11 +9,12 @@
<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"/>
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
<!-- 颜色表 -->
<SolidColorBrush x:Key="ColorBrush1">#343d4a</SolidColorBrush>
@@ -59,7 +61,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">
@@ -202,7 +204,7 @@
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:MyScrollViewer">
<Style TargetType="local:MyScrollViewer" x:Name="StyleMyScrollViewer">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
<Setter Property="PanningMode" Value="VerticalOnly" />
@@ -218,6 +220,7 @@
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:PageComp" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
<Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
@@ -281,25 +284,26 @@
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="TextBox">
<ControlTemplate TargetType="local:MyTextBox">
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
<Grid.RowDefinitions>
<RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="3">
<Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="{TemplateBinding CornerRadius}">
<ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0"
Margin="5,0,0,0" Cursor="IBeam" />
<!-- 由于未知原因,TextView 会有 2,0 的 Margin -->
</Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.25" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
<TextBlock x:Name="labHint" Foreground="{StaticResource ColorBrushGray4}" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" Margin="0,0,0,-3" />
</Grid>
</ControlTemplate>
</Setter.Value>
</Setter>
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
</Style>
<Style TargetType="PasswordBox">
<Setter Property="FontSize" Value="13" />
@@ -341,6 +345,7 @@
</ControlTemplate>
</Setter.Value>
</Setter>
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
</Style>
<!-- ComboBox -->
+89 -72
View File
@@ -1,5 +1,4 @@
Imports System.Net
Imports System.Reflection
Imports System.Reflection
Imports System.Windows.Threading
Public Class Application
@@ -20,18 +19,29 @@ Public Class Application
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try
'动态 DLL 调用(必须尽量在前面,否则模块加载 CacheCow 等 DLL 就可能导致崩溃)
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
'开始
SecretOnApplicationStart()
'检查参数调用
If e.Args.Length > 0 Then
If e.Args(0) = "--update" Then
'自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel)
Environment.Exit(ProcessReturnValues.TaskDone)
ElseIf e.Args(0) = "--gpu" Then
'调整显卡设置
Try
SetGPUPreference(e.Args(1).Trim(""""))
Environment.Exit(ProcessReturnValues.TaskDone)
Catch ex As Exception
Environment.Exit(ProcessReturnValues.Fail)
End Try
ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try
PageOtherTest.MemoryOptimizeInternal()
PageOtherTest.MemoryOptimizeInternal(False)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败")
Environment.Exit(-1)
@@ -45,10 +55,10 @@ Public Class Application
'制作更新包
ElseIf e.Args(0) = "--edit1" Then
ExeEdit(e.Args(1), True)
Environment.Exit(Result.Cancel)
Environment.Exit(ProcessReturnValues.TaskDone)
ElseIf e.Args(0) = "--edit2" Then
ExeEdit(e.Args(1), False)
Environment.Exit(Result.Cancel)
Environment.Exit(ProcessReturnValues.TaskDone)
#End If
End If
End If
@@ -60,9 +70,9 @@ Public Class Application
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Else
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\"
End If
@@ -72,14 +82,22 @@ Public Class Application
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](Result.Cancel)
Environment.[Exit](ProcessReturnValues.Cancel)
End If
#End If
'设置 ToolTipService 默认值
@@ -89,33 +107,43 @@ Public Class Application
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))
'设置网络配置默认值
ServicePointManager.Expect100Continue = False
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 10000
ServicePointManager.UseNagleAlgorithm = False
ServicePointManager.EnableDnsRoundRobin = True
ServicePointManager.ReusePort = True
'设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then
If Setup.Get("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})")
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} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
'检测压缩包运行
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
End If
'设置初始化
Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert")
'网络配置初始化
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 1024
Setup.Load("ToolDownloadSpeed")
'计时
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick()
@@ -130,8 +158,8 @@ Public Class Application
FilePath = PathWithName
Catch
End Try
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(Result.Exception)
MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Try
End Sub
@@ -141,66 +169,55 @@ Public Class Application
End Sub
'异常
Private IsCritErrored As Boolean = False
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
On Error Resume Next
e.Handled = True
If IsProgramEnded Then Exit Sub
If IsCritErrored Then
'在汇报错误后继续引发错误,知道这次压不住了
FormMain.EndProgramForce(Result.Exception)
Exit Sub
'触发页面的 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
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 IsProgramEnded Then Return
FeedbackInfo()
Dim Detail As String = e.Exception.GetDetail(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 ' “自动错误判断” 的结果分析
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
MsgBox("你的 .NET Framework 版本过低或损坏,请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试!", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel)
Log(e.Exception, "你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!" & vbCrLf & "若无法安装,可在卸载高版本的 .NET Framework 后再试。", LogLevel.Critical, "运行环境错误")
Else
FeedbackInfo()
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
Log(e.Exception, "程序出现未知错误", LogLevel.Critical, "锟斤拷烫烫烫")
End If
End Sub
'动态 DLL 调用
Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly
Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL:NAudio")
AssemblyNAudio = Assembly.Load(GetResources("NAudio"))
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
'缓存
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting"}
Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal)
Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal)
'查找对应的 DLL
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWithF(p))
If Prefix Is Nothing Then Return Nothing
'加载 DLL
If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object()
SyncLock Locks(Prefix)
If Not LoadedAssembly.ContainsKey(Prefix) Then
Log($"[Start] 加载 DLL:{Prefix}")
LoadedAssembly(Prefix) = Assembly.Load(GetResources(Prefix))
'WebP 特判
If Prefix = "Imazen.WebP" Then
SetDllDirectory(PathPure.TrimEnd("\"c))
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
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
Else
Return Nothing
End If
End If
Return LoadedAssembly(Prefix)
End SyncLock
End Function
'切换窗口
@@ -0,0 +1,187 @@
' 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
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Input
Imports System.Windows.Documents
Imports System.Linq
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 CBool(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
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
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
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0
End If
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
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
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
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)
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 System.Text.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
End Try
e.Handled = True
End Sub
End Class
End Namespace
@@ -0,0 +1,15 @@
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
@@ -7,7 +7,7 @@
<Border.RenderTransform>
<ScaleTransform />
</Border.RenderTransform>
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" Text="Button" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock.RenderTransform>
<ScaleTransform />
</TextBlock.RenderTransform>
@@ -1,22 +1,30 @@
Public Class MyButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return LabText.Text
Return GetValue(TextProperty)
End Get
Set(value As String)
LabText.Text = value
SetValue(TextProperty, value)
End Set
End Property '显示文本
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub)))
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If sender IsNot Nothing Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub)))
Public Property TextPadding As Thickness
Get
Return LabText.Padding
@@ -134,7 +142,7 @@
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
@@ -177,7 +185,7 @@
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))
@@ -185,7 +193,7 @@
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
+145 -102
View File
@@ -3,7 +3,7 @@
'控件
Inherits Grid
Private ReadOnly MainGrid As Grid
Private ReadOnly MainChrome As SystemDropShadowChrome
Public ReadOnly Property MainChrome As MyDropShadow
Private ReadOnly MainBorder As Border
Public Property BorderChild As UIElement
Get
@@ -36,6 +36,20 @@
'属性
Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return MainTextBlock.Inlines
End Get
End Property
Public Property CornerRadius As CornerRadius
Get
Return MainChrome.CornerRadius
End Get
Set(value As CornerRadius)
MainChrome.CornerRadius = value
MainBorder.CornerRadius = value
End Set
End Property
Public Property Title As String
Get
Return GetValue(TitleProperty)
@@ -49,20 +63,21 @@
'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 Title <> "" AndAlso MainTextBlock Is Nothing Then
If MainTextBlock Is Nothing Then
MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
@@ -75,7 +90,7 @@
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))
'取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation
@@ -94,28 +109,20 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Exit Sub
If IsNothing(Stack.Tag) Then Return
'排序
Select Case Type
Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version)
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version)
Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate)
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
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
@@ -130,9 +137,6 @@
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
@@ -172,30 +176,30 @@
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
@@ -208,52 +212,72 @@
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))
})
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
End If
AnimList.Add(AaCode(Sub()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid)
Dim AbsDelta = Math.Abs(Delta)
If AbsDelta <= 800 Then
'短距离,直接使用 150ms 的缓动动画
AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
Else
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 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,控件内容已改变,需要中断动画并更新高度。
''' </summary>
Public Sub TriggerForceResize()
Height = If(IsSwaped, SwapedHeight, Double.NaN)
Height = If(IsSwapped, SwapedHeight, Double.NaN)
AniStop("MyCard Height " & Uuid)
IsHeightAnimating = False
End Sub
#End Region
'折叠
#Region "折叠"
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object
@@ -265,26 +289,40 @@
''' <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()
'改变箭头
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
''' <summary>
''' 是否已被折叠。(已过时,请使用 IsSwapped)
''' </summary>
<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
@@ -293,53 +331,58 @@
Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then
If Not IsMouseDown Then Return
IsMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y
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 Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
If ee.Handled Then
IsMouseDown = False
Exit Sub
End If
IsSwaped = Not IsSwaped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
Return
End If
IsSwapped = Not IsSwapped
Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsMouseDown = False
End Sub
#End Region
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Control.IsHitTestVisible Then
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Exit Sub
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(
Sub()
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Return
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
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
@@ -4,7 +4,7 @@
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8">
<TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<TextBlock IsHitTestVisible="False" FontSize="13" x:FieldModifier="Public" x:Name="LabText" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" />
<Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z">
<Path.RenderTransform>
@@ -1,4 +1,7 @@
Public Class MyCheckBox
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyCheckBox
'基础
@@ -14,29 +17,32 @@
End Sub '使外部程序引发本控件的 Change 事件
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
Return GetValue(CheckedProperty)
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False)
End Set
End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyCheckBox), New PropertyMetadata(False,
Sub(d As MyCheckBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
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
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewChange(Me, e)
@@ -44,64 +50,71 @@
MouseDowned = True
Checkbox_MouseLeave()
MouseDowned = False
Exit Sub
Return
End If
End If
_Checked = value
SetValue(CheckedProperty, value)
If IsLoaded Then RaiseEvent Change(Me, user)
'更改动画
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
SyncUI()
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -110,24 +123,24 @@
SetValue(TextProperty, value)
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckbox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckbox).LabText.Text = e.NewValue
End Sub)))
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckBox).LabText.Text = e.NewValue
End Sub)))
'点击事件
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
MouseDowned = False
SetChecked(Not Checked, True, True)
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)
@@ -141,7 +154,7 @@
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
@@ -190,7 +203,7 @@
}, "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)
}, "MyCheckBox TextColor " & Uuid)
@@ -8,7 +8,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))
@@ -116,7 +116,7 @@
'修复 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 IsTextChanging OrElse Not IsEditable Then Return
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
@@ -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
'触发颜色动画
@@ -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
@@ -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,7 +51,7 @@
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(Sub()
If value Then
@@ -113,20 +113,20 @@
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
End If
IsLeftMouseHeld = True
Focus()
End Sub
Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
If Not CanRightClick Then Exit Sub
If Not 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)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
End If
IsRightMouseHeld = True
Focus()
@@ -134,18 +134,18 @@
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
If Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
End If
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not CanRightClick Then Exit Sub
If Not CanRightClick Then Return
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid)
End If
IsRightMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
@@ -154,8 +154,8 @@
IsLeftMouseHeld = False
IsRightMouseHeld = False
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
@@ -163,11 +163,14 @@
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If IsMouseOver Then
If Not IsEnabled Then
'禁用
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid)
Else
@@ -178,7 +181,9 @@
Else
AniStop("MyExtraButton Color " & Uuid)
If IsMouseOver Then
If Not IsEnabled Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4")
ElseIf IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
@@ -0,0 +1,33 @@
<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">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
<Border x:Name="PanClick" BorderThickness="0.001" Background="{StaticResource ColorBrushSemiTransparent}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}"/>
<Grid x:Name="PanScale" IsHitTestVisible="False" RenderTransformOrigin="0.5,0.5" Margin="0,10,0,0">
<Grid.RenderTransform>
<ScaleTransform />
</Grid.RenderTransform>
<Border x:Name="PanColor" BorderThickness="0.001" Background="{DynamicResource ColorBrush3}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}">
<Border.Effect>
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<StackPanel Orientation="Horizontal" Margin="20,0" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Path x:Name="Path" Stretch="Uniform" Margin="2,12,0,12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<ScaleTransform />
</Path.RenderTransform>
</Path>
<TextBlock x:Name="LabText" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush8}" FontSize="16"
Margin="12,0,0,0.8" />
</StackPanel>
</Grid>
</Grid>
@@ -0,0 +1,163 @@
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyExtraTextButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Return
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Path IsNot Nothing Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
'显示文本
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyExtraTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If sender IsNot Nothing Then CType(sender, MyExtraTextButton).LabText.Text = e.NewValue
End Sub)))
'动画
Private _Show As Boolean = False
Public Property Show As Boolean
Get
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Return
_Show = value
RunInUi(
Sub()
If value Then
'有了
Opacity = 0
AniStart({
AaOpacity(Me, 1 - Opacity, 80, 50),
AaScaleTransform(Me, 0.15 - CType(RenderTransform, ScaleTransform).ScaleX, 400, 50, New AniEaseOutBack),
AaScaleTransform(Me, 0.85, 160, 50, New AniEaseOutFluent(AniEasePower.Middle))
}, "MyExtraTextButton MainScale " & Uuid)
Else
'没了
AniStart({
AaOpacity(Me, -Opacity, 50, 50),
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak))
}, "MyExtraTextButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
End Set
End Property
'触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then
Log("[Control] 按下附加图标按钮:" & Text)
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
End If
End Sub
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsLeftMouseHeld As Boolean = False
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
End If
IsLeftMouseHeld = True
Focus()
End Sub
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
End If
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles PanClick.MouseLeave
IsLeftMouseHeld = False
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If Not IsEnabled Then
'禁用
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraTextButton Color " & Uuid)
Else
'普通
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush3", AnimationColorOut), "MyExtraTextButton Color " & Uuid)
End If
Else
AniStop("MyExtraTextButton Color " & Uuid)
If Not IsEnabled Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4")
ElseIf IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
End If
Catch ex As Exception
Log(ex, "刷新附加图标按钮颜色出错")
End Try
End Sub
End Class
+4 -12
View File
@@ -3,22 +3,14 @@
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" Text="提示文本" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
<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="不再提示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid>
</Border>
+91 -43
View File
@@ -1,44 +1,94 @@
Public Class MyHint
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 Property Text As String
'配色
Public Enum Themes
Blue = 0
Red = 1
Yellow = 2
End Enum
Public Property Theme As Themes
Get
Return LabText.Text
Return _ColorType
End Get
Set(value As String)
LabText.Text = value
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
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property
Public Shared ReadOnly TextProperty As DependencyProperty =
DependencyProperty.Register("Text", GetType(String), GetType(MyHint), New PropertyMetadata("",
Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
d.LabText.Text = e.NewValue
End Sub))
'关闭按钮
Public Property CanClose As Boolean
Get
Return BtnClose.Visibility = Visibility.Visible
@@ -47,12 +97,9 @@
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public RelativeSetup As String = ""
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 Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True)
@@ -96,20 +143,21 @@
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
If Not Control.IsHitTestVisible Then Return
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(
Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
End Sub
End Module
@@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0)
If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
@@ -177,7 +186,7 @@
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,7 @@
Public Class MyIconTextButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyIconTextButton
'基础
@@ -30,6 +33,11 @@
End Set
End Property
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -39,32 +47,32 @@
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue
End Sub)))
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue
End Sub)))
Public Enum ColorState
Black
Highlight
End Enum
Private _ColorType As ColorState = ColorState.Black
Public Property ColorType As ColorState
Get
Return _ColorType
Return GetValue(ColorTypeProperty)
End Get
Set(value As ColorState)
_ColorType = value
If ColorType = value Then Return
SetValue(ColorTypeProperty, value)
RefreshColor()
End Set
End Property '颜色类别
Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata())
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata(ColorState.Black))
'点击事件
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
If Not IsMouseDown Then Return
Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
+150
View File
@@ -0,0 +1,150 @@
Public Class MyImage
Inherits Image
#Region "公开属性"
''' <summary>
''' 网络图片的缓存有效期。
''' 在这个时间后,才会重新尝试下载图片。
''' </summary>
Public FileCacheExpiredTime As New TimeSpan(7, 0, 0, 0) '7 天
''' <summary>
''' 是否允许将网络图片存储到本地用作缓存。
''' </summary>
Public Property EnableCache As Boolean
Get
Return GetValue(EnableCacheProperty)
End Get
Set(value As Boolean)
SetValue(EnableCacheProperty, value)
End Set
End Property
Public Shared Shadows ReadOnly EnableCacheProperty As DependencyProperty = DependencyProperty.Register(
"EnableCache", GetType(Boolean), GetType(MyImage), New PropertyMetadata(True))
''' <summary>
''' 与 Image 的 Source 类似。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存。
''' 支持 WebP 格式的图片。
''' </summary>
Public Shadows Property Source As String '覆写 Image 的 Source 属性
Get
Return _Source
End Get
Set(value As String)
If value = "" Then value = Nothing
If _Source = value Then Return
_Source = value
If Not IsInitialized Then Return '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
Load()
End Set
End Property
Private _Source As String = ""
Public Shared Shadows ReadOnly SourceProperty As DependencyProperty = DependencyProperty.Register(
"Source", GetType(String), GetType(MyImage), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary>
''' 若 Source 是一个网络图片,该地址将作为第二下载源。
''' </summary>
Public Property FallbackSource As String
Get
Return _FallbackSource
End Get
Set(value As String)
_FallbackSource = value
End Set
End Property
Private _FallbackSource As String = Nothing
''' <summary>
''' 正在下载网络图片时显示的本地图片。
''' </summary>
Public Property LoadingSource As String
Get
Return _LoadingSource
End Get
Set(value As String)
_LoadingSource = value
End Set
End Property
Private _LoadingSource As String = "pack://application:,,,/images/Icons/NoIcon.png"
#End Region
''' <summary>
''' 实际被呈现的图片地址。
''' </summary>
Public Property ActualSource As String
Get
Return _ActualSource
End Get
Set(value As String)
If value = "" Then value = Nothing
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)
Catch ex As Exception
Log(ex, $"加载图片失败({value})")
Try
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
Catch
End Try
End Try
End Set
End Property
Private _ActualSource As String = Nothing
Private Sub Load() _
Handles Me.Initialized '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
'空
If Source Is Nothing Then
ActualSource = Nothing
Return
End If
'本地图片
If Not Source.StartsWithF("http") Then
ActualSource = Source
Return
End If
'从缓存加载网络图片
Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = GetTempPath(Source) & If(EnableCache, "", GetUuid()) '不启用缓存时加上随机字符串,避免冲突
Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
End If
RunInNewThread(
Sub()
Try
'下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
If(String.IsNullOrEmpty(FallbackSource), {Source}, {Source, FallbackSource}),
TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then
'保存缓存并显示
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempPath)
File.Delete(TempPath)
End If
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
Catch
End Try
Log(ex, $"下载图片失败", LogLevel.Hint)
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,7 @@
Public Class MyListItem
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyListItem
Implements IMyRadio
Public Event Click(sender As Object, e As MouseButtonEventArgs)
@@ -161,12 +164,17 @@
End Property
'标题
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabTitle.Inlines
End Get
End Property
Public Property Title As String
Get
Return GetValue(TitleProperty)
End Get
Set(value As String)
SetValue(TitleProperty, value)
SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, ""))
End Set
End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
@@ -189,7 +197,7 @@
Return _Info
End Get
Set(value As String)
If _Info = value Then Exit Property
If _Info = value Then Return
value = value.Replace(vbCr, "").Replace(vbLf, "")
_Info = value
LabInfo.Text = value
@@ -204,7 +212,7 @@
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)
@@ -212,33 +220,26 @@
If Not _Logo = "" Then
If _Logo.StartsWithF("http", True) Then
'网络图片
PathLogo = New Image With {
PathLogo = New MyImage With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo),
.Source = _Logo,
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
.Tag = Me,
.IsHitTestVisible = LogoClickable,
.Background = Bitmap,
.Background = New MyBitmap(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then
' '使用最适合 16x16 物品图片显示的大小
' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor)
' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center
' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width
'Else
PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality)
'End If
.SnapsToDevicePixels = True, .UseLayoutRounding = False,
.HorizontalAlignment = HorizontalAlignment.Stretch, .VerticalAlignment = VerticalAlignment.Stretch
}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
Else
'矢量图
PathLogo = New Shapes.Path With {
@@ -296,7 +297,7 @@
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))
@@ -327,8 +328,8 @@
Private Sub OnSizeChanged() Handles Me.SizeChanged
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWithF(".png", True) Then
If PathLogo IsNot Nothing Then
If _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -344,7 +345,7 @@
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False, value <> _Checked) '仅在值发生变化时触发动画 (#4596)
End Set
End Property
''' <summary>
@@ -366,31 +367,31 @@
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
'收集控件列表与选中个数
@@ -501,15 +502,15 @@
'触发点击事件
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)
e.Handled = True
End If
If e.Handled Then Exit Sub
If e.Handled Then Return
'实际的单击处理
Select Case Type
Case CheckType.Clickable
@@ -580,7 +581,7 @@
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 '防止默认属性变更触发动画
@@ -661,6 +662,8 @@
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
EventType = Nothing
EventData = Nothing
End Try
End If
End Sub
@@ -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
@@ -79,11 +79,7 @@ Public Class MyLoading
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
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
End If
Else
LabText.Text = TextError
@@ -142,7 +138,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 +155,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,7 +179,7 @@ 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({
@@ -271,7 +267,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)
@@ -37,7 +37,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = BackName Then Exit Sub
If ColorName = BackName Then Return
ColorName = BackName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -25,7 +25,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanText" Margin="0,0,0,7" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7">
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabText" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
@@ -72,20 +72,21 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse Not TextArea.ValidateResult = "" Then Exit Sub
TextArea.Validate() '#5773
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()
End Sub
Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextArea.ValidateChanged
Btn1.IsEnabled = TextArea.ValidateResult = ""
Btn1.IsEnabled = TextArea.IsValidated
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
@@ -24,7 +24,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7">
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<StackPanel x:Name="PanSelection" Orientation="Vertical" />
</my:MyScrollViewer>
<StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
@@ -77,13 +77,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()
@@ -24,7 +24,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7">
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
@@ -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
+16 -15
View File
@@ -3,15 +3,15 @@
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
@@ -39,16 +39,17 @@
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
AniList.Add(AaCode(
Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Delay += Math.Max(15 - Id, 7) * 2
Id += 1
End If
Next
@@ -63,8 +64,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 +73,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 +84,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
+48 -33
View File
@@ -3,16 +3,16 @@
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,7 +33,7 @@
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))
End Set
@@ -106,7 +106,7 @@
End Sub
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If Not PageLoaderAutoRun Then Return
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
@@ -187,7 +187,7 @@
''' 需要立即切换至 Empty。
''' </summary>
Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Exit Sub
If PageState = PageStates.Empty Then Return
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid)
@@ -302,7 +302,7 @@
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 OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
'(重新)开始运行
'需要从部分状态切换到 ReloadExit
@@ -314,7 +314,7 @@
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 Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
'运行结束
'需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
@@ -353,12 +353,16 @@
If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing
Next
For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
Delay += 40
If TypeOf Control Is MyExtraTextButton Then
CType(Control, MyExtraTextButton).Show = True
Else
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
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 += 25
End If
Next
Next
'滚动条动画
@@ -379,10 +383,14 @@
Dim Delay As Integer = 0
For Each Element In RealElements
For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
Delay += 20
If TypeOf Control Is MyExtraTextButton Then
CType(Control, MyExtraTextButton).Show = False
Else
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 70, Delay))
AniList.Add(AaTranslateY(Control, -6, 70, Delay))
Delay += 15
End If
Next
Next
'滚动条动画
@@ -392,31 +400,38 @@
AniList.Add(AaTranslateX(Scroll, 10 - CType(Scroll.RenderTransform, TranslateTransform).X, 90, 0, New AniEaseInFluent))
End If
'结束
AniList.Add(AaCode(Sub()
For Each Element In RealElements
Element.Visibility = Visibility.Collapsed
Next
PageOnExitAnimationFinished()
End Sub,, True))
AniList.Add(AaCode(
Sub()
For Each Element In RealElements
Element.Visibility = Visibility.Collapsed
Next
PageOnExitAnimationFinished()
End Sub,, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
End Sub
'遍历获取所有需要生成动画的控件
Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
''' <summary>
''' 禁用页面切换动画的控件列表。
''' </summary>
Public DisabledPageAnimControls As New List(Of FrameworkElement)
''' <summary>
''' 遍历获取所有需要生成动画的控件。
''' </summary>
Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As IEnumerable(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(Element, AllControls, IgnoreInvisibility)
Return AllControls
_GetAllAnimControls(Element, AllControls, IgnoreInvisibility)
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 TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
Private Sub _GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
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
Dim Content = CType(Element, ContentControl).Content
If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then GetAllAnimControls(Content, AllControls, IgnoreInvisibility)
If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then _GetAllAnimControls(Content, AllControls, IgnoreInvisibility)
ElseIf TypeOf Element Is Panel Then
For Each Element2 In CType(Element, Panel).Children
If TypeOf Element2 Is FrameworkElement Then GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
If TypeOf Element2 Is FrameworkElement Then _GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
Next
End If
End Sub
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid>
@@ -1,4 +1,7 @@
Public Class MyRadioBox
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioBox
Implements IMyRadio
'基础
@@ -10,59 +13,57 @@
Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed
'自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean
Get
Return _Checked
Return GetValue(CheckedProperty)
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False)
End Set
End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyRadioBox), New PropertyMetadata(False,
Sub(d As MyRadioBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
''' <summary>
''' 手动设置 Checked 属性。
''' </summary>
''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Public Sub SetChecked(value As Boolean, user As Boolean)
Try
'Preview 事件
If value AndAlso user Then
Dim e = New RouteEventArgs(user)
RaiseEvent PreviewCheck(Me, e)
If e.Handled Then
Radiobox_MouseLeave()
Exit Sub
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
_Checked = value
If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not 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
For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
If TypeOf Control Is MyRadioBox Then
RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1
End If
Next
'判断选中情况
Select Case CheckedCount
Select Case CheckedCount '判断选中情况
Case 0
'没有任何单选框被选中,选择第一个
RadioboxList(0).Checked = True
@@ -87,67 +88,74 @@
Next
End If
End Select
'End If
'更改动画
If Not IsChanged Then Exit Sub
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
If IsChanged Then
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
End If
'更改动画
SyncUI()
Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try
End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -157,19 +165,17 @@
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue
End Sub)))
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioBox).LabText.Text = e.NewValue)))
'点击事件
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
MouseDowned = False
If Not MouseDowned Then Return
Log("[Control] 按下单选框:" & Text)
SetChecked(True, True, True)
SetChecked(True, True)
MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
@@ -181,7 +187,7 @@
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
@@ -218,7 +224,7 @@
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)
@@ -4,6 +4,6 @@
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel>
</Border>
@@ -1,4 +1,7 @@
Public Class MyRadioButton
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioButton
'基础
@@ -59,7 +62,7 @@
'保证只有一个单选框选中
If IsNothing(Parent) Then Exit Sub
If IsNothing(Parent) Then Return
Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -98,7 +101,7 @@
'更改动画
If Not IsChanged Then Exit Sub
If Not IsChanged Then Return
RefreshColor(Nothing, anime)
'触发事件
@@ -108,6 +111,12 @@
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
End Try
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
@@ -117,9 +126,7 @@
End Set
End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue
End Sub)))
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioButton).LabText.Text = e.NewValue)))
Public Enum ColorState
White
Highlight
@@ -140,17 +147,17 @@
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
If Checked Then Return
If Not IsMouseDown Then Return
Log("[Control] 按下单选按钮:" & 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
+2 -2
View File
@@ -301,7 +301,7 @@ Public Class MyResizer
End Sub
Private Sub updateMouseDown()
Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released
Dim flag = (GetAsyncKeyState(&H1) And &H8000) = 0 '调用原生API判断鼠标是否抬起,如果使用WPF的API的话鼠标不在窗口上时不会更新状态 (#5655)
If flag Then
resizeRight = False
resizeLeft = False
@@ -311,5 +311,5 @@ Public Class MyResizer
End Sub
Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
Private Declare Function GetAsyncKeyState Lib "user32.dll" (vKey As Integer) As Short
End Class
@@ -1,21 +1,20 @@
Public Class MyScrollViewer
Inherits ScrollViewer
Public Property DeltaMuity As Double = 1
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 CheckBox) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
Return
End If
e.Handled = True
PerformVerticalOffsetDelta(-e.Delta)
@@ -25,10 +24,12 @@
Next
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
AniStart(
AaDouble(
Sub(AnimDelta As Double)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
End Sub
Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged
RealOffset = VerticalOffset
@@ -43,4 +44,7 @@
ScrollBar = GetTemplateChild("PART_VerticalScrollBar")
End Sub
Private Sub MyScrollViewer_PreviewGotKeyboardFocus(sender As Object, e As KeyboardFocusChangedEventArgs) Handles Me.PreviewGotKeyboardFocus
If e.NewFocus IsNot Nothing AndAlso TypeOf e.NewFocus Is MySlider Then e.Handled = True '#3854,阻止获得焦点时自动滚动
End Sub
End Class
@@ -8,7 +8,7 @@
d:DesignHeight="450" d:DesignWidth="800"
Height="40">
<Grid>
<local:MyTextBox HasAnimation="False" x:Name="TextBox" BorderThickness="0" Padding="32,0,40,0" MaxLength="50" FontSize="13.5" UseLayoutRounding="False" SnapsToDevicePixels="False" VerticalContentAlignment="Center" />
<local:MyTextBox HasBackground="False" x:Name="TextBox" BorderThickness="0" Padding="32,0,40,0" MaxLength="50" FontSize="13.5" UseLayoutRounding="False" SnapsToDevicePixels="False" VerticalContentAlignment="Center" />
<Path Width="14" Margin="14,0,0,0" IsHitTestVisible="False" Height="14" Fill="{DynamicResource ColorBrush1}" Stretch="Uniform" Data="M675.9168 242.816C556.3008 123.2 362.4448 123.2 242.8288 242.816 123.2128 362.432 123.2128 556.288 242.8288 675.904 362.4448 795.52 556.3008 795.52 675.9168 675.904 795.5328 556.288 795.5328 362.432 675.9168 242.816L675.9168 242.816ZM1000.7168 892.48C1030.6048 922.368 1030.6048 970.816 1000.7168 1000.704 970.8288 1030.656 922.3808 1030.656 892.4288 1000.704L730.0608 838.336C728.1408 836.416 727.4368 833.92 725.7728 831.872 546.3168 960.448 295.7568 945.408 134.5408 784.192-44.8512 604.8-44.8512 313.92 134.5408 134.528 313.9328-44.864 604.8128-44.864 784.2048 134.528 945.4208 295.744 960.4608 546.304 831.8848 725.76 833.9328 727.424 836.4288 728.128 838.3488 730.048L1000.7168 892.48Z" HorizontalAlignment="Left" />
<local:MyIconButton x:Name="BtnClear" IsHitTestVisible="False" Opacity="0" Width="24" Margin="0,0,10,0" LogoScale="0.75" Height="24" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" HorizontalAlignment="Right" Theme="Black" />
</Grid>
@@ -14,7 +14,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
@@ -29,7 +29,7 @@
Try
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
If _Value = newValue Then Return
'触发 Preview 事件,修改新值
Dim OldValue = _Value
@@ -40,12 +40,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)
@@ -103,7 +103,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)
@@ -165,7 +165,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 +178,7 @@
ChangeByKey = False
e.Handled = True
Else
Exit Sub
Return
End If
'更新 Popup
If GetHintText IsNot Nothing Then
+77 -49
View File
@@ -3,8 +3,18 @@
'自定义属性
Public Property HasAnimation As Boolean = True
Public Property HasBackground As Boolean = True
Public Property ShowValidateResult As Boolean = True
Public Property CornerRadius As CornerRadius
Get
Return GetValue(CornerRadiusProperty)
End Get
Set(value As CornerRadius)
SetValue(CornerRadiusProperty, value)
End Set
End Property
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty =
DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyTextBox), New PropertyMetadata(New CornerRadius(3)))
'额外控件初始化
@@ -26,7 +36,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
@@ -62,7 +72,24 @@
SetValue(ValidateResultProperty, value)
End Set
End Property
Public Shared ReadOnly ValidateResultProperty As DependencyProperty = DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata(""))
Public Shared ReadOnly ValidateResultProperty As DependencyProperty =
DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("",
Sub(d As MyTextBox, e As DependencyPropertyChangedEventArgs)
d.SetValue(IsValidatedPropertyKey, String.IsNullOrEmpty(e.NewValue))
End Sub))
''' <summary>
''' 是否通过了输入验证。
''' </summary>
Public ReadOnly Property IsValidated As Boolean
Get
Return GetValue(IsValidatedProperty)
End Get
End Property
Private Shared ReadOnly IsValidatedPropertyKey As DependencyPropertyKey =
DependencyProperty.RegisterReadOnly("IsValidated", GetType(Boolean), GetType(MyTextBox), New PropertyMetadata(True))
Public Shared ReadOnly IsValidatedProperty As DependencyProperty = IsValidatedPropertyKey.DependencyProperty
''' <summary>
''' 输入验证的规则。
''' </summary>
@@ -81,50 +108,49 @@
''' </summary>
Public Sub Validate() Handles Me.Loaded
'执行输入验证
ValidateResult = ""
For Each ValidateRule As Validate In ValidateRules
ValidateResult = ValidateRule.Validate(Text)
If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For
Next
Dim IsSuccessful As Boolean = ValidateResult = ""
ValidateResult = ModValidate.Validate(Text, ValidateRules)
'根据结果改变样式
If ShownValidateResult <> If(IsSuccessful, ValidateState.Success, ValidateState.FailedAndShowDetail) Then
If ShownValidateResult <> If(IsValidated, ValidateState.Success, ValidateState.FailedAndShowDetail) Then
If IsLoaded AndAlso labWrong IsNot Nothing Then
ChangeValidateResult(IsSuccessful, True)
ChangeValidateResult(IsValidated, True)
Else
RunInNewThread(Sub()
Thread.Sleep(30)
RunInUi(Sub() ChangeValidateResult(IsSuccessful, False))
End Sub, "DelayedValidate Change")
RunInNewThread(
Sub()
Thread.Sleep(30)
RunInUi(Sub() ChangeValidateResult(IsValidated, False))
End Sub, "DelayedValidate Change")
End If
End If
'更新错误信息
If ShowValidateResult AndAlso Not ValidateResult = "" Then
If ShowValidateResult AndAlso Not IsValidated Then
If IsLoaded AndAlso labWrong IsNot Nothing Then
labWrong.Text = ValidateResult
Else
RunInNewThread(Sub()
Dim IsFinished As Boolean = False
Do Until IsFinished
Thread.Sleep(20)
RunInUiWait(Sub()
If labWrong IsNot Nothing Then
labWrong.Text = ValidateResult
IsFinished = True
End If
If Not IsLoaded Then IsFinished = True
End Sub)
Loop
End Sub, "DelayedValidate Text")
RunInNewThread(
Sub()
Dim IsFinished As Boolean = False
Do Until IsFinished
Thread.Sleep(20)
RunInUiWait(
Sub()
If labWrong IsNot Nothing Then
labWrong.Text = ValidateResult
IsFinished = True
End If
If Not IsLoaded Then IsFinished = True
End Sub)
Loop
End Sub, "DelayedValidate Text")
End If
End If
End Sub
''' <summary>
''' 强制显示结果为正常,类似尚未输入过文本的状态。不影响实际的检查结果。
''' </summary>
Public Sub ForceShowAsSuccess()
IsTextChanged = False
ChangeValidateResult(ValidateResult = "", True)
ChangeValidateResult(IsValidated, True)
End Sub
Private ShownValidateResult As ValidateState = ValidateState.NotInited
Private Sub ChangeValidateResult(IsSuccessful As Boolean, IsLoaded As Boolean)
@@ -133,18 +159,18 @@
'变为正确
ShownValidateResult = If(IsSuccessful, ValidateState.Success, ValidateState.FailedButTextNotChanged)
AniStart({
AaOpacity(labWrong, -labWrong.Opacity, 150),
AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent),
AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True)
}, "MyTextBox Validate " & Uuid)
AaOpacity(labWrong, -labWrong.Opacity, 150),
AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent),
AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True)
}, "MyTextBox Validate " & Uuid)
ElseIf ShowValidateResult Then
'变为错误
ShownValidateResult = ValidateState.FailedAndShowDetail
labWrong.Visibility = Visibility.Visible
AniStart({
AaOpacity(labWrong, 1 - labWrong.Opacity, 170),
AaHeight(labWrong, 21 - labWrong.Height, 300,, New AniEaseOutBack(AniEasePower.Weak))
}, "MyTextBox Validate " & Uuid)
AaOpacity(labWrong, 1 - labWrong.Opacity, 150),
AaHeight(labWrong, 21 - labWrong.Height, 150,, New AniEaseOutFluent)
}, "MyTextBox Validate " & Uuid)
Else
'变为错误,但不显示文本
ShownValidateResult = ValidateState.FailedAndHideDetail
@@ -170,16 +196,19 @@
''' 是否已经由用户输入过文本,若尚未输入过,则不显示输入检查的失败。
''' </summary>
Private IsTextChanged As Boolean = False
Private _HintText As String = ""
Public Property HintText As String
Get
Return _HintText
Return GetValue(HintTextProperty)
End Get
Set(value As String)
_HintText = value
If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "")
SetValue(HintTextProperty, value)
End Set
End Property
Public Shared ReadOnly HintTextProperty As DependencyProperty =
DependencyProperty.Register("HintText", GetType(String), GetType(MyTextBox), New PropertyMetadata("",
Sub(t As MyTextBox, e As DependencyPropertyChangedEventArgs)
If t.labHint IsNot Nothing Then t.labHint.Text = If(t.Text = "", t.HintText, "")
End Sub))
Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged
Try
'改变提示文本
@@ -188,11 +217,11 @@
IsTextChanged = IsLoaded
'进行输入验证
Validate()
If Not ValidateResult = "" Then Exit Sub
If Not IsValidated Then Return
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", LogLevel.Assert)
Log(ex, "进行输入验证时出错", LogLevel.Critical)
End Try
End Sub
@@ -200,15 +229,13 @@
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
Try
'手动关闭动画
If Not HasAnimation Then Exit Sub
'不对 ComboBox 从属进行动画
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Return
'判断当前颜色
Dim ForeColorName As String, BackColorName As String
Dim AnimationTime As Integer
If IsEnabled Then
If ValidateResult = "" OrElse Not IsTextChanged Then
If IsValidated OrElse Not IsTextChanged Then
If IsFocused Then
ForeColorName = "ColorBrush3"
BackColorName = "ColorBrush7"
@@ -232,11 +259,12 @@
BackColorName = "ColorBrushGray6"
AnimationTime = 200
End If
If Not HasBackground Then BackColorName = "ColorBrushTransparent"
'触发颜色动画
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
@@ -252,7 +280,7 @@
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)
@@ -57,7 +57,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 +72,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = ForeName Then Exit Sub
If ColorName = ForeName Then Return
ColorName = ForeName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -90,21 +90,21 @@
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 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))
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register(
"EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
End Class
+12 -14
View File
@@ -99,12 +99,10 @@
<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>
<Image x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyIconButton x:Name="BtnTitleClose" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,12,0" Theme="White"
LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
<local:MyIconButton x:Name="BtnTitleMin" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,44,0" Theme="White"
@@ -115,25 +113,25 @@
<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" />
<Image x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<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>
<Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
<local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28"
LogoScale="0.87" Logo="M1097.162313 584.707482 250.272424 584.707482 562.833701 896.95123C591.749274 925.859979 591.749274 972.659975 562.833701 1001.568724 533.91812 1030.477473 487.058315 1030.477473 458.142742 1001.568724L21.580946 565.451235C6.757449 550.631234-0.361728 531.131238 0.028357 511.679985L0.028357 511.631236 0.028357 511.582486C-0.361728 492.13124 6.757449 472.582488 21.580946 457.762487L458.142742 21.644997C487.058315-7.215002 533.91812-7.215002 562.833701 21.644997 591.749274 50.553746 591.749274 97.4025 562.833701 126.262499L250.272424 438.55499 1097.162313 438.55499C1137.585605 438.55499 1170.304578 471.266238 1170.304578 511.631236 1170.304578 551.947483 1137.585605 584.707482 1097.162313 584.707482L1097.162313 584.707482Z" />
LogoScale="0.87" Logo="M1097 584 250 584 562 896C591 925 591 972 562 1001 533 1030 487 1030 458 1001L21 565C6 550-0 531 0 511L0 511 0 511C-0 492 6 472 21 457L458 21C487-7 533-7 562 21 591 50 591 97 562 126L250 438 1097 438C1137 438 1170 471 1170 511 1170 551 1137 584 1097 584L1097 584Z" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
</Grid>
</Grid>
@@ -145,7 +143,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>
@@ -166,7 +164,7 @@
</Border>
</Border>
</Grid>
<StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" />
<StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,20" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />
File diff suppressed because it is too large. Load diff
Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

@@ -624,6 +624,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 = MathClamp(percent, 0, 1)
If alpha = 0 Then Return p '退化到线性
Return (alpha + 1) * p / (1 + alpha * p)
End Function
End Class
'Back / 回弹
''' <summary>
@@ -807,7 +827,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Assert)
Log(ex, "动画帧执行失败", LogLevel.Critical)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
File diff suppressed because it is too large. Load diff
+91 -101
View File
@@ -85,23 +85,24 @@
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))
_State = value
Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(Sub()
Select Case value
Case LoadState.Loading
LoadingState = MyLoading.MyLoadingState.Run
Case LoadState.Failed
LoadingState = MyLoading.MyLoadingState.Error
Case Else
LoadingState = MyLoading.MyLoadingState.Stop
End Select
RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
RunInUi(
Sub()
Select Case value
Case LoadState.Loading
LoadingState = MyLoading.MyLoadingState.Run
Case LoadState.Failed
LoadingState = MyLoading.MyLoadingState.Error
Case Else
LoadingState = MyLoading.MyLoadingState.Stop
End Select
RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
End Set
End Property
@@ -111,7 +112,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)
@@ -153,7 +154,7 @@
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)
@@ -183,7 +184,7 @@
Thread.Sleep(10)
Loop
If State = LoadState.Finished Then
Exit Sub
Return
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
@@ -206,7 +207,7 @@
If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage)
Loop
If State = LoadState.Finished Then
Exit Sub
Return
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
@@ -287,15 +288,14 @@
End SyncLock
End Try
'检验输入以确定情况
If (Not IsForceRestart) AndAlso '不要求强行重启
((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同
(State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
'如果输入相同且未出错则不重试
Return False
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 '…则不重试
Else
'需要开始
Return True
Return True '否则需要重启
End If
End Function
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
@@ -309,46 +309,50 @@
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 & ") 已启动")
LoadDelegate(Me)
If IsAborted Then
Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束,输出被弃用(最新线程:" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & ")", LogLevel.Developer)
Else
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效
End If
Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Exit Sub
Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
End Try
End Sub) With {.Name = Name, .Priority = ThreadPriority}
Sub()
Try
IsForceRestarting = IsForceRestart
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsAborted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Return
End If
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效
Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted
Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Return
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
End Sub
Public Overrides Sub Abort()
If State <> LoadState.Loading Then Exit Sub
If State <> LoadState.Loading Then Return
SyncLock LockState
State = LoadState.Aborted
End SyncLock
TriggerThreadAbort()
End Sub
Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Exit Sub
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断")
If LastRunningThread Is Nothing Then Return
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
LastRunningThread = Nothing
End Sub
@@ -417,7 +421,7 @@
'改变状态
SyncLock LockState
If State = LoadState.Loading Then
Exit Sub
Return
Else
State = LoadState.Loading
End If
@@ -437,15 +441,16 @@
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Aborted
Else
Exit Sub
Return
End If
End SyncLock
RunInThread(Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
RunInThread(
Sub()
'中断加载器
For Each Loader In Loaders
Loader.Abort()
Next
End Sub)
End Sub
''' <summary>
@@ -467,7 +472,7 @@
Case Else
'完蛋,出错了
SyncLock LockState
If State >= LoadState.Finished Then Exit Sub
If State >= LoadState.Finished Then Return
[Error] = New Exception(Loader.Name & "失败", Loader.Error)
State = Loader.State
End SyncLock
@@ -475,16 +480,16 @@
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
Exit Sub
Return
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.Aborted Then Return
Dim IsFinished As Boolean = True
Dim Ignore As Boolean = False
Dim Blocked As Boolean = False
Dim Input As Object = Me.Input
For Each Loader In Loaders
Select Case Loader.State
@@ -492,28 +497,30 @@
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
End If
'更新下一个加载器的输入
Input = CType(Loader, Object).Output
End If
'如果不让继续启动,且已有加载器正在加载中,就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
End If
End If
'已经有正在加载中的了,不需要再启动了
IsFinished = False
Ignore = True
Blocked = True
Case Else
Restart:
'未启动,则启动加载器
IsFinished = False
If Ignore Then Continue For
If Blocked Then Continue For
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
@@ -527,8 +534,8 @@ Restart:
Else
Loader.Start(IsForceRestart:=IsForceRestarting)
End If
'如果不让继续启动,那就不启动呗
If Loader.Block Then Ignore = True
'阻止继续
If Loader.Block Then Blocked = True
End Select
Next
If IsFinished Then
@@ -566,38 +573,28 @@ Restart:
End Class
'任务栏进度条
Public LoaderTaskbarLock As New Object
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbar As New SafeList(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)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.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)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
End SyncLock
'若单个任务已中止,或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Aborted) Then
FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress
@@ -625,15 +622,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(l) l.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
File diff suppressed because it is too large. Load diff
@@ -1,11 +1,28 @@
'提供不同的输入验证方法,名称以 Validate 开头
Public Module ModValidate
''' <summary>
''' 进行输入验证,并返回错误原因。
''' 如果没有错误则返回空字符串。
''' </summary>
Public Function Validate(Text As String, ValidateRules As IEnumerable(Of Validate)) As String
Dim Result As String = ""
For Each ValidateRule As Validate In ValidateRules
Result = ValidateRule.Validate(Text)
If Result Is Nothing Then Return ""
If Result <> "" Then Return Result
Next
Return Result
End Function
End Module
''' <summary>
''' 输入验证规则基类。要查看所有的输入验证规则,可在输入 Validate 后查看自动补全。
''' </summary>
Public MustInherit Class Validate
''' <summary>
''' 验证某字符串是否符合验证要求。若符合,返回空字符串;若不符合,返回错误原因。
''' 验证某字符串是否符合验证要求。若符合,返回空字符串;若不符合,返回错误原因;若需要中断检查并直接通过,返回 Nothing。
''' </summary>
Public MustOverride Function Validate(Str As String) As String
End Class
@@ -119,9 +136,9 @@ Public Class ValidateLength
Me.Max = Max
End Sub
Public Overrides Function Validate(Str As String) As String
If Len(Str) <> Max AndAlso Max = Min Then Return "长度必须为 " & Max & " 个字符!"
If Len(Str) > Max Then Return "长度最长为 " & Max & " 个字符!"
If Len(Str) < Min Then Return "长度至少需 " & Min & " 个字符!"
If Len(Str) <> Max AndAlso Max = Min Then Return $"长度必须为 {Max} 个字符!"
If Len(Str) > Max Then Return $"长度最长为 {Max} 个字符!"
If Len(Str) < Min Then Return $"长度至少需 {Min} 个字符!"
Return ""
End Function
End Class
@@ -131,21 +148,24 @@ 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 = "输入内容不能包含 %!"
ErrorMessage = "输入内容不能包含 %"
End Sub '用于 XAML 初始化
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %!")
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %!")
Me.Excepts = New ObjectModel.Collection(Of String)
Me.ErrorMessage = ErrorMessage
For Each Data As String In Excepts
Me.Excepts.Add(Data)
Next
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
@@ -164,23 +184,25 @@ 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()
End Sub
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String)
For Each Data As String In Excepts
Me.Excepts.Add(Data)
Next
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
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")
@@ -218,21 +240,23 @@ Public Class ValidateFolderName
Try
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查空格
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
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 Not InvalidStrCheck = "" Then Return InvalidStrCheck
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
'检查文件夹重名
Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then
@@ -277,15 +301,17 @@ Public Class ValidateFileName
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
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 Not InvalidStrCheck = "" Then Return InvalidStrCheck
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
@@ -322,10 +348,10 @@ Public Class ValidateFolderPath
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查长度
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
@@ -351,6 +377,8 @@ 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 "文件夹名不能包含这一特殊格式!"
Next
Return ""
End Function
@@ -7,7 +7,7 @@ Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Dictionary(Of String, MyBitmap)
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary>
''' 存储的图片
@@ -17,15 +17,19 @@ Public Class MyBitmap
'自动类型转换
'支持的类:Image,ImageSource,Bitmap,ImageBrush,BitmapSource
Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image
If Image Is Nothing Then Return Nothing
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
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)
@@ -37,15 +41,19 @@ Public Class MyBitmap
End Try
End Operator
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap
If Image Is Nothing Then Return Nothing
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush
If Image Is Nothing Then Return Nothing
Return New ImageBrush(New MyBitmap(Image.Pic))
End Operator
@@ -61,23 +69,32 @@ Public Class MyBitmap
Pic = BitmapCache(FilePathOrResourceName).Pic
Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.Add(FilePathOrResourceName, Pic)
BitmapCache.TryAdd(FilePathOrResourceName, Pic)
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
Pic = New System.Drawing.Bitmap(InputStream)
InputStream.Dispose()
'判断是否为 WebP 文件头
Dim Header(1) As Byte
InputStream.Read(Header, 0, 2)
InputStream.Seek(0, SeekOrigin.Begin)
If Header(0) = 82 AndAlso Header(1) = 73 Then
'读取 WebP
Dim FileBytes(InputStream.Length - 1) As Byte
InputStream.Read(FileBytes, 0, FileBytes.Length)
Pic = WebPDecoder.DecodeFromBytes(FileBytes) '将代码隔离在另外一个类中,这样只要不走进这个分支就不会加载 Imazen.WebP.dll
Else
Pic = New System.Drawing.Bitmap(InputStream)
End If
End Using
End If
Catch ex As Exception
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, $"加载位图失败({FilePathOrResourceName})")
Throw
Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex)
Else
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer)
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try
End If
End Try
@@ -104,6 +121,13 @@ Public Class MyBitmap
Pic = New System.Drawing.Bitmap(MS)
End Using
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)
End Function
End Class
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
File diff suppressed because it is too large. Load diff
@@ -1,24 +1,12 @@
Public Class CrashAnalyzer
Private Shared IsAnalyzeCacheCleared As Boolean = False
Private Shared IsAnalyzeCacheClearedLock As New Object
'构造函数
Private TempFolder As String
Public Sub New(UUID As Integer)
'清理缓存
SyncLock IsAnalyzeCacheClearedLock
If Not IsAnalyzeCacheCleared Then
Try
DeleteDirectory(PathTemp & "CrashAnalyzer\")
Catch ex As Exception
Log(ex, "清理崩溃分析缓存失败")
End Try
IsAnalyzeCacheCleared = True
End If
End SyncLock
Private TargetVersion As McVersion
Public Sub New(Optional TargetVersion As McVersion = Nothing)
Me.TargetVersion = TargetVersion
'构建文件结构
TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\"
DeleteDirectory(TempFolder)
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹:" & TempFolder)
@@ -85,11 +73,7 @@
'将可能可用的日志文件导出
For Each FilePath In RightLogs
Try
If FilePath.Contains("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Split(vbCrLf.ToCharArray)))
Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败(" & FilePath & ")")
End Try
@@ -131,11 +115,7 @@ Extracted:
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then
If TargetFile.Name.StartsWithF("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
File.Delete(TargetFile.FullName)
End If
@@ -151,20 +131,21 @@ Extracted:
Private Enum AnalyzeFileType
HsErr
MinecraftLog
ExtraLog
ExtraLogFile
ExtraReportFile
CrashReport
End Enum
Private DirectFile As KeyValuePair(Of String, String())? = Nothing '在弹窗中选择直接打开的文件
''' <summary>
''' 从 AnalyzeRawFiles 中提取实际有用的文本片段存储到 AnalyzeFiles,并整理可用于生成报告的文件。
''' 返回找到的用于分析的项目数。
''' 返回是否有足够信息可用于分析。
''' </summary>
Public Function Prepare() As Integer
Public Function Prepare() As Boolean
Log("[Crash] 步骤 2:准备日志文本")
'对日志文件进行分类
DirectFile = Nothing
Dim TotalFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
@@ -184,27 +165,35 @@ Extracted:
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
Else
TargetType = AnalyzeFileType.ExtraLog
TargetType = AnalyzeFileType.ExtraLogFile
End If
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraLog
ElseIf MatchName.EndsWithF(".log", True) Then
TargetType = AnalyzeFileType.ExtraLogFile
ElseIf MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraReportFile
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
If LogFile.Value.Any Then
AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType))
Else
Log("[Crash] " & MatchName & " 由于内容为空跳过")
End If
Next
'若只有额外日志,则将它们视作 Minecraft 日志
If AllFiles.Any() AndAlso AllFiles.All(Function(p) p.Key = AnalyzeFileType.ExtraLogFile) Then
Log("[Crash] 由于仅发现了额外日志,将它们视作 Minecraft 日志进行分析")
AllFiles = AllFiles.Select(Function(p) New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(AnalyzeFileType.MinecraftLog, p.Value)).ToList
End If
'将分类后的文件分别写入
For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLog, AnalyzeFileType.CrashReport}
For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLogFile, AnalyzeFileType.CrashReport}
'获取该种类的所有文件 {文件路径 -> 文件内容行}
Dim SelectedFiles As New List(Of KeyValuePair(Of String, String()))
For Each File In TotalFiles
For Each File In AllFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If Not SelectedFiles.Any() Then Continue For
@@ -246,54 +235,59 @@ Extracted:
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
'截取 “以下为游戏输出的最后一段内容” 后的内容
Dim HasLauncherMark As Boolean = False
For Each Line In CurrentLog.Value
If HasLauncherMark Then
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为启动器日志")
Exit For
End If
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
'截取 “以下为游戏输出的最后一段内容” 后的内容
Dim HasLauncherMark As Boolean = False
For Each Line In CurrentLog.Value
If HasLauncherMark Then
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为启动器日志")
Exit For
Next
'选择一份最佳的 Minecraft Log
For Each FileName As String In {"latest.log", "latest log.txt", "debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft 日志")
Exit For
End If
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft 日志")
Exit For
Next
'查找 Debug Log
For Each FileName As String In {"debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft Debug 日志")
Exit For
End If
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft Debug 日志")
Exit For
Next
'检查错误
'兜底
If LogMc = "" Then
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
If LogMcDebug <> "" Then '如果没有找到 Minecraft 日志,则使用 Debug 日志作为兜底
LogMc = LogMcDebug
ElseIf FileNameDict.Any() Then '如果都没有找到,则使用第一个文件
Dim CurrentLog = FileNameDict.First.Value
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为兜底日志")
Else
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
End If
End If
If LogMcDebug = "" Then LogMcDebug = Nothing
Case AnalyzeFileType.ExtraLog
Case AnalyzeFileType.ExtraLogFile, AnalyzeFileType.ExtraReportFile
'全部丢过去
For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为额外日志")
Log("[Crash] 输出报告:" & SelectedFile.Key & ",不用作分析")
Next
End Select
Catch ex As Exception
@@ -301,15 +295,13 @@ Extracted:
End Try
Next
'获取种类数
Dim ResultCount As Integer = If(LogMc Is Nothing, 0, 1) + If(LogHs Is Nothing, 0, 1) + If(LogCrash Is Nothing, 0, 1)
If ResultCount = 0 Then
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
Else
'结束
Prepare = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Prepare Then
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Else
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
End If
Return ResultCount
End Function
''' <summary>
''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
@@ -349,6 +341,7 @@ Extracted:
''' 导致崩溃的原因枚举。
''' </summary>
Private Enum CrashReason
Java虚拟机参数有误
Mod文件被解压
MixinBootstrap缺失
内存不足
@@ -381,6 +374,7 @@ Extracted:
没有可用的分析文件
使用32位Java导致JVM无法分配足够多的内存
Mod重复安装
Mod互不兼容
OptiFine与Forge不兼容
Fabric报错
Fabric报错并给出解决方案
@@ -389,7 +383,7 @@ Extracted:
版本Json中存在多个Forge
Mod过多导致超出ID限制
NightConfig的Bug
ShadersMod与Optifine同时安装
ShadersMod与OptiFine同时安装
Forge安装不完整
Mod需要Java11
Mod缺少前置或MC版本错误
@@ -399,7 +393,7 @@ Extracted:
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = (If(LogMc, "") & If(LogMcDebug, "") & If(LogHs, "") & If(LogCrash, ""))
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
'1. 精准日志匹配,中/高优先级
AnalyzeCrit1()
@@ -413,7 +407,7 @@ Extracted:
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If
'Minecraft 日志
If LogMc IsNot Nothing Then
@@ -485,16 +479,18 @@ Done:
'空白分析
If LogMc Is Nothing AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing Then
AppendReason(CrashReason.没有可用的分析文件)
Exit Sub
Return
End If
'崩溃报告分析,高优先级
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
End If
'游戏日志分析
If LogMc IsNot Nothing Then
If LogMc.Contains("Unrecognized option:") Then AppendReason(CrashReason.Java虚拟机参数有误)
If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
@@ -516,15 +512,16 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") AndAlso Not CrashReasons.ContainsKey(CrashReason.Mod配置文件导致游戏崩溃) Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
@@ -540,12 +537,14 @@ Done:
End If
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复安装
'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'Mod 缺少前置
If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息:").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
End If
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
@@ -573,8 +572,9 @@ Done:
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If
@@ -591,40 +591,57 @@ Done:
''' </summary>
Private Sub AnalyzeCrit2()
'Mixin 分析
Dim MixinAnalyze =
Function(LogText As String) As Boolean
Dim IsMixin As Boolean =
LogText.Contains("Mixin prepare failed ") OrElse LogText.Contains("Mixin apply failed ") OrElse
LogText.Contains("MixinApplyError") OrElse LogText.Contains("MixinTransformerError") OrElse
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
If Not IsMixin Then Return False
'Mod 名称匹配
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
If ModName IsNot Nothing Then
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
Return True
End If
'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
Next
'没有明确匹配
AppendReason(CrashReason.ModMixin失败)
Return True
End Function
'游戏日志分析
If LogMc IsNot Nothing Then
'Mixin 崩溃
Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
'Mixin 崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
Else
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
'Mixin 崩溃
MixinAnalyze(LogCrash)
'常规信息
If LogCrash.Contains("Suspected Mod") Then
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If
End If
@@ -640,7 +657,9 @@ Done:
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc)
End If
'Mixin 失败可以导致大量 Mod 实例创建失败
'Mod 解析错误(常见于 Fabric 前置校验失败)
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
'Mixin 失败可以导致大量 Mod 实例创建失败,因此需要放到低优先级中
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
'注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报
End If
@@ -694,11 +713,12 @@ NextStack:
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl",
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -738,13 +758,13 @@ NextStack:
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If
Details = Details.After("¨")
Details = Details.AfterLast("¨")
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ContainsF(".jar", True) OrElse
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -841,28 +861,30 @@ NextStack:
''' <summary>
''' 弹出崩溃弹窗,并指导导出崩溃报告。
''' </summary>
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
Public Sub Output(IsManualAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示
FrmMain.ShowWindowToTop()
Dim ShowLog As Action =
Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"),
Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub()
'弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key)
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath)
StartProcess(FilePath)
End If
End Sub
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
End Sub))
Case 3
'弹窗选择:导出错误报告
Dim FileAddress As String = Nothing
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Exit Sub
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Return
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
'输出诊断信息
@@ -872,16 +894,24 @@ NextStack:
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile)
Dim FileEncoding As Encoding = Nothing
Select Case FileName
Case "LatestLaunch.bat"
FileName = "启动脚本.bat"
Case "Log1.txt"
FileName = "PCL 启动器日志.txt"
FileEncoding = Encoding.UTF8
Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt"
FileEncoding = Encoding.UTF8
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
FileContent = FilterUserName(FileContent, "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
Next
'导出报告
@@ -890,10 +920,15 @@ NextStack:
Hint("错误报告已导出!", HintType.Finish)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Exit Sub
Return
End Try
OpenExplorer("/select,""" & FileAddress & """")
OpenExplorer(FileAddress)
End Select
'上报
If IsManualAnalyze Then Return
Telemetry("Minecraft 崩溃",
"Version", If(TargetVersion Is Nothing, "null", TargetVersion.Version.ToString),
"Detail", FilterUserName(Detail, "*"))
End Sub
''' <summary>
''' 获取崩溃分析的结果描述。
@@ -905,7 +940,7 @@ NextStack:
If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。"
Else
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请导出错误报告并发给他人,而不是发送这个窗口的截图。"
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。"
End If
End If
@@ -914,12 +949,14 @@ NextStack:
For Each Reason In CrashReasons
Dim Additional As List(Of String) = Reason.Value
Select Case Reason.Key
Case CrashReason.Java虚拟机参数有误
Results.Add("由于 Java 参数有误,导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
Case CrashReason.内存不足
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是因为电脑内存不足、游戏分配的内存不足,或是配置要求过高。\n\n你可以尝试在 更多 → 百宝箱 中选择 内存优化,然后再启动游戏。\n如果还是不行,请在启动设置中增加为游戏分配的内存,并删除配置要求较高的材质、Mod、光影。\n如果依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Case CrashReason.使用OpenJ9
Results.Add("游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。")
Results.Add("游戏因为使用 OpenJ9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。")
Case CrashReason.使用JDK
Results.Add("游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。")
Case CrashReason.Java版本过高
@@ -938,9 +975,9 @@ NextStack:
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
@@ -961,7 +998,9 @@ NextStack:
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.ModMixin失败
If Additional.Count = 1 Then
If Additional.Count = 0 Then
Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
ElseIf Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
@@ -976,7 +1015,7 @@ NextStack:
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
@@ -988,22 +1027,30 @@ NextStack:
If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h")
If Additional.First.Contains("minecraft:player") Then
If Additional.First.Contains(" ") Then
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
Else
Results.Add($"游戏因为玩家实体导致了崩溃。\h")
End If
Else
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
End If
Else
Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、")}\h")
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.ShadersMod与Optifine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.ShadersMod与OptiFine同时安装
Results.Add("无需同时安装 OptiFine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Results.Add("可能由于其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.Mod需要Java11
@@ -1029,30 +1076,36 @@ NextStack:
Case CrashReason.文件或内容校验失败
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
Case CrashReason.Forge安装不完整
Results.Add("由于 Forge 安装不完整,导致游戏无法正常运行。\n请尝试重新安装 Forge。\h")
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Mod互不兼容
If Additional.Count = 1 Then
Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Forge报错
If Additional.Count = 1 Then
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.没有可用的分析文件
Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h")
@@ -1068,9 +1121,9 @@ NextStack:
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 [设置 → 其他 → 启动器 → 检查更新] 更新 PCL。"))
End Function
End Class
@@ -21,12 +21,7 @@
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable Then
'是否跳过
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
End If
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
@@ -56,7 +51,7 @@
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件"
@@ -69,9 +64,9 @@
#End Region
#Region "下载资源文件"
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
If ShouldIgnoreFileCheck(Version) Then
Log("[Download] 已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
@@ -104,7 +99,7 @@
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新:每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引")
Log("[Download] 无需更新资源文件索引,取消")
Task.Abort()
End If
End Sub))
@@ -121,7 +116,7 @@
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
@@ -172,24 +167,25 @@
End Structure
''' <summary>
''' Minecraft 客户端 版本列表,主加载器。
''' 若要求镜像源必须包含某个版本,则将该版本 ID 作为输入(#5195)。
''' </summary>
Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -198,13 +194,20 @@
''' <summary>
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'确定官方源是否可用
If Not DlPreferMojang Then
Dim DeltaTime = GetTimeTick() - StartTime
DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
@@ -230,14 +233,21 @@
''' <summary>
''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'检查是否有要求的版本(#5195)
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
If DlClientListLoader.Output.Value IsNot Nothing AndAlso Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
End If
End If
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
@@ -250,26 +260,31 @@
''' </summary>
Public Function DlClientListGet(Id As String)
Try
'确认 Minecraft 版本列表已完成获取
Select Case DlClientListLoader.State
Case LoadState.Loading
DlClientListLoader.WaitForExit()
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(IsForceRestart:=True)
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始
'获取 Minecraft 版本列表
Select Case DlClientListLoader.State
Case LoadState.Finished
'从当前的结果获取目标版本…
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
'…如果没有,则重新尝试获取(在版本刚更新时可能出现这种情况,#5195)
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
Return Version("url").ToString
End If
If Version("id") = Id Then Return Version("url").ToString
Next
Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
Log($"未发现版本 {Id} 的 json 下载地址,版本列表返回为:{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug)
Return Nothing
Catch ex As Exception
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败")
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -342,17 +357,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -362,7 +377,7 @@
''' </summary>
Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain)
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
Dim Result As String = NetRequestByClientRetry("https://optifine.net/downloads", Encoding:=Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
Try
'获取所有版本信息
@@ -398,7 +413,7 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -448,17 +463,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -468,7 +483,7 @@
''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True)
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
@@ -482,7 +497,7 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding:=Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
@@ -579,7 +594,7 @@
VersionName = Version
Me.Version = New Version(Version)
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
@@ -593,17 +608,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -614,12 +629,12 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用")
Else
Throw
End If
@@ -677,7 +692,7 @@
Catch ex As Exception
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("不可用")
Loader.Output = Versions
End Sub
@@ -685,9 +700,8 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4,#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -732,7 +746,7 @@
Catch ex As Exception
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("不可用")
Loader.Output = Versions
End Sub
@@ -785,7 +799,7 @@
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
Version = New Version(ApiName.Before("-"))
Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
@@ -800,17 +814,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -821,8 +835,8 @@
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
@@ -836,11 +850,11 @@
''' <summary>
''' NeoForge 版本列表,BMCLAPI。
''' </summary>
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListOfficialMain)
Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
@@ -857,7 +871,7 @@
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("不可用")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions
End Function
@@ -925,17 +939,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -945,7 +959,7 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True)
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -973,7 +987,7 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1024,17 +1038,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -1044,7 +1058,7 @@
''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://meta.fabricmc.net/v2/versions", IsJson:=True)
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1059,7 +1073,7 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True)
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1083,102 +1097,215 @@
#End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回 JToken。
''' 调用 NetRequest,会进行重试。
''' </summary>
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Dim McimUrl As String = DlSourceModGet(Url)
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) '至少 10s,要不然有时候远端服务器来不及完成
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
End Select
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
MojangBase
}
Private DlPreferMojang As Boolean = False
''' <summary>
''' 下载文件(而非获取版本列表)的时候,是否优先使用官方源。
''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
''' 下载文件(而非获取版本列表)的时候,根据是否优先使用官方源决定使用 Url 的顺序。
''' </summary>
Public Function DlSourceOrder(OfficialUrls As IEnumerable(Of String), MirrorUrls As IEnumerable(Of String)) As IEnumerable(Of String)
Return If(DlSourcePreferMojang, OfficialUrls.Union(MirrorUrls), MirrorUrls.Union(OfficialUrls))
End Function
''' <summary>
''' 获取版本列表(而非下载文件)的时候,是否优先使用官方源。
''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
''' 获取版本列表(而非下载文件)的时候,根据是否优先使用官方源决定使用 Url 的顺序。
''' </summary>
Public Function DlVersionListOrder(OfficialUrls As IEnumerable(Of String), MirrorUrls As IEnumerable(Of String)) As IEnumerable(Of String)
Return If(DlVersionListPreferMojang, OfficialUrls.Union(MirrorUrls), MirrorUrls.Union(OfficialUrls))
End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String()
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
MojangBase
}
''' <summary>
''' 下载 Assets 文件。
''' </summary>
Public Function DlSourceAssetsGet(Original As String) As IEnumerable(Of String)
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
})
End Function
''' <summary>
''' 下载 Libraries 文件。
''' </summary>
Public Function DlSourceLibraryGet(Original As String) As IEnumerable(Of String)
If {"minecraftforge", "fabricmc", "neoforged"}.Any(Function(k) Original.Contains(k)) Then '不添加原版源
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
}
Else
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
})
End If
End Function
''' <summary>
''' 下载 Launcher 或 Meta 文件。
''' 不应使用它来获取版本列表(因为它只使用文件下载源设置来决定源顺序)。
''' </summary>
Public Function DlSourceLauncherOrMetaGet(Original As String) As IEnumerable(Of String)
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
})
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
MojangBase
}
'Mod 下载源
Public Function DlSourceModGet(Original As String) As String
Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
'Loader 自动切换
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)),
Optional IsForceRestart As Boolean = False)
Dim WaitCycle As Integer = 0
Do While True
'检查加载结束
Dim IsAllFailed As Boolean = True
'检查状态
Dim BeforeLoadersAllFailed As Boolean = True
For Each SubLoader In LoaderList
If WaitCycle = 0 Then
'如果要强制刷新,就不使用已经加载好的值
If IsForceRestart Then Exit For
'如果输入不一样,就不使用已经加载好的值
If WaitCycle = 0 Then '判断是否可以不加载,直接使用已经加载好的结果
If IsForceRestart Then Continue For '强制刷新,不行
If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样,也不行
End If
If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False
If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList)
Exit Sub
ElseIf IsAllFailed Then
Return
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
End If
'由于 Forge BMCLAPI 没有可用版本导致强制失败
'在没有可用版本时,官方源会一直卡住,直接使用 BMCLAPI 判定失败即可
If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
For Each SubLoader2 In LoaderList
If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
Next
End If
Next
'启动加载源
'第一轮时:既然不直接使用已经加载好的结果,那就启动第一个加载器
If WaitCycle = 0 Then
'启动第一个源
LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart)
'将其他源标记为未启动,以确保可以切换下载源(#184)
For i = 1 To LoaderList.Count - 1
LoaderList(i).Key.State = LoadState.Waiting
LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart)
For Each Loader In LoaderList.Skip(1)
Loader.Key.State = LoadState.Waiting '将其他源标记为未启动,以确保可以切换下载源(#184)
Next
End If
'检查加载器失败或超时
For i = 0 To LoaderList.Count - 1
If WaitCycle = LoaderList(i).Value * 100 Then
If i < LoaderList.Count - 1 Then
'启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
If WaitCycle <> LoaderList(i).Value * 100 Then Continue For
If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then
'若还有下一个源,则启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'若没有,则失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
Next
'计时
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
Exit Sub
End If
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
Return
End If
Loop
End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
@@ -1,5 +1,5 @@
Public Module ModJava
Public JavaListCacheVersion As Integer = 6
Public JavaListCacheVersion As Integer = 7
''' <summary>
''' 目前所有可用的 Java。
@@ -10,7 +10,7 @@
'路径
''' <summary>
''' Java.exe 文件的完整路径。
''' java.exe 文件的完整路径。
''' </summary>
Public ReadOnly Property PathJava As String
Get
@@ -18,15 +18,7 @@
End Get
End Property
''' <summary>
''' Javaw.exe 文件的完整路径。
''' </summary>
Public ReadOnly Property PathJavaw As String
Get
Return PathFolder & "javaw.exe"
End Get
End Property
''' <summary>
''' Javaw.exe 文件所在文件夹的路径,以 \ 结尾。
''' java.exe 文件所在文件夹的路径,以 \ 结尾。
''' </summary>
Public PathFolder As String
''' <summary>
@@ -98,22 +90,19 @@
''' 检查并获取 Java 详细信息。在 Java 存在异常时抛出错误。
''' </summary>
Public Sub Check()
If IsChecked Then Exit Sub
If IsChecked Then Return
Dim Output As String = Nothing
Try
'确定文件存在
If Not File.Exists(PathJavaw) Then
Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw)
End If
If Not File.Exists(PathFolder & "java.exe") Then
Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
End If
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java,该 Java 或系统存在问题")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
@@ -131,18 +120,18 @@
Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If
Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'基于 #3649,在 64 位系统上禁用 32 位 Java
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'#3649:在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
'#2249:JRE 17 似乎会导致 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException
Throw ex
Catch ex As ThreadInterruptedException
Throw ex
Catch ex As Exception
Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex)
Log("[Java] 检查失败的 Java 输出:" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败(" & If(PathJava, "Nothing") & ")", ex)
End Try
IsChecked = True
End Sub
@@ -216,10 +205,12 @@
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList
@@ -340,7 +331,7 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -370,6 +361,7 @@ ExitUserJavaCheck:
For Each Java In AllowedJavaList
'如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例
If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For
If Java.PathFolder.Contains("PCL\MyDownload\") Then Continue For '#5780
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
@@ -380,7 +372,7 @@ ExitUserJavaCheck:
UserPass:
'对适合的 Java 进行排序
AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter)
AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序:")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
@@ -453,10 +445,12 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(PathMcFolder)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then
@@ -487,16 +481,18 @@ NoUserJava:
Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
If FrmSetupLaunch IsNot Nothing Then
RunInUiWait(Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
If FrmVersionSetup IsNot Nothing Then
RunInUiWait(Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
Try
@@ -518,8 +514,11 @@ NoUserJava:
Next
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 .jdks 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, True)
'查找 APPDATA 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
@@ -550,10 +549,9 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.ContainsF("system32") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径,不应优先使用")
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Next
@@ -581,7 +579,7 @@ NoUserJava:
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter)
NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
'修改设置项
Dim AllList As New JArray
@@ -663,24 +661,25 @@ Wait:
Private Sub JavaSearchFolder(OriginalPath As DirectoryInfo, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try
'确认目录存在
If Not OriginalPath.Exists Then Exit Sub
If Not OriginalPath.Exists Then Return
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
'不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon", "bin",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
"4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
If IsFullSearch OrElse
OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
@@ -706,8 +705,8 @@ Wait:
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
$"如果你已经安装了 {VersionDescription},可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java?", "自动下载", "取消") = 1
End If
End Function
@@ -736,10 +735,10 @@ Wait:
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetGetCodeByDownload(
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
IsJson:=True)
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True)
'获取下载地址
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
@@ -748,7 +747,7 @@ Wait:
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表
Dim ListFileStr As String = NetGetCodeByDownload({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
@@ -761,7 +760,7 @@ Wait:
End If
If Checker.Check(LastJavaBaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
Dim Url As String = Info("url")
Results.Add(New NetFile({Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"), Url}, LastJavaBaseDir & File.Name, Checker))
Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker))
Next
Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件,目标文件夹:{LastJavaBaseDir}")
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
@@ -1,6 +1,7 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 8
Public Class McMod
@@ -47,7 +48,7 @@ Public Module ModMod
Get
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
@@ -58,7 +59,7 @@ Public Module ModMod
Public Enum McModState As Integer
Fine = 0
Disabled = 1
Unavaliable = 2
Unavailable = 2
End Enum
#End Region
@@ -72,7 +73,7 @@ Public Module ModMod
Get
If _Name Is Nothing Then Load()
If _Name Is Nothing Then _Name = _ModId
If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path)
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
Set(value As String)
@@ -187,9 +188,9 @@ Public Module ModMod
Private _Dependencies As New Dictionary(Of String, String)
Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
'确保信息正确
If ModID Is Nothing OrElse ModID.Count < 2 Then Exit Sub
If ModID Is Nothing OrElse ModID.Count < 2 Then Return
ModID = ModID.ToLower
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Exit Sub '跳过 name 与纯数字 id
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
@@ -278,7 +279,7 @@ Public Module ModMod
''' 进行文件可用性检查与 .class 以外的信息获取。
''' </summary>
Public Sub Load(Optional ForceReload As Boolean = False)
If IsLoaded AndAlso Not ForceReload Then Exit Sub
If IsLoaded AndAlso Not ForceReload Then Return
'初始化
Init()
Dim Jar As ZipArchive = Nothing
@@ -687,7 +688,7 @@ Finished:
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return ChangelogUrls.Any()
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) AndAlso ChangelogUrls.Any()
End Get
End Property
@@ -701,13 +702,13 @@ Finished:
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path)
For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
@@ -814,16 +815,17 @@ Finished:
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
@@ -835,7 +837,7 @@ Finished:
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso
File.Directory.Name = "1." & PageVersionLeft.Version.Version.McCodeMain & "." & PageVersionLeft.Version.Version.McCodeSub) Then
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then
Continue For
End If
End If
@@ -852,7 +854,7 @@ Finished:
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
If CacheContent <> "" Then
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
@@ -861,6 +863,7 @@ Finished:
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try
Cache("version") = LocalModCacheVersion
@@ -869,7 +872,7 @@ Finished:
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load()
@@ -886,7 +889,7 @@ Finished:
End If
ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
@@ -899,17 +902,17 @@ Finished:
Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
'排序
ModList = Sort(ModList,
ModList = ModList.Sort(
Function(Left As McMod, Right As McMod) As Boolean
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
Return Left.State = McMod.McModState.Unavaliable
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavailable
Else
Return Not Right.FileName.CompareTo(Left.FileName)
End If
End Function)
'回设
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Loader.Output = ModList
'开始联网加载
@@ -924,39 +927,30 @@ Finished:
End Try
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 5
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
' For i = 1 To TargetMcVersion.McCodeSub
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
' Next
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim MainThread As Thread = Thread.CurrentThread
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Exit Sub
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
@@ -969,25 +963,23 @@ Finished:
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray)
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -1005,9 +997,9 @@ Finished:
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
@@ -1020,13 +1012,13 @@ Finished:
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Exit Sub
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
@@ -1041,34 +1033,33 @@ Finished:
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新
If ModLoaders.Count = 1 Then
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
@@ -1086,9 +1077,9 @@ Finished:
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
If Not UpdateFileIds.Any() Then Return
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod)
@@ -1113,29 +1104,36 @@ Finished:
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub
Thread.Sleep(10)
If Loader.IsAborted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsAborted Then Return
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmVersionMod?.RefreshBars())
End If
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
@@ -1215,7 +1213,7 @@ Finished:
If ReqVersionHead = ReqVersionTail Then
VersionRequire = "应为 " & ReqVersionHead
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
ElseIf ReqVersionHead.Contains(".") Then
If ReqVersionHeadCanEqual Then
VersionRequire = "最低应为 " & ReqVersionHead
@@ -1233,7 +1231,7 @@ Finished:
End If
'检查前置 Mod 是否存在,并获取其版本
If Not CurrentDependencies.ContainsKey(ReqId) Then
Result.Add("缺少前置 Mod:" & ReqId & If(VersionRequire = "", "", ",其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"缺少前置 Mod:{ReqId}{If(VersionRequire = "", "", ",其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
@@ -1242,7 +1240,7 @@ Finished:
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
@@ -1250,29 +1248,29 @@ Finished:
If ReqVersionTail.Contains(".") Then
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
Else
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
Result.Add("缺少前置 Mod:" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"缺少前置 Mod:{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
End If
Next
Catch ex As Exception
Result.Add("检查 Mod 时出错:" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
Result.Add($"检查 Mod 时出错:{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
Log(ex, "检查 Mod 时出错")
End Try
Next
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
Log($"[Minecraft] Mod 检查异常结果:{vbCrLf}{Join(Result, vbCrLf)}")
End If
Return Result
End Function
#End If
End Module
End Module
File diff suppressed because it is too large. Load diff
@@ -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()
@@ -81,33 +81,34 @@
WatcherStateChanged()
'初始化进程与日志读取
Me.GameProcess = Loader.Input
GameProcess = Loader.Input
GameProcess.BeginOutputReadLine()
GameProcess.BeginErrorReadLine()
AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
'初始化时钟
RunInNewThread(Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
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"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
Next
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
RunInNewThread(
Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
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"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
Next
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
End Sub
'状态
@@ -117,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
@@ -143,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
@@ -179,8 +180,9 @@
Public LatestLog As New Queue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Exit Sub
If Text Is Nothing Then Return
Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text)
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
@@ -255,8 +257,8 @@
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
@@ -266,10 +268,10 @@
Log(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogLevel.Hint)
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})")
@@ -290,8 +292,8 @@
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
@@ -306,27 +308,27 @@
TryGetMinecraftWindow = Nothing
EnumWindows(
Sub(hwnd As IntPtr, lParam As Integer)
If TryGetMinecraftWindow IsNot Nothing Then Exit Sub
If TryGetMinecraftWindow 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
Return
End Try
'返回
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
@@ -343,28 +345,27 @@
'崩溃处理
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 出现错误,错误分析已开始……")
Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Critical)
FeedbackInfo()
RunInNewThread(Sub()
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(PID)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json",
Path & "PCL\Log1.txt",
Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try
End Sub, "Crash Analyzer")
RunInNewThread(
Sub()
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(Version)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try
End Sub, "Crash Analyzer")
End Sub
'强制关闭
@@ -1,3 +1,8 @@
Public Module ModDevelop
#If DEBUG Then
Public Sub Start()
End Sub
#End If
End Module
+41 -18
View File
@@ -1,7 +1,7 @@
Public Module ModEvent
Public Sub TryStartEvent(Type As String, Data As String)
If String.IsNullOrWhiteSpace(Type) Then Exit Sub
If String.IsNullOrWhiteSpace(Type) Then Return
Dim RealData As String() = {""}
If Data IsNot Nothing Then RealData = Data.Split("|")
StartEvent(Type, RealData)
@@ -15,12 +15,12 @@
Data(0) = Data(0).Replace("\", "/")
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
Return
End If
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
Case "打开文件", "打开帮助", "执行命令"
RunInThread(
Sub()
Try
@@ -29,15 +29,25 @@
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
If Type = "打开帮助" Then
PageOtherHelp.EnterHelpPage(Location)
Else
If Not Setup.Get("HintCustomCommand") Then
Select Case MyMsgBox(
"即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
"请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 2
Setup.Set("HintCustomCommand", True)
Case 3
Return
End Select
End If
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
StartProcess(Info)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
@@ -48,7 +58,7 @@
If Data(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Return
Else
Data(0) = McVersionCurrent.Name
End If
@@ -90,9 +100,24 @@
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
Return
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Try
Select Case Data.Length
Case 1
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case 2
PageOtherTest.StartCustomDownload(Data(0), Data(1))
Case Else
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Data(0), "未知")
End Try
Case "修改设置"
Setup.Set(Data(0), Data(1))
Hint($"已写入设置:{Data(0)} → {Data(1)}", HintType.Finish)
Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
@@ -125,13 +150,11 @@
" - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
End Try
'下载文件
Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName
Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp1)
Hint("正在获取资源,请稍候……")
Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp)
Try
NetDownload(RelativeUrl, LocalTemp1)
NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
NetDownloadByClient(RelativeUrl, LocalTemp)
NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
Catch ex As Exception
Throw New Exception("下载指定的文件失败!" & vbCrLf &
"注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
@@ -139,7 +162,7 @@
" - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
" - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
End Try
RelativeUrl = LocalTemp1
RelativeUrl = LocalTemp
End If
RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
@@ -164,7 +187,7 @@
Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
ElseIf EventType = "打开文件" Then
ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
'直接使用原有路径启动程序
Location = RelativeUrl
Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
+132 -37
View File
@@ -34,12 +34,12 @@ Public Module ModMain
''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary>
Private HintWaiting As List(Of HintMessage) = If(HintWaiting, New List(Of HintMessage))
Private HintWaiting As SafeList(Of HintMessage) = If(HintWaiting, New SafeList(Of HintMessage))
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New List(Of HintMessage)
If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
@@ -47,7 +47,7 @@ Public Module ModMain
Try
'Tag 存储了:{ 是否可以重用, Uuid }
If Not HintWaiting.Any() Then Exit Sub
If Not HintWaiting.Any() Then Return
Do While HintWaiting.Any
''清除空提示
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
@@ -69,14 +69,14 @@ Public Module ModMain
Dim Percent As Double = 0.3
Select Case CurrentHint.Type
Case HintType.Info
TargetColor0 = New MyColor(37, 155, 252)
TargetColor1 = New MyColor(10, 142, 252)
TargetColor0 = New MyColor(215, 37, 155, 252)
TargetColor1 = New MyColor(215, 10, 142, 252)
Case HintType.Finish
TargetColor0 = New MyColor(33, 177, 33)
TargetColor1 = New MyColor(29, 160, 29)
TargetColor0 = New MyColor(215, 33, 177, 33)
TargetColor1 = New MyColor(215, 29, 160, 29)
Case Else 'HintType.Critical
TargetColor0 = New MyColor(255, 53, 11)
TargetColor1 = New MyColor(255, 43, 0)
TargetColor0 = New MyColor(215, 255, 53, 11)
TargetColor1 = New MyColor(215, 255, 43, 0)
End Select
If Not IsNothing(DoubleStack) Then
'有重复提示,且该提示的进入动画已播放
@@ -176,15 +176,17 @@ EndHint:
Public Title As String
Public Text As String
''' <summary>
''' 输入框模式:文本框的文本;选择模式:需要放进去的 List(Of MyListItem)。
''' 输入模式:文本框的文本。
''' 选择模式:需要放进去的 List(Of MyListItem)。
''' 登录模式:登录步骤 1 中返回的 JSON。
''' </summary>
Public Content As Object
''' <summary>
''' 仅输入框模式:输入验证规则。
''' 输入模式:输入验证规则。
''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate)
''' <summary>
''' 仅输入框模式:提示文本。
''' 输入模式:提示文本。
''' </summary>
Public HintText As String = ""
''' <summary>
@@ -214,7 +216,9 @@ EndHint:
''' </summary>
Public IsExited As Boolean = False
''' <summary>
''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮,则为 Nothing。
''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
''' 选择模式:点击的按钮编号,从 1 开始。
''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
''' </summary>
Public Result As Object
End Class
@@ -222,6 +226,7 @@ EndHint:
Text
[Select]
Input
Login
End Enum
''' <summary>
@@ -338,7 +343,7 @@ EndHint:
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
Public Sub MyMsgBoxTick()
Try
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Exit Sub
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
If FrmMain.PanMsg.Children.Count > 0 Then
'弹窗中
FrmMain.PanMsg.Visibility = Visibility.Visible
@@ -352,6 +357,8 @@ EndHint:
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Login
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
End Select
WaitingMyMsgBox.RemoveAt(0)
Else
@@ -390,14 +397,11 @@ EndHint:
'下载页面声明
Public FrmDownloadLeft As PageDownloadLeft
Public FrmDownloadInstall As PageDownloadInstall
Public FrmDownloadClient As PageDownloadClient
Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack
Public FrmDownloadDataPack As PageDownloadDataPack
Public FrmDownloadShader As PageDownloadShader
Public FrmDownloadResourcePack As PageDownloadResourcePack
'设置页面声明
Public FrmSetupLeft As PageSetupLeft
@@ -427,6 +431,7 @@ EndHint:
Public FrmVersionMod As PageVersionMod
Public FrmVersionModDisabled As PageVersionModDisabled
Public FrmVersionSetup As PageVersionSetup
Public FrmVersionExport As PageVersionExport
'资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -436,6 +441,10 @@ EndHint:
#Region "帮助"
Public Class HelpEntry
''' <summary>
''' 原始信息路径。用于刷新。
''' </summary>
Public RawPath As String
'基础
@@ -494,6 +503,7 @@ EndHint:
''' 从文件初始化 HelpEntry 对象,失败会抛出异常。
''' </summary>
Public Sub New(FilePath As String)
RawPath = FilePath
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息
@@ -591,7 +601,7 @@ EndHint:
'加载忽略列表
Log("[Help] 发现 .helpignore 文件:" & File.FullName)
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
Dim RealString As String = Line.Before("#").Trim
Dim RealString As String = Line.BeforeFirst("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString)
@@ -621,7 +631,7 @@ NextFile:
Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
End Try
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
'将文件实例化
Dim Dict As New List(Of HelpEntry)
@@ -637,7 +647,7 @@ NextFile:
'回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Loader.Output = Dict
Catch ex As Exception
@@ -664,8 +674,8 @@ NextFile:
''' </summary>
Public Function HelpArgumentReplace(Xaml As String) As String
Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomHint()), "\{hint\}")
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomCave()), "\{cave\}")
Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
Return Result
End Function
@@ -680,8 +690,8 @@ NextFile:
Private AprilDistance As Integer = 0
Private Sub TimerFool()
Try
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Exit Sub
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Exit Sub
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Return
'计算是否空闲
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
@@ -750,7 +760,7 @@ NextFile:
'移动
AprilSpeed = AprilSpeed * 0.8 + Acc
Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
If SpeedValue < 0.01 Then Exit Sub
If SpeedValue < 0.01 Then Return
AprilSpeed.Normalize()
AprilSpeed *= SpeedValue
AprilDistance += SpeedValue
@@ -798,6 +808,90 @@ NextFile:
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
''' <summary>
''' 将特定程序设置为使用高性能显卡启动。
''' 如果失败,则抛出异常。
''' </summary>
Public Sub SetGPUPreference(Executeable As String)
Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
Const REG_VALUE As String = "GpuPreference=2;"
'查看现有设置
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
If ReadOnlyKey IsNot Nothing Then
Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
If REG_VALUE = CurrentValue?.ToString() Then
Log($"[System] 无需调整显卡设置:{Executeable}")
Return
End If
Else
'创建父级键
Log($"[System] 需要创建显卡设置的父级键")
My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
End If
End Using
'写入新设置
Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
WriteKey.SetValue(Executeable, REG_VALUE)
Log($"[System] 已调整显卡设置:{Executeable}")
End Using
End Sub
#End Region
#Region "任务缓存"
Private IsTaskTempCleared As Boolean = False
Private IsTaskTempClearing As Boolean = False
''' <summary>
''' 尝试清理任务缓存文件夹。
''' 在整次运行中只会实际清理一次。
''' </summary>
Public Sub TryClearTaskTemp()
If Not IsTaskTempCleared Then
IsTaskTempCleared = True
IsTaskTempClearing = True
Try
Log("[System] 开始清理任务缓存文件夹")
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
DeleteDirectory($"{PathTemp}TaskTemp\")
Log("[System] 已清理任务缓存文件夹")
Catch ex As Exception
Log(ex, "清理任务缓存文件夹失败")
Finally
IsTaskTempClearing = False
End Try
ElseIf IsTaskTempClearing Then
'等待另一个清理步骤完成
Do While IsTaskTempClearing
Thread.Sleep(1)
Loop
End If
End Sub
''' <summary>
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
''' 若所有缓存位置均没有权限,会抛出异常。
''' </summary>
''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
TryClearTaskTemp()
Dim ResultFolder As String
Try
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
Directory.CreateDirectory(ResultFolder)
CheckPermissionWithException(ResultFolder)
Return ResultFolder
Catch
End Try
'使用备用路径
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Directory.CreateDirectory(ResultFolder)
CheckPermission(ResultFolder)
Return ResultFolder
End Function
#End Region
Public DragControl = Nothing
@@ -813,7 +907,7 @@ NextFile:
If ThemeDontClick = 2 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "短程主时钟执行异常", LogLevel.Assert)
Log(ex, "短程主时钟执行异常", LogLevel.Critical)
End Try
Timer4Count += 1
If Timer4Count = 4 Then
@@ -833,15 +927,16 @@ NextFile:
#Region "每 7.5s 执行一次的代码"
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
'以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
RunInUi(Sub()
If Not FrmMain.Hidden Then
If FrmMain.Top < -9000 Then FrmMain.Top = 100
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
End If
End Sub)
RunInUi(
Sub()
If Not FrmMain.Hidden Then
If FrmMain.Top < -9000 Then FrmMain.Top = 100
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
End If
End Sub)
#End Region
Catch ex As Exception
Log(ex, "长程主时钟执行异常", LogLevel.Assert)
Log(ex, "长程主时钟执行异常", LogLevel.Critical)
End Try
End If
End Sub
@@ -857,7 +952,7 @@ NextFile:
Log(ex, "程序主时钟出错", LogLevel.Feedback)
End Try
End Sub, "Timer Main")
If Not IsAprilEnabled Then Exit Sub
If Not IsAprilEnabled Then Return
RunInNewThread(
Sub()
Try
+86 -55
View File
@@ -14,8 +14,8 @@
''' 初始化音乐播放列表。
''' </summary>
''' <param name="ForceReload">强制全部重新载入列表。</param>
''' <param name="IgnoreFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "")
''' <param name="PreventFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional PreventFirst As String = Nothing)
If ForceReload Then MusicAllList = Nothing
Try
'初始化全部可用音乐列表
@@ -31,10 +31,10 @@
End If
'打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
MusicWaitingList.Add(PreventFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -42,13 +42,18 @@
End Sub
''' <summary>
''' 获取下一首播放的音乐路径并将其从列表中移除。
''' 如果没有,可能会返回 Nothing。
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Any() Then
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
Else
DequeueNextMusicAddress = Nothing
End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
@@ -60,44 +65,45 @@
''' 刷新背景音乐按钮 UI 与设置页 UI。
''' </summary>
Private Sub MusicRefreshUI()
RunInUi(Sub()
Try
RunInUi(
Sub()
Try
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
End Sub
''' <summary>
@@ -128,8 +134,12 @@
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
If Address Is Nothing Then
Hint("没有可以播放的音乐!", HintType.Critical)
Else
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
End If
End If
MusicRefreshUI()
End Sub
@@ -179,11 +189,15 @@
End If
Else
Dim Address As String = DequeueNextMusicAddress()
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
If Address Is Nothing Then
If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical)
Else
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
End If
End If
MusicRefreshUI()
@@ -195,6 +209,7 @@
''' 开始播放音乐。
''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return
Log("[Music] 播放开始:" & Address)
MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
@@ -230,7 +245,12 @@
RunInThread(
Sub()
Log("[Music] 已恢复播放")
MusicNAudio?.Play()
Try
MusicNAudio?.Play()
Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
MusicNAudio?.Stop()
MusicNAudio?.Play()
End Try
MusicRefreshUI()
End Sub)
Return True
@@ -240,7 +260,7 @@
#End Region
''' <summary>
''' 当前正在播放的 NAudio.Wave.WaveOut。
''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
''' </summary>
Public MusicNAudio = Nothing
''' <summary>
@@ -252,12 +272,13 @@
''' 在 MusicUuid 不变的前提下,持续播放某地址的音乐,且在播放结束后随机播放下一曲。
''' </summary>
Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False)
Dim CurrentWave As NAudio.Wave.WaveOut = Nothing
Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing
Dim Reader As NAudio.Wave.WaveStream = Nothing
Try
'开始播放
CurrentWave = New NAudio.Wave.WaveOut()
CurrentWave = New NAudio.Wave.WaveOutEvent()
MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
CurrentWave.Init(Reader)
CurrentWave.Play()
@@ -280,22 +301,32 @@
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Critical)
Thread.Sleep(1000000000)
End If
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Thread.Sleep(1000000000)
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
Thread.Sleep(1000)
'将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent)
MusicWaitingList.Remove(MusicCurrent)
MusicRefreshUI()
'等待 2 秒后继续播放
Thread.Sleep(2000)
If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then
Else
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If
Finally
+88 -82
View File
@@ -1,15 +1,19 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net
Imports System.Reflection
Imports System.Security.Cryptography
Friend Module ModSecret
#Region "杂项"
'在开源内容的注册表键与普通内容的注册表键隔离
'在开源版的注册表与常规版的注册表隔离,以防数据冲突
Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")
'CurseForge API Key
Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")
'用于匿名数据收集的腾讯云日志服务上报 URL,形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id}
Public Const ClsBaseUrl As String = ""
Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级
@@ -30,7 +34,7 @@ Friend Module ModSecret
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel)
Environment.[Exit](ProcessReturnValues.Cancel)
End Try
If Not CheckPermission(Path & "PCL") Then
MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf &
@@ -38,11 +42,12 @@ Friend Module ModSecret
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel)
Environment.[Exit](ProcessReturnValues.Cancel)
End If
'开源版本提示
MyMsgBox($"该版本中不包含以下特性:
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中)
MyMsgBox($"该版本中无法使用以下特性:
- CurseForge API 调用:需要你自行申请 API Key,然后添加到 ModSecret.vb 的开头
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
@@ -64,60 +69,29 @@ Friend Module ModSecret
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
End Sub
''' <summary>
''' 打码字符串中的 AccessToken。
''' </summary>
Friend Function SecretFilter(Raw As String, FilterChar As Char) As String
'打码 "accessToken " 后的内容
If Raw.Contains("accessToken ") Then
For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
Next
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken Is Nothing OrElse AccessToken.Length < 10 OrElse Not Raw.ContainsF(AccessToken, True) OrElse
McLoginLoader.Output.Uuid = McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Return Raw
Else
Return Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
End Function
#End Region
#Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String)
'只处理以 {CDN} 结尾的链接
Friend Function SecretCdnSign(UrlWithMark As String) As String
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function
''' <summary>
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
If Not Req.Headers.UserAgent.Any Then
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Req.Headers.Add("User-Agent", "LogStatistic") '#4951
ElseIf SimulateBrowserHeaders Then
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
Else
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
End If
End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub
''' <summary>
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用
If UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Request.UserAgent = "PCL2/" & VersionStandardCode
End If
Request.Referer = "http://" & VersionCode & ".pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
End Sub
#End Region
@@ -194,45 +168,70 @@ Friend Module ModSecret
Public ThemeDontClick As Integer = 0
Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
Hint("该版本中不包含主题功能……")
Try
If ThemeNow = NewTheme AndAlso NewTheme >= 0 Then Return
If NewTheme >= 0 Then ThemeNow = NewTheme
Color1 = New MyColor().FromHSL2(ColorHue, ColorSat * 0.2, 25 + ColorLightAdjust * 0.3)
Color2 = New MyColor().FromHSL2(ColorHue, ColorSat, 45 + ColorLightAdjust)
Color3 = New MyColor().FromHSL2(ColorHue, ColorSat, 55 + ColorLightAdjust)
Color4 = New MyColor().FromHSL2(ColorHue, ColorSat, 65 + ColorLightAdjust)
Color5 = New MyColor().FromHSL2(ColorHue, ColorSat, 80 + ColorLightAdjust * 0.4)
Color6 = New MyColor().FromHSL2(ColorHue, ColorSat, 91 + ColorLightAdjust * 0.1)
Color7 = New MyColor().FromHSL2(ColorHue, ColorSat, 95)
Color8 = New MyColor().FromHSL2(ColorHue, ColorSat, 97)
ColorBg0 = Color4 * 0.4 + Color5 * 0.4 + ColorGray4 * 0.2
ColorBg1 = New MyColor(190, Color7)
ColorSemiTransparent = New MyColor(1, Color8)
Application.Current.Resources("ColorBrush1") = New SolidColorBrush(Color1)
Application.Current.Resources("ColorBrush2") = New SolidColorBrush(Color2)
Application.Current.Resources("ColorBrush3") = New SolidColorBrush(Color3)
Application.Current.Resources("ColorBrush4") = New SolidColorBrush(Color4)
Application.Current.Resources("ColorBrush5") = New SolidColorBrush(Color5)
Application.Current.Resources("ColorBrush6") = New SolidColorBrush(Color6)
Application.Current.Resources("ColorBrush7") = New SolidColorBrush(Color7)
Application.Current.Resources("ColorBrush8") = New SolidColorBrush(Color8)
Application.Current.Resources("ColorBrushBg0") = New SolidColorBrush(ColorBg0)
Application.Current.Resources("ColorBrushBg1") = New SolidColorBrush(ColorBg1)
Application.Current.Resources("ColorObject1") = CType(Color1, Color)
Application.Current.Resources("ColorObject2") = CType(Color2, Color)
Application.Current.Resources("ColorObject3") = CType(Color3, Color)
Application.Current.Resources("ColorObject4") = CType(Color4, Color)
Application.Current.Resources("ColorObject5") = CType(Color5, Color)
Application.Current.Resources("ColorObject6") = CType(Color6, Color)
Application.Current.Resources("ColorObject7") = CType(Color7, Color)
Application.Current.Resources("ColorObject8") = CType(Color8, Color)
Application.Current.Resources("ColorObjectBg0") = CType(ColorBg0, Color)
Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
ThemeRefreshMain()
Catch ex As Exception
Log(ex, "刷新主题颜色失败", LogLevel.Hint)
End Try
End Sub
Public Sub ThemeRefreshMain()
RunInUi(
Sub()
If Not FrmMain.IsLoaded Then Exit Sub
If Not FrmMain.IsLoaded Then Return
'顶部条背景
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
If ThemeNow = 5 Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 15)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
ElseIf Not (ThemeNow = 12 OrElse ThemeDontClick = 2) Then
If TypeOf ColorHueTopbarDelta Is Integer Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
End If
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
If TypeOf ColorHueTopbarDelta Is Integer Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)})
FrmMain.PanTitle.Background = Brush
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
End If
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
'主页面背景
If Setup.Get("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 20, Math.Min(60, ColorSat) * 0.5, 80)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.9, 90)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 20, Math.Min(60, ColorSat) * 0.5, 80)})
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 15, ColorSat * 0.8, 91)})
FrmMain.PanForm.Background = Brush
Else
FrmMain.PanForm.Background = New MyColor(245, 245, 245)
@@ -240,18 +239,18 @@ Friend Module ModSecret
FrmMain.PanForm.Background.Freeze()
End Sub)
End Sub
Public Sub ThemeCheckAll(EffectSetup As Boolean)
Friend Sub ThemeCheckAll(EffectSetup As Boolean)
End Sub
Public Function ThemeCheckOne(Id As Integer) As Boolean
Friend Function ThemeCheckOne(Id As Integer) As Boolean
Return True
End Function
Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
Return False
End Function
Public Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Return False
End Function
Public Function DonateCodeInput() As Boolean?
Friend Function DonateCodeInput() As Boolean?
Return Nothing
End Function
@@ -270,6 +269,13 @@ Friend Module ModSecret
End Sub
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
End Sub
''' <summary>
''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
''' 如果不是,则下载一个。
''' </summary>
Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
'注意:如果要自行实现这个功能,请换用另一个文件路径,以免与官方版本冲突
End Sub
#End Region
@@ -1,59 +0,0 @@
Imports System.Net
Public Class CookieWebClient
Inherits WebClient
Public Sub New(container As CookieContainer, Headers As Dictionary(Of String, String))
Me.New(container)
For Each keyVal In Headers
Me.Headers(keyVal.Key) = keyVal.Value
Next
End Sub
Public Sub New()
Me.New(New CookieContainer())
End Sub
Public Sub New(container As CookieContainer)
Me.container = container
End Sub
Private Shadows ReadOnly container As New CookieContainer()
''' <summary>
''' 以毫秒为单位的超时。
''' </summary>
Public Timeout As Integer = 600000
Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
Dim r As WebRequest = MyBase.GetWebRequest(address)
Dim request = TryCast(r, HttpWebRequest)
If request IsNot Nothing Then
request.CookieContainer = container
request.Timeout = Timeout
End If
Return r
End Function
Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request, result)
ReadCookies(response)
Return response
End Function
Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request)
ReadCookies(response)
Return response
End Function
Private Sub ReadCookies(r As WebResponse)
Dim response = TryCast(r, HttpWebResponse)
If response IsNot Nothing Then
Dim cookies As CookieCollection = response.Cookies
container.Add(cookies)
End If
End Sub
End Class
+151
View File
@@ -0,0 +1,151 @@
'来源:https://blog.csdn.net/simpleman2000/article/details/140952294
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Windows.Interop
Public Class DragHelper
Public Event DragDrop As EventHandler
Public Property DropFilePaths As String()
Get
Return _DropFilePathsBackingField
End Get
Private Set(value As String())
_DropFilePathsBackingField = value
End Set
End Property
Private _DropFilePathsBackingField As String()
Public Property DropPoint As POINT
Get
Return _DropPointBackingField
End Get
Private Set(value As POINT)
_DropPointBackingField = value
End Set
End Property
Private _DropPointBackingField As POINT
Public Property HwndIntPtrSource As HwndSource
Public Sub AddHook()
RemoveDragHook()
HwndIntPtrSource.AddHook(AddressOf WndProc)
Dim handle As IntPtr = HwndIntPtrSource.Handle
If IsUserAnAdmin() Then RevokeDragDrop(handle)
DragAcceptFiles(handle, True)
ChangeMessageFilter(handle)
End Sub
Public Sub RemoveDragHook()
HwndIntPtrSource.RemoveHook(AddressOf WndProc)
DragAcceptFiles(HwndIntPtrSource.Handle, False)
End Sub
Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
Dim filePaths As String() = Nothing
Dim point As New POINT()
If TryGetDropInfo(msg, wParam, filePaths, point) Then
DropPoint = point
DropFilePaths = filePaths
RaiseEvent DragDrop(Me, EventArgs.Empty)
handled = True
End If
Return IntPtr.Zero
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function ChangeWindowMessageFilterEx(hWnd As IntPtr, msg As UInteger, action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function ChangeWindowMessageFilter(msg As UInteger, flags As UInteger) As Boolean
End Function
<DllImport("shell32.dll")>
Private Shared Sub DragAcceptFiles(hWnd As IntPtr, fAccept As Boolean)
End Sub
<DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
Private Shared Function DragQueryFile(hWnd As IntPtr, iFile As UInteger, lpszFile As StringBuilder, cch As Integer) As UInteger
End Function
<DllImport("shell32.dll")>
Private Shared Function DragQueryPoint(hDrop As IntPtr, ByRef lppt As POINT) As Boolean
End Function
<DllImport("shell32.dll")>
Private Shared Sub DragFinish(hDrop As IntPtr)
End Sub
<DllImport("ole32.dll")>
Private Shared Function RevokeDragDrop(hWnd As IntPtr) As Integer
End Function
<DllImport("shell32.dll")>
Private Shared Function IsUserAnAdmin() As Boolean
End Function
<StructLayout(LayoutKind.Sequential)>
Public Structure POINT
Public X As Integer
Public Y As Integer
End Structure
<StructLayout(LayoutKind.Sequential)>
Private Structure CHANGEFILTERSTRUCT
Public cbSize As UInteger
Public ExtStatus As UInteger
End Structure
Private Const WM_COPYGLOBALDATA As UInteger = &H49
Private Const WM_COPYDATA As UInteger = &H4A
Private Const WM_DROPFILES As UInteger = &H233
Private Const MSGFLT_ALLOW As UInteger = 1
Private Const MSGFLT_ADD As UInteger = 1
Private Const MAX_PATH As Integer = 260
Private Shared Sub ChangeMessageFilter(handle As IntPtr)
Dim ver As Version = Environment.OSVersion.Version
Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
If isVistaOrHigher Then
Dim status As New CHANGEFILTERSTRUCT With {.cbSize = 8}
For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
Dim [error] As Boolean = False
If isNt61OrHiger Then
[error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
Else
[error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
End If
If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
Next
End If
End Sub
Private Shared Function TryGetDropInfo(msg As Integer, wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
dropFilePaths = Nothing
dropPoint = New POINT()
If msg <> WM_DROPFILES Then Return False
Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
ReDim dropFilePaths(CInt(fileCount) - 1)
For i As UInteger = 0 To CInt(fileCount) - 1
Dim sb As New StringBuilder(MAX_PATH)
Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
If result > 0 Then dropFilePaths(i) = sb.ToString()
Next
DragQueryPoint(wParam, dropPoint)
DragFinish(wParam)
Return True
End Function
End Class
@@ -1,4 +1,4 @@
Imports System.Reflection
Imports System.Reflection
Imports System.Resources
Imports System.Runtime.InteropServices
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.2.0")>
<Assembly: AssemblyFileVersion("2.8.2.0")>
<Assembly: AssemblyVersion("2.10.8.0")>
<Assembly: AssemblyFileVersion("2.10.8.0")>
<Assembly: NeutralResourcesLanguage("")>
+66 -6
View File
@@ -63,9 +63,9 @@ Namespace My.Resources
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Custom() As Byte()
Friend ReadOnly Property CacheCow_Client() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
Dim obj As Object = ResourceManager.GetObject("CacheCow.Client", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
@@ -73,9 +73,29 @@ Namespace My.Resources
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Dialogs() As Byte()
Friend ReadOnly Property CacheCow_Client_FileStore() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Dialogs", resourceCulture)
Dim obj As Object = ResourceManager.GetObject("CacheCow.Client.FileStore", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property CacheCow_Common() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("CacheCow.Common", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Custom() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
@@ -100,6 +120,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Imazen_WebP() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Imazen.WebP", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -113,9 +143,9 @@ Namespace My.Resources
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Json() As Byte()
Friend ReadOnly Property libwebp64() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture)
Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
@@ -140,6 +170,36 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Newtonsoft_Json() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Newtonsoft.Json", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Ookii_Dialogs_Wpf() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Ookii.Dialogs.Wpf", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property System_Net_Http_Formatting() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("System.Net.Http.Formatting", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -118,23 +118,32 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="CacheCow.Client" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Client.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="CacheCow.Client.FileStore" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Client.FileStore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Dialogs" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ForgeInstaller" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Imazen.WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
@@ -142,6 +151,15 @@
<data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Newtonsoft.Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Ookii.Dialogs.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
@@ -1,6 +1,7 @@
<Grid x:Class="MyCompItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
x:Name="PanBack" Height="64"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
@@ -23,7 +24,7 @@
<Border.Clip>
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
@@ -4,90 +4,14 @@
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
Return PathLogo.Source
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载资源工程图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化资源工程图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[Comp] 已清理损坏的资源工程图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的资源工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载资源工程图标失败(" & value & ")")
End Try
PathLogo.Source = value
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Public Property Title As String
@@ -95,7 +19,7 @@ RetryStart:
Return LabTitle.Text
End Get
Set(value As String)
If LabTitle.Text = value Then Exit Property
If LabTitle.Text = value Then Return
LabTitle.Text = value
End Set
End Property
@@ -106,7 +30,7 @@ RetryStart:
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
If LabTitleRaw.Text = value Then Return
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
@@ -118,7 +42,7 @@ RetryStart:
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
If LabInfo.Text = value Then Return
LabInfo.Text = value
End Set
End Property
@@ -164,41 +88,52 @@ RetryStart:
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
If e.Handled Then Return
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
End If
End Sub
Private Sub ProjectClick(sender As MyCompItem, e As EventArgs) Handles Me.Click
Private Sub MyCompItem_Click(sender As MyCompItem, e As EventArgs) Handles Me.Click
'记录当前展开的卡片标题(#2712)
Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
Dim TargetType As CompType
Dim TargetVersion As String = Nothing
Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = CompType.Mod
TargetVersion = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
Case FormMain.PageSubType.DownloadPack
TargetType = CompType.ModPack
TargetVersion = FrmDownloadPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadDataPack
TargetType = CompType.DataPack
TargetVersion = FrmDownloadDataPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadResourcePack
TargetType = CompType.ResourcePack
TargetVersion = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadShader
TargetType = CompType.Shader
TargetVersion = FrmDownloadShader.Content.Loader.Input.GameVersion
End Select
Else
'从详情页进入(查看前置)
TargetType = CompType.Any '允许任意类别
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader, TargetType}})
End Sub
'鼠标点击判定
@@ -248,9 +183,9 @@ RetryStart:
''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' </summary>
Public CanInteraction As Boolean = True
Public Property CanInteraction As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
If Not CanInteraction Then Exit Sub
If Not CanInteraction Then Return
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
@@ -265,7 +200,7 @@ RetryStart:
StateNew = "Idle"
Time = 180
End If
If StateLast = StateNew Then Exit Sub
If StateLast = StateNew Then Return
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -0,0 +1,95 @@
<local:MyScrollViewer x:Class="PageComp"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索XXX" Margin="0,0,0,15" x:Name="PanAlways">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1.3*" />
<ColumnDefinition Width="1.2*" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="名称" Margin="0,0,18,0" />
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="2" />
<TextBlock VerticalAlignment="Center" Grid.Column="4" HorizontalAlignment="Left" Text="来源" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchSource" Grid.Column="5">
<local:MyComboBoxItem Content="全部" Tag="3" IsSelected="True" />
<local:MyComboBoxItem Content="CurseForge" Tag="1" />
<local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.8" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320" />
</Grid>
<Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSearchRun" Text="搜索" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton x:Name="BtnSearchReset" Text="重置条件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnSearchInstallModPack" Text="安装已有整合包" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2"
ToolTip="在当前选择的 Minecraft 文件夹下安装整合包" ToolTipService.HorizontalOffset="-55" ToolTipService.VerticalOffset="5" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后再试,或使用 VPN 改善网络环境。" Theme="Yellow" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
@@ -0,0 +1,259 @@
Imports System.Windows.Markup
<ContentProperty("SearchTags")>
Public Class PageComp
#Region "属性"
''' <summary>
''' 用于 XAML 快速设置的 Tag 下拉框列表。
''' </summary>
Public ReadOnly Property SearchTags As ItemCollection
Get
Return ComboSearchTag.Items
End Get
End Property
''' <summary>
''' 英文前后不含空格的可读资源类型名,例如 "Mod"、"整合包"。
''' </summary>
Public Property TypeName As String
Get
Return _TypeName
End Get
Set(Value As String)
If _TypeName = Value Then Return
_TypeName = Value
Loader.Name = $"社区资源获取:{Value}"
End Set
End Property
Private _TypeName As String = ""
''' <summary>
''' 英文前后含一个空格的可读资源类型名,例如 " Mod "、"整合包"。
''' </summary>
Public Property TypeNameSpaced As String
Get
Return _TypeNameSpaced
End Get
Set(Value As String)
If _TypeNameSpaced = Value Then Return
_TypeNameSpaced = Value
PanAlways.Title = $"搜索{Value}"
Load.Text = $"正在获取{Value}列表"
End Set
End Property
Private _TypeNameSpaced As String = ""
''' <summary>
''' 该页面对应的资源类型。
''' </summary>
Public Property PageType As CompType
Get
Return _Type
End Get
Set(Value As CompType)
If _Type = Value Then Return
_Type = Value
BtnSearchInstallModPack.Visibility = If(Value = CompType.ModPack, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Private _Type As CompType = -1
#End Region
#Region "加载"
''' <summary>
''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。
''' </summary>
Public Shared TargetVersion As McVersion = Nothing
''' <summary>
''' 在切换到该页面时自动设置的搜索框内的内容。
''' </summary>
Public Shared TargetName As String = Nothing
'在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private IsLoaderInited As Boolean = False
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then
'设置目标
ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName
Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items
If Item.Content = Name Then Return Item
Next
Return ComboSearchLoader.Items(0)
End Function
If TargetVersion.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If
TargetVersion = Nothing
If TargetName IsNot Nothing Then
TextSearchName.Text = TargetName
TargetName = Nothing
End If
'如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch()
ScrollToHome()
End If
'加载器初始化
If IsLoaderInited Then Return
IsLoaderInited = True
CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Private Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PageSize)
Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
With Request
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any)
.Source = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With
Return Request
End Function
#End Region
Public Storage As New CompProjectStorage
''' <summary>
''' 每页展示的结果数量。
''' </summary>
Public Const PageSize = 40
Public Page As Integer = 0
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
ScrollToTop()
Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", LogLevel.Feedback)
End Try
End Sub
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case Loader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", LogLevel.Debug)
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Sub BtnPageRight_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageRight.Click
ChangePage(Page + 1)
End Sub
Private Sub ChangePage(NewPage As Integer)
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] {TypeName}:切换到第 {Page + 1} 页")
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub EnterTrigger(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyDown, TextSearchVersion.KeyDown
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub ResetFilter() Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
'版本选择
'#3067:当下拉菜单展开时,程序会被 WPF 挂起,因而无法更新 Grid 布局,所以必须延迟到下拉菜单收起后才能更新
Private Sub TextSearchVersion_TextChanged() Handles TextSearchVersion.TextChanged
If Not TextSearchVersion.IsDropDownOpen Then UpdateSearchLoaderVisibility()
End Sub
Private Sub UpdateSearchLoaderVisibility() Handles TextSearchVersion.DropDownClosed
If PageType = CompType.Mod AndAlso (TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w")) Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
Else
ComboSearchLoader.Visibility = Visibility.Collapsed
Grid.SetColumnSpan(TextSearchVersion, 2)
ComboSearchLoader.SelectedIndex = 0
End If
End Sub
#End Region
'安装已有整合包按钮
Private Sub BtnSearchInstallModPack_Click(sender As Object, e As EventArgs) Handles BtnSearchInstallModPack.Click
ModpackInstall()
End Sub
End Class
@@ -3,13 +3,12 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
PanScroll="{Binding ElementName=PanBack}">
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyCard Margin="0,0,0,25" x:Name="CardIntro">
<StackPanel Margin="22,18,22,19" x:Name="PanIntro">
@@ -20,7 +19,12 @@
</StackPanel>
</StackPanel>
</local:MyCard>
<StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True" />
<StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True">
<local:MyCard Margin="0,0,0,15" x:Name="CardFilter">
<StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" />
</local:MyCard>
<StackPanel Name="PanResults" />
</StackPanel>
<local:MyCard Grid.Row="1" HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="0,0,0,8">
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
@@ -0,0 +1,454 @@
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
#Region "加载器"
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
"Comp File",
Sub(Task)
LoadTargetFromAdditional()
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
If Task.IsAborted Then Return
Task.Output = Result
End Sub)
'初始化加载器信息
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
''' <summary>
''' 当前页面应展示的内容类别。可能为 Any。
''' </summary>
Private PageType As CompType
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Comp] 下载的文件 json 列表损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
End Sub
'结果 UI 化
Private Class CardSorter
Implements IComparer(Of String)
Public Topmost As String = ""
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
'相同
If x = y Then Return 0
'置顶
If x = Topmost Then Return -1
If y = Topmost Then Return 1
'特殊版本
Dim IsXSpecial As Boolean = x.EndsWithF("版本")
Dim IsYSpecial As Boolean = y.EndsWithF("版本")
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
If IsXSpecial Then Return 1
If IsYSpecial Then Return -1
'比较版本号
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
If VersionCodeSort <> 0 Then Return VersionCodeSort
'比较全部
Return -VersionSortInteger(x, y)
End Function
Public Sub New(Optional Topmost As String = "")
Me.Topmost = If(Topmost, "")
End Sub
End Class
Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output
Select Case PageType
Case CompType.Any
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
Case CompType.Shader, CompType.ResourcePack
'不筛选光影和资源包,否则原版光影会因为是资源包格式而被过滤(#6473)
Case Else
Results = Results.Where(Function(r) r.Type = PageType).ToList
End Select
Return Results
End Function
Private Sub Load_OnFinish()
Dim Results = GetResults()
'初始化筛选器
Dim VersionFilters As List(Of String)
'按小版本号筛选?
IsMajorVersionFilter = False
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
'按大版本号筛选?
If VersionFilters.Count >= 9 Then
IsMajorVersionFilter = True
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End If
'UI 化筛选器
PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing
Else
CardFilter.Visibility = Visibility.Visible
VersionFilters.Insert(0, "全部")
'转化为按钮
For Each Version As String In VersionFilters
Dim NewButton As New MyRadioButton With {
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0)
AddHandler NewButton.Check,
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
UpdateFilterResult()
End Sub
PanFilter.Children.Add(NewButton)
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
Exit For
Next
End If
End If
If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0)
ToCheck.Checked = True
End If
'更新筛选结果(文件列表 UI 化)
UpdateFilterResult()
End Sub
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("其他版本", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
'决定添加到哪个卡片
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
Next
End If
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的,确保它在一张卡片里
'实际添加
For Each Loader In Loaders
Dim TargetCard As String = Loader & VerName
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
Next
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of CompFile))
For Each Version As CompFile In Results
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
End If
Next
End If
'转化为 UI
Try
PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanResults.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(PageType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else
NewCard.IsSwapped = True
End If
'增加提示
If Pair.Key = "其他版本" Then
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
End If
Next
'如果只有一张卡片,展开第一张卡片
If PanResults.Children.Count = 1 Then
CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
End Try
End Sub
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
If Name Is Nothing Then
Return "其他版本"
ElseIf Name.Contains("w") Then
Return "快照版本"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
Return "远古版本"
Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
End If
End Function
#End Region
Private IsFirstInit As Boolean = True
Public Sub Init() Handles Me.PageEnter
AniControlEnabled += 1
Project = FrmMain.PageCurrent.Additional(0)
PanBack.ScrollToHome()
'重启加载器
If IsFirstInit Then
'在 Me.Initialized 已经初始化了加载器,不再重复初始化
IsFirstInit = False
Else
PageLoaderRestart(IsForceRestart:=True)
End If
'放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem)
'决定按钮显示
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
End Sub
'整合包安装
Public Sub Install_Click(sender As MyListItem, e As EventArgs)
Try
'获取基本信息
Dim File As CompFile = sender.Tag
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载:{Project.TranslatedName} "
'获取版本名
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Return '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'资源下载;整合包另存为
Public Shared CachedFolder As New Dictionary(Of CompType, String) '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = Nothing
Select Case File.Type
Case CompType.ModPack : Desc = "整合包"
Case CompType.Mod : Desc = "Mod "
Case CompType.ResourcePack : Desc = "资源包"
Case CompType.Shader : Desc = "光影包"
Case CompType.DataPack : Desc = "数据包"
End Select
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If File.Type <> CompType.ModPack Then
Dim SubFolder As String = Nothing
Select Case Project.Type
Case CompType.Mod : SubFolder = "mods\"
Case CompType.ResourcePack : SubFolder = "resourcepacks\"
Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录
End Select
Dim IsVersionSuitable As Func(Of McVersion, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of CompModLoaderType)
If File.ModLoaders.Any Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders.Any Then
AllowedLoaders = Project.ModLoaders
End If
Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求
IsVersionSuitable =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
'只对 Mod 和数据包进行版本检测
If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True
Return False
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(Project.Type) Then
DefaultFolder = CachedFolder(Project.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableVersions = McVersionList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
If SuitableVersions.Any Then
Dim SelectedVersion = SuitableVersions.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedVersion.FullName
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合此资源的版本!")
Else
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
End If
End If
End If
'获取基本信息
Dim FileName As String
If Project.TranslatedName = Project.RawName Then
FileName = File.FileName
Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Setup.Get("ToolDownloadTranslateV2")
Case 0
FileName = $"【{ChineseName}】{File.FileName}"
Case 1
FileName = $"[{ChineseName}] {File.FileName}"
Case 2
FileName = $"{ChineseName}-{File.FileName}"
Case 3
FileName = $"{File.FileName}-{ChineseName}"
Case Else
FileName = File.FileName
End Select
End If
RunInUi(
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(File.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(Project.Type) = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存资源文件失败", LogLevel.Feedback)
End Try
End Sub, "Download CompDetail Save")
End Sub
Private Sub BtnIntroWeb_Click(sender As Object, e As EventArgs) Handles BtnIntroWeb.Click
OpenWebsite(Project.Website)
End Sub
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
End Sub
End Class
@@ -0,0 +1,26 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadDataPack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="/worldgen" />
<local:MyComboBoxItem Content="科技" Tag="6951/technology" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="/storage" />
<local:MyComboBoxItem Content="魔法" Tag="6952/magic" />
<local:MyComboBoxItem Content="冒险" Tag="6948/adventure" />
<local:MyComboBoxItem Content="幻想" Tag="6949/" />
<local:MyComboBoxItem Content="装饰" Tag="/decoration" />
<local:MyComboBoxItem Content="生物" Tag="/mobs" />
<local:MyComboBoxItem Content="实用" Tag="6953/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="服务器" Tag="/social" />
<local:MyComboBoxItem Content="支持库" Tag="6950/library" />
<local:MyComboBoxItem Content="Mod 相关" Tag="6946/" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadDataPack
End Class
@@ -0,0 +1,35 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
<local:MyComboBoxItem Content="生物群系" Tag="407/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="矿物与资源" Tag="408/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412/technology" />
<local:MyComboBoxItem Content="管道与物流" Tag="415/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="自动化" Tag="4843/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="能源" Tag="417/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="红石" Tag="4558/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="食物与烹饪" Tag="436/food" />
<local:MyComboBoxItem Content="农业" Tag="416/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="414/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="420/storage" />
<local:MyComboBoxItem Content="魔法" Tag="419/magic" />
<local:MyComboBoxItem Content="冒险" Tag="422/adventure" />
<local:MyComboBoxItem Content="装饰" Tag="424/decoration" />
<local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="实用" Tag="5191/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadMod
End Class
@@ -0,0 +1,28 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" />
<local:MyComboBoxItem Tag="/optimization" Content="性能优化" />
<local:MyComboBoxItem Tag="4479/challenging" Content="硬核" />
<local:MyComboBoxItem Tag="4483/combat" Content="战斗" />
<local:MyComboBoxItem Tag="4478/quests" Content="任务" />
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="水槽包" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4474/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadPack
End Class
@@ -0,0 +1,45 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadResourcePack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版风" Tag="403/vanilla-like" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="写实风" Tag="400/realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="现代风" Tag="401/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="中世纪" Tag="402/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="蒸汽朋克" Tag="399/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="主题化" Tag="/themed" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="简洁" Tag="/simplistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="装饰" Tag="/decoration" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="战斗" Tag="/combat" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="实用" Tag="/utility" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="改良" Tag="/tweaks" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="鬼畜" Tag="/cursed" />
<local:MyComboBoxItem Content="特性" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含实体" Tag="/entities" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含声音" Tag="/audio" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含字体" Tag="5244/fonts" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含模型" Tag="/models" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含语言" Tag="/locale" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含 UI" Tag="/gui" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="核心着色器" Tag="/core-shaders" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="动态效果" Tag="404/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="兼容 Mod" Tag="4465/modded" />
<local:MyComboBoxItem Content="分辨率" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="8x 或更低" Tag="/8x-" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="16x" Tag="393/16x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="32x" Tag="394/32x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="48x" Tag="/48x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="64x" Tag="395/64x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="128x" Tag="396/128x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="256x" Tag="397/256x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="512x 或更高" Tag="398/512x+" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadResourcePack
End Class
@@ -0,0 +1,34 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadShader"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版风" Tag="6555/vanilla-like" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="幻想风" Tag="6554/fantasy" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="写实风" Tag="6553/realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="半写实风" Tag="/semi-realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="卡通风" Tag="/cartoon" />
<local:MyComboBoxItem Content="特性" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="彩色光照" Tag="/colored-lighting" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="路径追踪" Tag="/path-tracing" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="PBR" Tag="/pbr" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="反射" Tag="/reflections" />
<local:MyComboBoxItem Content="性能负荷" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="极低" Tag="/potato" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="低" Tag="/low" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="中" Tag="/medium" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="高" Tag="/high" />
<local:MyComboBoxItem Content="加载器" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版可用" Tag="/vanilla" ToolTip="作为资源包加载,可以直接在原版游戏里使用。" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="Iris" Tag="/iris" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="OptiFine" Tag="/optifine" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadShader
End Class
File diff suppressed because it is too large. Load diff
@@ -1,31 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<!--<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="自动安装提示" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,2" Text="本页只提供需要在下载后手动进行安装的游戏 jar 与 json 下载。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,11" Text="如果你想要进行自动安装,在游戏安装页选择游戏版本,然后直接安装即可。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnInstall" Grid.Column="1" MinWidth="140" Text="转到游戏安装页" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
</StackPanel>
</local:MyCard>-->
<StackPanel Name="PanMain" Margin="20,20,20,5" Grid.IsSharedSizeScope="True" />
</StackPanel>
</local:MyScrollViewer>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40,0" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</Grid>
</local:MyPageRight>
@@ -1,106 +0,0 @@
Public Class PageDownloadClient
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict As New Dictionary(Of String, List(Of JObject)) From {
{"正式版", New List(Of JObject)}, {"预览版", New List(Of JObject)}, {"远古版", New List(Of JObject)}, {"愚人节版", New List(Of JObject)}
}
Dim Versions As JArray = DlClientListLoader.Output.Value("versions")
For Each Version As JObject In Versions
'确定分类
Dim Type As String = Version("type")
Select Case Type
Case "release"
Type = "正式版"
Case "snapshot"
Type = "预览版"
'Mojang 误分类
If Version("id").ToString.StartsWith("1.") AndAlso
Not Version("id").ToString.ToLower.Contains("combat") AndAlso
Not Version("id").ToString.ToLower.Contains("rc") AndAlso
Not Version("id").ToString.ToLower.Contains("experimental") AndAlso
Not Version("id").ToString.ToLower.Contains("pre") Then
Type = "正式版"
Version("type") = "release"
End If
'愚人节版本
Select Case Version("id").ToString.ToLower
Case "20w14infinite", "20w14∞"
Type = "愚人节版"
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
End Select
Case "special"
'已被处理的愚人节版
Type = "愚人节版"
Case Else
Type = "远古版"
End Select
'加入辞典
Dict(Type).Add(Version)
Next
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next
'清空当前
PanMain.Children.Clear()
'添加最新版本
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
MyCard.StackInstall(PanInfo, 2)
CardInfo.Children.Add(PanInfo)
PanMain.Children.Add(CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, sender.Title, sender.Tag("url").ToString)
End Sub
''介绍栏
'Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
' OpenWebsite("https://www.minecraft.net/zh-hans")
'End Sub
'Private Sub BtnInstall_Click(sender As Object, e As EventArgs) Handles BtnInstall.Click
' FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
'End Sub
End Class
Loaded 100 of 199 files, more files were not shown because too many files have changed in this diff. Show more