MyCard.vb 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359
  1. Public Class MyCard
  2. '控件
  3. Inherits Grid
  4. Private ReadOnly MainGrid As Grid
  5. Public ReadOnly Property MainChrome As MyDropShadow
  6. Private ReadOnly MainBorder As Border
  7. Public Property BorderChild As UIElement
  8. Get
  9. Return MainBorder.Child
  10. End Get
  11. Set(value As UIElement)
  12. MainBorder.Child = value
  13. End Set
  14. End Property
  15. Private _MainTextBlock As TextBlock
  16. Public Property MainTextBlock As TextBlock
  17. Get
  18. Init() '当父级触发 Loaded 时,本卡片可能尚未触发 Loaded(该事件从父级向子级调用),因此这会是 null。手动触发以确保控件已加载。
  19. Return _MainTextBlock
  20. End Get
  21. Set(value As TextBlock)
  22. _MainTextBlock = value
  23. End Set
  24. End Property
  25. Private _MainSwap As Shapes.Path
  26. Public Property MainSwap As Shapes.Path
  27. Get
  28. Init()
  29. Return _MainSwap
  30. End Get
  31. Set(value As Shapes.Path)
  32. _MainSwap = value
  33. End Set
  34. End Property
  35. '属性
  36. Public Uuid As Integer = GetUuid()
  37. Public ReadOnly Property Inlines As InlineCollection
  38. Get
  39. Return MainTextBlock.Inlines
  40. End Get
  41. End Property
  42. Public Property CornerRadius As CornerRadius
  43. Get
  44. Return MainChrome.CornerRadius
  45. End Get
  46. Set(value As CornerRadius)
  47. MainChrome.CornerRadius = value
  48. MainBorder.CornerRadius = value
  49. End Set
  50. End Property
  51. Public Property Title As String
  52. Get
  53. Return GetValue(TitleProperty)
  54. End Get
  55. Set(value As String)
  56. SetValue(TitleProperty, value)
  57. If _MainTextBlock IsNot Nothing Then MainTextBlock.Text = value
  58. End Set
  59. End Property
  60. Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata(""))
  61. 'UI 建立
  62. Public Sub New()
  63. MainChrome = New MyDropShadow With {
  64. .Margin = New Thickness(-3, -3, -3, -3 - GetWPFSize(1)), .ShadowRadius = 3, .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius(5)}
  65. MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1")
  66. Children.Insert(0, MainChrome)
  67. MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(245, 255, 255, 255)), .CornerRadius = New CornerRadius(5), .IsHitTestVisible = False}
  68. Children.Insert(1, MainBorder)
  69. MainGrid = New Grid
  70. Children.Add(MainGrid)
  71. End Sub
  72. Private IsLoad As Boolean = False
  73. Private Sub Init() Handles Me.Loaded
  74. If IsLoad Then Return
  75. IsLoad = True
  76. '初次加载限定
  77. If MainTextBlock Is Nothing Then
  78. MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
  79. MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
  80. MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
  81. MainGrid.Children.Add(MainTextBlock)
  82. End If
  83. If CanSwap OrElse SwapControl IsNot Nothing Then
  84. If SwapControl Is Nothing AndAlso Children.Count > 3 Then SwapControl = Children(3)
  85. MainSwap = New Shapes.Path With {.HorizontalAlignment = HorizontalAlignment.Right, .Stretch = Stretch.Uniform, .Height = 6, .Width = 10, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(0, 17, 16, 0), .Data = New GeometryConverter().ConvertFromString("M2,4 l-2,2 10,10 10,-10 -2,-2 -8,8 -8,-8 z"), .RenderTransform = New RotateTransform(180), .RenderTransformOrigin = New Point(0.5, 0.5)}
  86. MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1")
  87. MainGrid.Children.Add(MainSwap)
  88. End If
  89. '改变默认的折叠
  90. If IsSwapped AndAlso SwapControl IsNot Nothing Then
  91. MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
  92. SwapControl.Visibility = Visibility.Collapsed
  93. '取消由于高度变化被迫触发的高度动画
  94. Dim RawUseAnimation As Boolean = UseAnimation
  95. UseAnimation = False
  96. Height = SwapedHeight
  97. AniStop("MyCard Height " & Uuid)
  98. IsHeightAnimating = False
  99. RunInUi(Sub() UseAnimation = RawUseAnimation, True)
  100. End If
  101. End Sub
  102. '填充
  103. Private ContentBuilder As Action(Of Panel)
  104. Public Sub SetContentBuilder(Builder As Action(Of Panel))
  105. ContentBuilder = Builder
  106. End Sub
  107. Public Sub SetContentBuilder(Of T)(Items As IEnumerable(Of T), ItemBuilder As Func(Of T, UIElement))
  108. SetContentBuilder(
  109. Sub(Stack)
  110. For Each Item In Items
  111. Stack.Children.Add(ItemBuilder(Item))
  112. Next
  113. Stack.Children.Add(New FrameworkElement With {.Height = 18})
  114. End Sub)
  115. End Sub
  116. ''' <summary>
  117. ''' 使用 ContentBuilder 生成卡片内容。
  118. ''' </summary>
  119. Public Sub BuildContent()
  120. If ContentBuilder Is Nothing Then Return
  121. Dim Stack = TryCast(SwapControl, Panel)
  122. If Stack Is Nothing Then Return
  123. Try
  124. ContentBuilder(Stack)
  125. ContentBuilder = Nothing
  126. Catch
  127. Stack.Children.Clear()
  128. Throw
  129. End Try
  130. TriggerForceResize()
  131. End Sub
  132. '动画
  133. Private Const DropShadowIdleOpacity As Double = 0.07
  134. Private Const DropShadowHoverOpacity As Double = 0.4
  135. Public Property HasMouseAnimation As Boolean = True
  136. Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
  137. If Not HasMouseAnimation Then Return
  138. Dim AniList As New List(Of AniData)
  139. If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 90))
  140. If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 90))
  141. AniList.AddRange({
  142. AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4", 90),
  143. AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90)
  144. })
  145. AniStart(AniList, "MyCard Mouse " & Uuid)
  146. End Sub
  147. Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
  148. If Not HasMouseAnimation Then Return
  149. Dim AniList As New List(Of AniData)
  150. If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 90))
  151. If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 90))
  152. AniList.AddRange({
  153. AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1", 90),
  154. AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90)
  155. })
  156. AniStart(AniList, "MyCard Mouse " & Uuid)
  157. End Sub
  158. #Region "高度改变动画"
  159. ''' <summary>
  160. ''' 是否启用高度改变动画。
  161. ''' </summary>
  162. Public Property UseAnimation As Boolean = True
  163. Private IsHeightAnimating As Boolean = False
  164. Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
  165. Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
  166. If Not UseAnimation Then Return
  167. Dim DeltaHeight As Double = If(IsSwapped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
  168. '卡片的进入时动画已被页面通用切换动画替代
  169. If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
  170. StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
  171. End Sub
  172. Private Sub StartHeightAnimation(Delta As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
  173. If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
  174. Dim AnimList As New List(Of AniData)
  175. Dim AbsDelta = Math.Abs(Delta)
  176. If AbsDelta <= 800 Then
  177. '短距离,直接使用 150ms 的缓动动画
  178. AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
  179. Else
  180. Dim EaseLength As Integer, EaseTime As Integer
  181. Dim InitSpeed As Integer '到达缓动区前的初速度
  182. If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0.1 Then
  183. '收回距离过长 (>0.1s),强制以 100ms 完成匀速段,然后让减速段更长
  184. EaseLength = 200
  185. EaseTime = 150
  186. InitSpeed = (AbsDelta - EaseLength) / 0.1
  187. ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0.6 Then
  188. '展开距离过长 (>0.6s),以 5000 速度展示 300ms 匀速段,剩下的距离全部归入减速段
  189. InitSpeed = 5000
  190. EaseLength = AbsDelta - InitSpeed * 0.3
  191. EaseTime = 400
  192. Else
  193. '中程,匀速地快速展开(或收回)
  194. EaseLength = 150
  195. EaseTime = 200
  196. InitSpeed = 4000
  197. End If
  198. '匀速段
  199. AnimList.Add(AaHeight(Me, (AbsDelta - EaseLength) * Math.Sign(Delta),
  200. (AbsDelta - EaseLength) / InitSpeed * 1000))
  201. '减速段
  202. AnimList.Add(AaHeight(Me, EaseLength * Math.Sign(Delta),
  203. EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000, EaseLength), True))
  204. End If
  205. AnimList.Add(AaCode(
  206. Sub()
  207. IsHeightAnimating = False
  208. Height = ActualUsedHeight
  209. If IsSwapped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
  210. End Sub,, True))
  211. AniStart(AnimList, "MyCard Height " & Uuid)
  212. IsHeightAnimating = True
  213. ActualUsedHeight = If(IsSwapped, SwapedHeight, Height)
  214. Height = PreviousHeight
  215. End Sub
  216. ''' <summary>
  217. ''' 通知 MyCard,控件内容已改变,需要中断动画并瞬间更新高度。
  218. ''' </summary>
  219. Public Sub TriggerForceResize()
  220. Height = If(IsSwapped, SwapedHeight, Double.NaN)
  221. AniStop("MyCard Height " & Uuid)
  222. IsHeightAnimating = False
  223. End Sub
  224. #End Region
  225. #Region "折叠"
  226. '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
  227. '这是因为不能直接在 XAML 中设置 SwapControl
  228. Public SwapControl As FrameworkElement
  229. Public Property CanSwap As Boolean = False
  230. ''' <summary>
  231. ''' 是否已被折叠。
  232. ''' </summary>
  233. Public Property IsSwapped As Boolean
  234. Get
  235. Return _IsSwapped
  236. End Get
  237. Set(value As Boolean)
  238. If _IsSwapped = value Then Return
  239. _IsSwapped = value
  240. If SwapControl Is Nothing Then Return
  241. '展开
  242. If Not IsSwapped Then BuildContent()
  243. '若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
  244. If Not IsLoaded Then Return
  245. '更新样式
  246. SwapControl.Visibility = Visibility.Visible
  247. TriggerForceResize()
  248. UpdateCursorStyle()
  249. '改变箭头
  250. AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
  251. End Set
  252. End Property
  253. Private _IsSwapped As Boolean = False
  254. <Obsolete("IsSwaped 存在拼写错误,请换用 IsSwapped 属性。")>
  255. Public Property IsSwaped As Boolean
  256. Get
  257. Return GetValue(IsSwapedProperty)
  258. End Get
  259. Set(value As Boolean)
  260. SetValue(IsSwapedProperty, value)
  261. End Set
  262. End Property
  263. Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
  264. Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
  265. Public Property SwapLogoRight As Boolean = False
  266. Private IsSwapMouseDown As Boolean = False '用于触发卡片展开/折叠的 MouseDown
  267. Private IsCustomMouseDown As Boolean = False '用于触发自定义事件的 MouseDown
  268. Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
  269. Public Event Swap(sender As Object, e As RouteEventArgs)
  270. Public Const SwapedHeight As Integer = 40
  271. Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
  272. Dim Pos As Double = Mouse.GetPosition(Me).Y
  273. If Not IsSwapped AndAlso
  274. (Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return
  275. IsCustomMouseDown = True
  276. If Not IsSwapped AndAlso
  277. (SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
  278. IsSwapMouseDown = True
  279. End Sub
  280. Private Sub MyCard_MouseLeftButtonUp() Handles Me.MouseLeftButtonUp
  281. If Not IsCustomMouseDown Then Return
  282. IsCustomMouseDown = False
  283. RaiseCustomEvent() '触发自定义事件
  284. If Not IsSwapMouseDown Then Return
  285. IsSwapMouseDown = False
  286. Dim Pos As Double = Mouse.GetPosition(Me).Y
  287. If Not IsSwapped AndAlso
  288. (SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
  289. Dim e = New RouteEventArgs(True)
  290. RaiseEvent PreviewSwap(Me, e)
  291. If e.Handled Then
  292. IsSwapMouseDown = False
  293. Return
  294. End If
  295. IsSwapped = Not IsSwapped
  296. Logger.Info($"{If(IsSwapped, "折叠卡片", "展开卡片")}{If(Title Is Nothing, "", ":" & Title)}")
  297. RaiseEvent Swap(Me, e)
  298. End Sub
  299. Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
  300. IsSwapMouseDown = False
  301. End Sub
  302. Private Sub UpdateCursorStyle() Handles Me.MouseMove
  303. If _MainSwap Is Nothing Then Cursor = Nothing : Return
  304. Dim Pos As Double = Mouse.GetPosition(Me).Y
  305. Cursor = If(MainSwap.Visibility = Visibility.Visible AndAlso (IsSwapped OrElse (Pos <= SwapedHeight - 6 AndAlso Not (Pos = 0 AndAlso Not IsMouseDirectlyOver))),
  306. Cursors.Hand, Nothing)
  307. End Sub
  308. #End Region
  309. End Class
  310. Partial Public Module ModAnimation
  311. Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
  312. If Control.IsHitTestVisible Then
  313. Control.IsHitTestVisible = False
  314. AniStart({
  315. AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
  316. AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
  317. AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
  318. AaCode(
  319. Sub()
  320. If RemoveFromChildren Then
  321. If Control.Parent Is Nothing Then Return
  322. CType(Control.Parent, Object).Children.Remove(Control)
  323. Else
  324. Control.Visibility = Visibility.Collapsed
  325. End If
  326. If CallBack IsNot Nothing Then CallBack(Control)
  327. End Sub,, True)
  328. }, "MyCard Dispose " & Control.Uuid)
  329. Else
  330. If RemoveFromChildren Then
  331. If Control.Parent Is Nothing Then Return
  332. CType(Control.Parent, Object).Children.Remove(Control)
  333. Else
  334. Control.Visibility = Visibility.Collapsed
  335. End If
  336. If CallBack IsNot Nothing Then CallBack(Control)
  337. End If
  338. End Sub
  339. End Module