Public Class MyCompItem #Region "基础属性" Public Uuid As Integer = GetUuid() 'Logo Public Property Logo As String Get Return PathLogo.Source End Get Set(value As String) PathLogo.Source = value End Set End Property '标题 Public Property Title As String Get Return LabTitle.Text End Get Set(value As String) If LabTitle.Text = value Then Exit Property LabTitle.Text = value End Set End Property '副标题 Public Property SubTitle As String Get Return If(LabTitleRaw?.Text, "") End Get Set(value As String) If LabTitleRaw.Text = value Then Exit Property LabTitleRaw.Text = value LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) End Set End Property '描述 Public Property Description As String Get Return LabInfo.Text End Get Set(value As String) If LabInfo.Text = value Then Exit Property LabInfo.Text = value End Set End Property '指向时扩展描述 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 'Tag Public WriteOnly Property Tags As List(Of String) Set(value As List(Of String)) PanTags.Children.Clear() PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) For Each TagText In value Dim NewTag = GetObjectFromXML( " ") PanTags.Children.Add(NewTag) Next End Set End Property #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] 按下资源工程列表项:" & LabTitle.Text) End If End Sub 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.PanResults.Children If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title) Next Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles)) FrmMain.PageCurrent.Additional(1) = Titles End If '打开详情页 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) End If FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader, TargetType}}) End Sub '鼠标点击判定 Private IsMouseDown As Boolean = False Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown If IsMouseOver AndAlso CanInteraction 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 ' End If Return _RectBack End Get End Property #End Region Private StateLast As String ''' ''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。 ''' 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 '判断当前颜色 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, "CompItem Color " & Uuid) Else '无动画 AniStop("CompItem Color " & Uuid) If _RectBack IsNot Nothing Then RectBack.Opacity = 0 End If End Sub End Class