上传公开代码
This commit is contained in:
@@ -0,0 +1,200 @@
|
||||
Public Class MyCfItem
|
||||
Public Uuid As Integer = GetUuid()
|
||||
|
||||
#Region "Logo"
|
||||
|
||||
'Public CacheLogo As Boolean = True '是否缓存 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", "ColorBrush9"), 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
|
||||
Reference in New Issue
Block a user