This commit is contained in:
龙腾猫跃
2023-02-16 22:21:04 +08:00
parent a9bf0b682a
commit 6dc8789ac0
32 changed files with 3605 additions and 2453 deletions
@@ -690,7 +690,7 @@ Public Module ModDownloadLib
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion),
If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion)),
.Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
}
AddHandler NewItem.Click, OnClick
@@ -1730,22 +1730,22 @@ Public Module ModDownloadLib
'结束
Return NewItem
End Function
Public Function FabricApiDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.ReleaseTypeString & ",发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"),
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
Return NewItem
End Function
Public Function OptiFabricDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.ReleaseTypeString & ",发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"),
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/OptiFabric.png"
}
AddHandler NewItem.Click, OnClick
@@ -1804,12 +1804,12 @@ Public Module ModDownloadLib
''' <summary>
''' 欲下载的 Fabric API 信息。
''' </summary>
Public FabricApi As DlCfFile = Nothing
Public FabricApi As CompFile = Nothing
''' <summary>
''' 欲下载的 OptiFabric 信息。
''' </summary>
Public OptiFabric As DlCfFile = Nothing
Public OptiFabric As CompFile = Nothing
''' <summary>
''' 欲下载的 LiteLoader 详细信息。
@@ -1962,11 +1962,11 @@ Public Module ModDownloadLib
Dim LoaderList As New List(Of LoaderBase)
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
@@ -2112,7 +2112,7 @@ Public Module ModDownloadLib
SplitArguments.Add(RawArguments(i))
End If
Next
Dim RealArguments As String = Join(ArrayNoDouble(SplitArguments), " ")
Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ")
'合并
OutputJson = MinecraftJson
If HasOptiFine Then
@@ -1,45 +0,0 @@
<Grid x:Class="MyCfItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" Height="57"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="9" />
<ColumnDefinition Width="1*"/>
<ColumnDefinition Width="Auto"/>
<ColumnDefinition Width="7" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="17" />
<RowDefinition Height="14" />
<RowDefinition Height="14" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!--<Rectangle Height="45" Width="45" RadiusX="4" RadiusY="4" Fill="White" Grid.Column="1" Grid.Row="1" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="False" Grid.RowSpan="3" />-->
<Border Height="45" Width="45" Grid.Column="1" Grid.Row="1" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True" Grid.RowSpan="3">
<Border.Clip>
<RectangleGeometry Rect="0,0,45,45" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
</Border>
<TextBlock x:Name="LabTitle" Grid.Row="1" Grid.Column="3" Grid.ColumnSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False"
Margin="0,0,0,1" HorizontalAlignment="Left" VerticalAlignment="Center" TextTrimming="CharacterEllipsis"
FontSize="14" Foreground="{StaticResource ColorBrush1}" />
<TextBlock x:Name="LabLeft" Grid.Row="2" Grid.Column="3" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False"
HorizontalAlignment="Left" VerticalAlignment="Center" TextTrimming="CharacterEllipsis"
FontSize="12" Foreground="{StaticResource ColorBrushGray3}" />
<!--<TextBlock x:Name="LabRight" Grid.Row="2" Grid.Column="4" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False"
HorizontalAlignment="Right" VerticalAlignment="Center" TextTrimming="CharacterEllipsis"
FontSize="12" Foreground="{StaticResource ColorBrushGray3}" />-->
<TextBlock x:Name="LabInfo" Grid.Row="3" Grid.Column="3" Grid.ColumnSpan="2" IsHitTestVisible="True" SnapsToDevicePixels="False" UseLayoutRounding="False"
HorizontalAlignment="Left" VerticalAlignment="Center" TextTrimming="CharacterEllipsis"
FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
ToolTipService.InitialShowDelay="80" ToolTipService.Placement="Relative" ToolTipService.PlacementRectangle="-8,-6,500,10000">
<TextBlock.ToolTip>
<ToolTip x:Name="ToolTipInfo" Style="{StaticResource ExtendTextToolTip}" />
</TextBlock.ToolTip>
</TextBlock>
</Grid>
@@ -1,199 +0,0 @@
Public Class MyCfItem
Public Uuid As Integer = GetUuid()
#Region "Logo"
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "CurseForge Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载 CurseForge 工程图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化 CurseForge 工程图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[Download] 已清理损坏的 CurseForge 工程图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的 CurseForge 工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载 CurseForge 工程图标失败(" & value & ")")
End Try
End Set
End Property
Private Sub LogoLoader(Address As String)
Dim Retry As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
NetDownload(_Logo, Address & DownloadEnd)
RunInUiWait(Sub()
Try
'在地址更换时取消加载
If Not Address = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(Address & DownloadEnd)
Catch ex As Exception
Log(ex, "读取 CurseForge 工程图标失败(" & Address & ")", LogLevel.Hint)
End Try
End Sub)
If File.Exists(Address) Then
File.Delete(Address & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(Address & DownloadEnd, Address)
End If
Catch ex As Exception
If Not Retry Then
Retry = True
GoTo RetryStart
Else
Log(ex, "下载 CurseForge 工程图标失败")
End If
End Try
End Sub
#End Region
#Region "点击"
'触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
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
Log("[Control] 按下 CurseForge 工程列表项:" & LabTitle.Text)
End If
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseOver Then IsMouseDown = True
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
End Sub
#End Region
#Region "后加载指向背景"
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(3),
.RenderTransform = New ScaleTransform(0.8, 0.8),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
#End Region
Private StateLast As String
Public HasAnimation As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
If Not HasAnimation Then Exit Sub
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
If IsMouseDown Then
StateNew = "MouseDown"
Time = 120
Else
StateNew = "MouseOver"
Time = 120
End If
Else
StateNew = "Idle"
Time = 180
End If
If StateLast = StateNew Then Exit Sub
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
Dim Ani As New List(Of AniData)
If IsMouseOver Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "CfItem Color " & Uuid)
Else
'无动画
AniStop("CfItem Color " & Uuid)
If _RectBack IsNot Nothing Then RectBack.Opacity = 0
End If
End Sub
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
End Class
@@ -2,7 +2,7 @@
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="PageDownloadCfDetail"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
d:DesignWidth="778.571" d:DesignHeight="90.857">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
@@ -14,9 +14,9 @@
<local:MyCard Margin="0,0,0,25" x:Name="CardIntro">
<StackPanel Margin="22,22,22,19" x:Name="PanIntro">
<StackPanel Orientation="Horizontal" Height="35">
<local:MyButton x:Name="BtnIntroCf" MinWidth="140" Text="查看 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="查看百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="查看 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroWeb" MinWidth="140" Text="转到 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="转到 MC 百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="转到 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroCopy" MinWidth="140" Text="复制名称" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</StackPanel>
</StackPanel>
@@ -1,25 +1,25 @@
Public Class PageDownloadCfDetail
Private CfItem As MyCfItem = Nothing
Private Project As DlCfProject
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
Private Project As CompProject
#Region "加载器"
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
"Comp File", Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet(Project.Id, Project.FromCurseForge))
'初始化加载器信息
Private Sub PageDownloadCfDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Project = FrmMain.PageCurrent.Additional
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, DlCfFileLoader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Function LoaderInput() As KeyValuePair(Of Integer, Boolean)
Return New KeyValuePair(Of Integer, Boolean)(Project.Id, Project.IsModPack)
End Function
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case DlCfFileLoader.State
Select Case CompFileLoader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的 Mod 列表 Json 文件损坏,已自动重试", LogLevel.Debug)
Log("[Comp] 下载的文件 Json 列表损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
@@ -42,38 +42,42 @@
'初始化字典,并将当前版本排在最上面
Dim TopVersion As String
If Project.IsModPack Then
TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Else
TopVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
End If
Dim Dict As New SortedDictionary(Of String, List(Of DlCfFile))(New VersionSorterWithSelect(TopVersion))
'PCL#8826 汇报了奇怪的这个 Try 块里出现 NPE 的问题,但实在找不到,就瞎加点检测
Select Case Project.Type
Case CompType.Mod
TopVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
Case CompType.ModPack
TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TopVersion = Nothing 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TopVersion))
'#8826 汇报了奇怪的这个 Try 块里出现 NPE 的问题,但实在找不到,就瞎加点检测
Try
Dict.Add("未知版本", New List(Of DlCfFile))
If DlCfFileLoader.Output Is Nothing Then
Log("[Download] 列表加载输出为 Nothing,请反馈此问题", LogLevel.Feedback)
Dict.Add("未知版本", New List(Of CompFile))
If CompFileLoader.Output Is Nothing Then
Log("[Comp] 列表加载输出为 Nothing,请反馈此问题", LogLevel.Feedback)
Exit Try
End If
For Each Version As DlCfFile In DlCfFileLoader.Output
For Each Version As CompFile In CompFileLoader.Output
If Version Is Nothing Then
Log("[Download] 列表中的一个版本为 Nothing,请反馈此问题", LogLevel.Feedback)
Log("[Comp] 列表中的一个版本为 Nothing,请反馈此问题", LogLevel.Feedback)
Continue For
End If
If Version.GameVersion Is Nothing Then
Log("[Download] 列表中的一个版本没有任何适配的游戏版本,返回为 Nothing,请反馈此问题", LogLevel.Feedback)
Continue For
End If
For Each GameVersion In Version.GameVersion
For Each GameVersion In Version.GameVersions
'决定添加到哪个版本
Dim TargetVersion As String
If GameVersion Is Nothing OrElse GameVersion.Split(".").Count < 2 Then
If GameVersion Is Nothing Then
TargetVersion = "未知版本"
Else
ElseIf GameVersion.Contains("w") Then
TargetVersion = "快照版本"
ElseIf GameVersion.Split(".").Count >= 2 Then
TargetVersion = GameVersion
Else
TargetVersion = "未知版本"
End If
'实际进行添加
If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of DlCfFile))
If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of CompFile))
If Not Dict(TargetVersion).Contains(Version) Then Dict(TargetVersion).Add(Version)
Next
Next
@@ -86,17 +90,17 @@
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlCfFile)) In Dict
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Pair.Value.Count = 0 Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.IsModPack, 9, 8)}
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
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
PanMain.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TopVersion Then
MyCard.StackInstall(NewStack, If(Project.IsModPack, 9, 8), Pair.Key)
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
Else
NewCard.IsSwaped = True
End If
@@ -133,14 +137,15 @@
End If
'放置当前工程
If CfItem IsNot Nothing Then PanIntro.Children.Remove(CfItem)
CfItem = Project.ToCfItem(True, True)
CfItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CfItem)
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
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)
BtnIntroMCBBS.Visibility = If(Project.MCBBS Is Nothing, Visibility.Collapsed, Visibility.Visible)
BtnIntroMCBBS.Visibility = If(Project.MCBBS = 0, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
End Sub
@@ -150,11 +155,11 @@
Try
'获取基本信息
Dim File As DlCfFile = sender.Tag
Dim LoaderName As String = "CurseForge 整合包下载:" & Project.ChineseName & " "
Dim File As CompFile = sender.Tag
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载:{Project.TranslatedName} "
'获取版本名
Dim PackName As String = Project.ChineseName.Replace(".zip", "").Replace(".rar", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
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})
@@ -162,15 +167,15 @@
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
Dim LogoFileAddress As String = PathTemp & "CFLogo\" & GetHash(CfItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
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()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
@@ -190,60 +195,54 @@
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载 CurseForge 整合包失败", LogLevel.Feedback)
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'Mod 下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
Dim Desc As String = If(Project.Type = CompType.ModPack, "整合包", If(Project.Type = CompType.Mod, "Mod ", "资源包"))
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Count > 0 Then '从文件中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In File.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In Project.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
AllowFabric IsNot Nothing AndAlso Not AllowFabric Then
AllowForge = Nothing : AllowFabric = Nothing
End If
Log("[Download] 允许 Forge:" & If(AllowForge, "未知") & ",允许 Fabric:" & If(AllowFabric, "未知"))
Log("[Comp] 允许 Forge:" & If(AllowForge, "未知") & ",允许 Fabric:" & If(AllowFabric, "未知"))
'判断某个版本是否符合要求
Dim IsVersionSuitable As Func(Of McVersion, Boolean) =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
Function(Version)
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
'获取 Mod 默认下载位置
If CachedFolder IsNot Nothing Then
DefaultFolder = CachedFolder
Log("[Download] 使用上次下载时的文件夹作为默认下载位置")
Log("[Comp] 使用上次下载时的文件夹作为默认下载位置")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用当前版本的 mods 文件夹作为默认下载位置(" & McVersionCurrent.Name & ")")
Log("[Comp] 使用当前版本的 mods 文件夹作为默认下载位置(" & McVersionCurrent.Name & ")")
Else
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
@@ -259,7 +258,7 @@
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
Else
Log("[Download] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
@@ -268,13 +267,13 @@
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
End If
End If
End If
'获取基本信息
Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim ChineseName As String = If(Project.TranslatedName = Project.RawName, "",
Project.TranslatedName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
@@ -290,17 +289,17 @@
Sub()
'弹窗要求选择保存位置
Dim Target As String
If File.FileName.EndsWith(".litemod") Then
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
Else
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
End If
Target = SelectAs("选择保存位置", FileName,
Desc & "文件|" &
If(Project.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
If Target <> DefaultFolder AndAlso Not Project.IsModPack Then CachedFolder = GetPathFromFullPath(Target)
If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
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 DownloadStateSave}
Loader.Start(1)
@@ -309,12 +308,12 @@
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
Log(ex, "保存资源文件失败", LogLevel.Feedback)
End Try
End Sub, "Download CFDetail Save")
End Sub, "Download CompDetail Save")
End Sub
Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.Click
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
@@ -324,7 +323,7 @@
OpenWebsite("https://www.mcbbs.net/thread-" & Project.MCBBS & "-1-1.html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CfItem.LabTitle.Text)
ClipboardSet(CompItem.LabTitle.Text)
End Sub
End Class
@@ -232,7 +232,7 @@
End Sub
'FabricApi
Private SelectedFabricApi As DlCfFile = Nothing
Private SelectedFabricApi As CompFile = Nothing
Private Sub SetFabricApiInfoShow(IsShow As String)
If PanFabricApiInfo.Tag = IsShow Then Exit Sub
PanFabricApiInfo.Tag = IsShow
@@ -252,7 +252,7 @@
End Sub
'OptiFabric
Private SelectedOptiFabric As DlCfFile = Nothing
Private SelectedOptiFabric As CompFile = Nothing
Private Sub SetOptiFabricInfoShow(IsShow As String)
If PanOptiFabricInfo.Tag = IsShow Then Exit Sub
PanOptiFabricInfo.Tag = IsShow
@@ -591,18 +591,23 @@
End If
'检查最低 Forge 版本
Dim MinimalForgeVersion As String = "9999.9999"
Dim NotSuitForForge As Boolean = False
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本
If SelectedForge Is Nothing OrElse IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then
Return Nothing
If SelectedForge Is Nothing Then Return Nothing '该版本可用
If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then
Return Nothing '该版本可用
Else
'设置用于显示的最低 Forge 版本
MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion),
OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion)
NotSuitForForge = True
If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then
'设置用于显示的最低允许的 Forge 版本
MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion),
OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion)
End If
End If
Next
If MinimalForgeVersion = "9999.9999" Then
Return "没有可用版本"
Return If(NotSuitForForge, "与 Forge 不兼容", "没有可用版本")
Else
Return "需要 Forge " & If(MinimalForgeVersion.Contains("."), "", "#") & MinimalForgeVersion & " 或更高版本"
End If
@@ -611,6 +616,7 @@
'检查某个 OptiFine 是否与某个 Forge 兼容(最低 Forge 版本是否达到需求)
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
@@ -749,13 +755,21 @@
End If
End If
If Loader.State <> LoadState.Finished Then Return "获取版本列表失败:未知错误,状态为 " & GetStringFromEnum(Loader.State)
Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 OptiFine 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
Return "与 OptiFine 不兼容" '1.13 ~ 1.14.3 OptiFine 检查
End If
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then
NotSuitForOptiFine = True '与 OptiFine 不兼容
Continue For
End If
Return Nothing
Next
Return "该版本不支持自动安装"
Return If(NotSuitForOptiFine, "与 OptiFine 不兼容", "该版本不支持自动安装")
End Function
'限制展开
@@ -772,18 +786,19 @@
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub
'可视化
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean
Return New Version(Left.Version) > New Version(Right.Version)
End Function)
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then Continue For
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
@@ -941,7 +956,7 @@
If DlFabricApiLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing Then Exit Sub
'获取版本列表
Dim Versions As New List(Of DlCfFile)
Dim Versions As New List(Of CompFile)
For Each Version In DlFabricApiLoader.Output
If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then
If Not Version.DisplayName.StartsWith("[") Then
@@ -953,8 +968,8 @@
Next
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
Versions = Sort(Versions, Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
'可视化
PanFabricApi.Children.Clear()
@@ -987,10 +1002,10 @@
''' <summary>
''' 从显示名判断该 Mod 是否与某版本适配。
''' </summary>
Private Function IsSuitableOptiFabric(ModFile As DlCfFile, MinecraftVersion As String) As Boolean
Private Function IsSuitableOptiFabric(ModFile As CompFile, MinecraftVersion As String) As Boolean
Try
If MinecraftVersion Is Nothing Then Return False
Return ModFile.GameVersion.Contains(MinecraftVersion)
Return ModFile.GameVersions.Contains(MinecraftVersion)
Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错(" & MinecraftVersion & ")")
Return False
@@ -1026,14 +1041,14 @@
If DlOptiFabricLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Exit Sub
'获取版本列表
Dim Versions As New List(Of DlCfFile)
Dim Versions As New List(Of CompFile)
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
Versions = Sort(Versions, Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
'可视化
PanOptiFabric.Children.Clear()
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="游戏组件" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z">
<local:MyListItem.Buttons>
@@ -59,7 +59,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="CurseForge" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
@@ -97,9 +97,11 @@
DlOptiFabricLoader.Start(IsForceRestart:=True)
ItemInstall.Checked = True
Case FormMain.PageSubType.DownloadMod
PageDownloadMod.Storage = New CompProjectStorage
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
@@ -26,27 +26,32 @@
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="10" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="1" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部" Tag="0" IsSelected="True" />
<local:MyComboBoxItem Content="世界生成" Tag="406" />
<local:MyComboBoxItem Content="生物群系" Tag="407" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="生物" Tag="411" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412" />
<local:MyComboBoxItem Content="交通与移动" Tag="414" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="管道与物流" Tag="415" 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="420" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="农业" Tag="416" />
<local:MyComboBoxItem Content="食物" Tag="436" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="魔法" Tag="419" />
<local:MyComboBoxItem Content="装备与工具" Tag="434" />
<local:MyComboBoxItem Content="冒险与探索" Tag="422" />
<local:MyComboBoxItem Content="建筑与装饰" Tag="424" />
<local:MyComboBoxItem Content="信息显示" Tag="423" />
<local:MyComboBoxItem Content="支持库" Tag="421" />
<local:MyComboBoxItem Content="服务器" Tag="435" />
<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="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="多人" Tag="435/social" />
<local:MyComboBoxItem Content="改良" Tag="5191/utility" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
@@ -88,9 +93,21 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardProjects" Title="热门 Mod">
<StackPanel x:Name="PanProjects" Margin="20,40,18,20" />
</local:MyCard>
<StackPanel x:Name="PanContent">
<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="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 Mod 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
@@ -1,46 +1,61 @@
Public Class PageDownloadMod
'初始化加载器信息
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject Mod", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize)
If FrmDownloadMod IsNot Nothing AndAlso FrmDownloadMod.IsLoaded Then
Return New DlCfProjectRequest With {
.SearchFilter = FrmDownloadMod.TextSearchName.Text,
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing),
.CategoryId = Val(FrmDownloadMod.ComboSearchTag.SelectedItem.Tag),
.IsModPack = False,
With Request
.SearchText = FrmDownloadMod.TextSearchName.Text
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing)
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
} '处理列表加载失败后的点击加载器重试
Else
Return New DlCfProjectRequest With {.IsModPack = False}
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
'列表项
PanProjects.Children.Clear()
If Loader.Input.SearchFilter = "" Then
CardProjects.Title = "热门 Mod"
Else
CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")"
End If
For Each Project In Loader.Output.Projects
PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick))
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(Loader.Input.GameVersion Is Nothing,
Loader.Input.ModLoader = CompModLoaderType.Any, AddressOf ProjectClick))
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
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.5)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化 Mod 列表出错", 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 DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的 Mod 列表 Json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
@@ -50,18 +65,43 @@
'进入详情页面
Public Sub ProjectClick(sender As MyCfItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag})
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'搜索
'切换页码
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartSearch()
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Shared Sub StartSearch() Handles BtnSearchRun.Click
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] Mod 切换到第 {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
Storage = New CompProjectStorage
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.SelectedIndex = 0
@@ -70,6 +110,8 @@
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
'版本选择
Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged
If TextSearchVersion.Text = "" Then
ComboSearchLoader.Visibility = Visibility.Collapsed
@@ -81,4 +123,6 @@
End If
End Sub
#End Region
End Class
@@ -25,24 +25,25 @@
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="10" HintText="仅支持使用英文搜索" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="1" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部" Tag="0" IsSelected="True" />
<local:MyComboBoxItem IsHitTestVisible="False" Content="规格" />
<local:MyComboBoxItem Tag="4481" Content="小型整合" Margin="15,0,0,0" />
<local:MyComboBoxItem Tag="4482" Content="大型整合" Margin="15,0,0,0" />
<local:MyComboBoxItem IsHitTestVisible="False" Content="特殊" />
<local:MyComboBoxItem Tag="4487" Content="FTB" Margin="15,0,0,0" ToolTip="该整合包由 FTB 官方发布" />
<local:MyComboBoxItem Tag="4480" Content="基于地图" Margin="15,0,0,0" ToolTip="该整合包基于已有的 Minecraft 游戏地图运行" />
<local:MyComboBoxItem Tag="4479" Content="硬核" />
<local:MyComboBoxItem Tag="4474" Content="科幻" />
<local:MyComboBoxItem Tag="4483" Content="战斗" />
<local:MyComboBoxItem Tag="4478" Content="任务" />
<local:MyComboBoxItem Tag="4484" Content="多人" />
<local:MyComboBoxItem Tag="4476" Content="探索" />
<local:MyComboBoxItem Tag="4736" Content="空岛" />
<local:MyComboBoxItem Tag="4475" Content="冒险" />
<local:MyComboBoxItem Tag="4472" Content="科技" />
<local:MyComboBoxItem Tag="4473" Content="魔法" />
<local:MyComboBoxItem Tag="4477" Content="小游戏" />
<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="4471/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="该整合包由 FTB 官方发布" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
@@ -81,9 +82,21 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardProjects" Title="热门整合包">
<StackPanel x:Name="PanProjects" Margin="20,40,18,20" />
</local:MyCard>
<StackPanel x:Name="PanContent">
<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="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取整合包列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
@@ -1,45 +1,59 @@
Public Class PageDownloadPack
'初始化加载器信息
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject ModPack", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject ModPack", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.ModPack, Storage, (Page + 1) * PageSize)
If FrmDownloadPack IsNot Nothing AndAlso FrmDownloadPack.IsLoaded Then
Return New DlCfProjectRequest With {
.SearchFilter = FrmDownloadPack.TextSearchName.Text,
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing),
.CategoryId = Val(FrmDownloadPack.ComboSearchTag.SelectedItem.Tag),
.IsModPack = True
} '处理列表加载失败后的点击加载器重试
Else
Return New DlCfProjectRequest With {.IsModPack = True}
With Request
.SearchText = FrmDownloadPack.TextSearchName.Text
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing)
.Tag = FrmDownloadPack.ComboSearchTag.SelectedItem.Tag
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
'列表项
PanProjects.Children.Clear()
If Loader.Input.SearchFilter = "" Then
CardProjects.Title = "热门整合包"
Else
CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")"
End If
For Each Project In Loader.Output.Projects
PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick))
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(Loader.Input.GameVersion Is Nothing, True, AddressOf ProjectClick))
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
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.5)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化整合包列表出错", 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 DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的整合包列表 Json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
@@ -47,28 +61,49 @@
End Select
End Sub
Private Sub Load_OnStart()
PanLoad.Visibility = Visibility.Visible
AniStart({
AaOpacity(PanLoad, 1 - PanLoad.Opacity, 150),
AaOpacity(CardProjects, -CardProjects.Opacity, 150),
AaCode(Sub()
CardProjects.Visibility = Visibility.Collapsed
PanProjects.Children.Clear()
End Sub,, True)
}, "FrmDownloadPack Load Switch")
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
Public Sub ProjectClick(sender As MyCfItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag})
'切换页码
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] 整合包切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartSearch()
Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click
ModpackInstall()
End Sub
Private Shared Sub StartSearch() Handles BtnSearchRun.Click
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
Storage = New CompProjectStorage
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.SelectedIndex = 0
@@ -76,8 +111,7 @@
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click
ModpackInstall()
End Sub
#End Region
End Class