2.8.9

2024-10-16 03:24:00 +08:00
parent fb1caf0c8f
commit c5ae532fd5
49 changed files with 1881 additions and 1401 deletions
@@ -1,7 +1,7 @@
-Public Class MyImage
+Public Class MyImage
    Inherits Image

-#Region "辅助属性注册"
+#Region "公开属性"

    ''' <summary>
    ''' 网络图片的缓存有效期。
@@ -22,14 +22,6 @@ Public Class MyImage
    End Property
    Private _EnableCache As Boolean = True

-    '将 Source 属性映射到 XAML
-    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())))
-
-#End Region
-
-    Private _Source As String = ""
    ''' <summary>
    ''' 与 Image 的 Source 类似。
    ''' 若输入以 http 开头的字符串，则会尝试下载图片然后显示，图片会保存为本地缓存。
@@ -43,74 +35,150 @@ Public Class MyImage
            If value = "" Then value = Nothing
            If _Source = value Then Exit Property
            _Source = value
-            Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(value)}.png"
+            If Not IsInitialized Then Exit Property '属性读取顺序修正：在完成 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 Exit Property
+            _ActualSource = value
            Try
-                '空
-                If value Is Nothing Then
-                    MyBase.Source = Nothing
-                    Exit Property
-                End If
-                '本地图片
-                If Not value.StartsWithF("http") Then
-                    MyBase.Source = New MyBitmap(value)
-                    Exit Property
-                End If
-                '从缓存加载网络图片
-                If EnableCache AndAlso File.Exists(TempPath) Then
-                    MyBase.Source = New MyBitmap(TempPath)
-                    If (Date.Now - File.GetCreationTime(TempPath)) < FileCacheExpiredTime Then
-                        Exit Property '无需刷新缓存
-                    Else
-                        File.Delete(TempPath) '需要刷新缓存
-                    End If
-                Else
-                    MyBase.Source = Nothing '清空显示
-                End If
-                '下载网络图片
-                RunInNewThread(
-                Sub()
-                    Dim Url As String = value '重新捕获变量，以检测在下载过程中 Source 被修改的情况
-                    Dim Retried As Boolean = False
-RetryStart:
-                    Dim TempDownloadingPath As String = TempPath & RandomInteger(0, 10000000)
-                    Try
-                        Log("[MyImage] 正在下载图片：" & Url)
-                        NetDownload(Url, TempDownloadingPath, True)
-                        If Url <> Source Then
-                            '若 Source 在下载时被修改，则不显示
-                            File.Delete(TempDownloadingPath)
-                        ElseIf EnableCache Then
-                            '保存缓存并显示
-                            Rename(TempDownloadingPath, TempPath)
-                            RunInUi(Sub() MyBase.Source = New MyBitmap(TempPath))
-                        Else
-                            '直接显示
-                            RunInUiWait(Sub() MyBase.Source = New MyBitmap(TempDownloadingPath))
-                            File.Delete(TempDownloadingPath)
-                        End If
-                    Catch ex As Exception
-                        Try
-                            File.Delete(TempDownloadingPath)
-                        Catch
-                        End Try
-                        If Not Retried Then
-                            Log(ex, $"下载图片可重试地失败（{Url}）", LogLevel.Developer)
-                            Retried = True
-                            Thread.Sleep(1000)
-                            GoTo RetryStart
-                        Else
-                            Log(ex, $"下载图片失败（{Url}）", LogLevel.Hint)
-                        End If
-                    End Try
-                End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
+                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}）", LogLevel.Hint)
+                Log(ex, $"加载图片失败（{value}）")
                Try
-                    File.Delete(TempPath) '删除缓存，以免缓存出现问题导致一直加载失败
+                    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

-End Class
+    Private Sub Load() _
+        Handles Me.Initialized '属性读取顺序修正：在完成 XAML 属性读取后再触发图片加载（#4868）
+        '空
+        If Source Is Nothing Then
+            ActualSource = Nothing
+            Exit Sub
+        End If
+        '本地图片
+        If Not Source.StartsWithF("http") Then
+            ActualSource = Source
+            Exit Sub
+        End If
+        '从缓存加载网络图片
+        Dim Url As String = Source
+        Dim Retried As Boolean = False
+        Dim TempPath As String = GetTempPath(Url)
+        Dim TempFile As New FileInfo(TempPath)
+        If EnableCache AndAlso TempFile.Exists Then
+            ActualSource = TempPath
+            If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
+        End If
+        RunInNewThread(
+        Sub()
+            Dim TempDownloadingPath As String = Nothing
+            Try
+RetryStart:
+                '下载
+                ActualSource = LoadingSource '显示加载中图片
+                TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
+                NetDownload(Url, TempDownloadingPath, True)
+                If Url <> Source AndAlso Url <> FallbackSource Then
+                    '已经更换了地址
+                    File.Delete(TempDownloadingPath)
+                ElseIf EnableCache Then
+                    '保存缓存并显示
+                    If File.Exists(TempPath) Then File.Delete(TempPath)
+                    Rename(TempDownloadingPath, TempPath)
+                    RunInUi(Sub() ActualSource = TempPath)
+                Else
+                    '直接显示
+                    RunInUiWait(Sub() ActualSource = TempDownloadingPath)
+                    File.Delete(TempDownloadingPath)
+                End If
+            Catch ex As Exception
+                Try
+                    If TempPath IsNot Nothing Then File.Delete(TempPath)
+                    If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
+                Catch
+                End Try
+                If Not Retried Then
+                    '更换备用地址
+                    Log(ex, $"下载图片可重试地失败（{Url}）", LogLevel.Developer)
+                    Retried = True
+                    Url = If(FallbackSource, Source)
+                    '空
+                    If Url Is Nothing Then
+                        ActualSource = Nothing
+                        Exit Sub
+                    End If
+                    '本地图片
+                    If Not Url.StartsWithF("http") Then
+                        ActualSource = Url
+                        Exit Sub
+                    End If
+                    '从缓存加载网络图片
+                    TempPath = GetTempPath(Url)
+                    TempFile = New FileInfo(TempPath)
+                    If EnableCache AndAlso TempFile.Exists() Then
+                        ActualSource = TempPath
+                        If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
+                    End If
+                    '下载
+                    If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
+                    GoTo RetryStart
+                Else
+                    Log(ex, $"下载图片失败（{Url}）", LogLevel.Hint)
+                End If
+            End Try
+        End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
+    End Sub
+    Public Shared Function GetTempPath(Url As String) As String
+        Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
+    End Function
+
+End Class
@@ -212,33 +212,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 {
@@ -327,8 +320,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)
@@ -157,9 +157,7 @@
        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)))

    '点击事件

@@ -117,9 +117,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
@@ -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