MyCard.vb 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371
  1. Public Class MyCard
  2. '控件
  3. Inherits Grid
  4. Private ReadOnly MainGrid As Grid
  5. Public ReadOnly Property MainChrome As SystemDropShadowChrome
  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 SystemDropShadowChrome With {.Margin = New Thickness(-9.5, -9, 0.5, -0.5), .Opacity = 0.1, .CornerRadius = New CornerRadius(6)}
  64. MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1")
  65. Children.Insert(0, MainChrome)
  66. MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
  67. Children.Insert(1, MainBorder)
  68. MainGrid = New Grid
  69. Children.Add(MainGrid)
  70. End Sub
  71. Private IsLoad As Boolean = False
  72. Private Sub Init() Handles Me.Loaded
  73. If IsLoad Then Exit Sub
  74. IsLoad = True
  75. '初次加载限定
  76. If MainTextBlock Is Nothing Then
  77. MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
  78. MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
  79. MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
  80. MainGrid.Children.Add(MainTextBlock)
  81. End If
  82. If CanSwap OrElse SwapControl IsNot Nothing Then
  83. If SwapControl Is Nothing AndAlso Children.Count > 3 Then SwapControl = Children(3)
  84. 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)}
  85. MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1")
  86. MainGrid.Children.Add(MainSwap)
  87. End If
  88. '改变默认的折叠
  89. If IsSwaped AndAlso SwapControl IsNot Nothing Then
  90. MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
  91. '取消由于高度变化被迫触发的高度动画
  92. Dim RawUseAnimation As Boolean = UseAnimation
  93. UseAnimation = False
  94. Height = SwapedHeight
  95. AniStop("MyCard Height " & Uuid)
  96. IsHeightAnimating = False
  97. RunInUi(Sub() UseAnimation = RawUseAnimation, True)
  98. End If
  99. End Sub
  100. Public Sub StackInstall()
  101. StackInstall(SwapControl, SwapType, Title)
  102. TriggerForceResize()
  103. End Sub
  104. Public Shared Sub StackInstall(ByRef Stack As StackPanel, Type As Integer, Optional CardTitle As String = "")
  105. '这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
  106. '但是现在……反正勉强能用……懒得改了就这样吧.jpg
  107. '别骂了别骂了.jpg
  108. If IsNothing(Stack.Tag) Then Exit Sub
  109. '排序
  110. Select Case Type
  111. Case 3
  112. Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
  113. Case 4, 10
  114. Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
  115. Case 6
  116. Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version)
  117. Case 8, 9
  118. Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
  119. End Select
  120. '控件转换
  121. Select Case Type
  122. Case 5
  123. Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
  124. Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
  125. LoadingPickaxe.State = Loader
  126. Loader.Start(Stack.Tag)
  127. AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
  128. AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
  129. Stack.Children.Add(LoadingPickaxe)
  130. Case 6
  131. ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
  132. Case 8
  133. CompFilesCardPreload(Stack, Stack.Tag)
  134. End Select
  135. '实现控件虚拟化
  136. For Each Data As Object In Stack.Tag
  137. Select Case Type
  138. Case 0
  139. Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
  140. Case 2
  141. Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
  142. Case 3
  143. Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
  144. Case 4
  145. Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
  146. Case 5
  147. Case 6
  148. Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
  149. Case 7
  150. '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
  151. Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
  152. Case 8
  153. If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
  154. CType(Stack.Tag, List(Of CompFile)).Count Then
  155. '存在重复的名称(#1344)
  156. Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
  157. Else
  158. '不存在重复的名称,正常加载
  159. Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
  160. End If
  161. Case 9
  162. If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
  163. CType(Stack.Tag, List(Of CompFile)).Count Then
  164. '存在重复的名称(#1344)
  165. Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
  166. Else
  167. '不存在重复的名称,正常加载
  168. Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
  169. End If
  170. Case 10
  171. Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
  172. Case 11
  173. Stack.Children.Add(CType(Data, HelpEntry).ToListItem)
  174. Case 12
  175. Stack.Children.Add(FabricDownloadListItem(CType(Data, JObject), AddressOf FrmDownloadInstall.Fabric_Selected))
  176. Case 13
  177. Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
  178. Case Else
  179. Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
  180. End Select
  181. Next
  182. Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距,同时适应折叠
  183. Stack.Tag = Nothing
  184. End Sub
  185. '事件
  186. Public Property HasMouseAnimation As Boolean = True
  187. Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
  188. If Not HasMouseAnimation Then Exit Sub
  189. Dim AniList As New List(Of AniData)
  190. If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
  191. If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
  192. AniList.AddRange({
  193. AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
  194. AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
  195. AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
  196. })
  197. AniStart(AniList, "MyCard Mouse " & Uuid)
  198. End Sub
  199. Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
  200. If Not HasMouseAnimation Then Exit Sub
  201. Dim AniList As New List(Of AniData)
  202. If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
  203. If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
  204. AniList.AddRange({
  205. AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
  206. AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
  207. AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
  208. })
  209. AniStart(AniList, "MyCard Mouse " & Uuid)
  210. End Sub
  211. #Region "高度改变动画"
  212. ''' <summary>
  213. ''' 是否启用高度改变动画。
  214. ''' </summary>
  215. Public Property UseAnimation As Boolean = True
  216. Private IsHeightAnimating As Boolean = False
  217. Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
  218. Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
  219. If Not UseAnimation Then Exit Sub
  220. Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
  221. '卡片的进入时动画已被页面通用切换动画替代
  222. If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Exit Sub
  223. StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
  224. End Sub
  225. Private Sub StartHeightAnimation(DeltaHeight As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
  226. If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
  227. Dim AnimList As New List(Of AniData)
  228. If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
  229. '高度增加较大,使用弹起动画
  230. Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
  231. AnimList.AddRange({
  232. AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
  233. AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
  234. })
  235. Else
  236. '普通的改变就行啦
  237. AnimList.AddRange({
  238. AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
  239. })
  240. End If
  241. AnimList.Add(AaCode(
  242. Sub()
  243. IsHeightAnimating = False
  244. Height = ActualUsedHeight
  245. If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
  246. End Sub,, True))
  247. AniStart(AnimList, "MyCard Height " & Uuid)
  248. IsHeightAnimating = True
  249. ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
  250. Height = PreviousHeight
  251. End Sub
  252. ''' <summary>
  253. ''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。
  254. ''' </summary>
  255. Public Sub TriggerForceResize()
  256. Height = If(IsSwaped, SwapedHeight, Double.NaN)
  257. AniStop("MyCard Height " & Uuid)
  258. IsHeightAnimating = False
  259. End Sub
  260. #End Region
  261. #Region "折叠"
  262. '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
  263. '这是因为不能直接在 XAML 中设置 SwapControl
  264. Public SwapControl As Object
  265. Public Property CanSwap As Boolean = False
  266. ''' <summary>
  267. ''' 被折叠的种类,用于控件虚拟化。
  268. ''' </summary>
  269. Public Property SwapType As Integer
  270. ''' <summary>
  271. ''' 是否已被折叠。
  272. ''' </summary>
  273. Public Property IsSwaped As Boolean
  274. Get
  275. Return _IsSwaped
  276. End Get
  277. Set(value As Boolean)
  278. If _IsSwaped = value Then Exit Property
  279. _IsSwaped = value
  280. If SwapControl Is Nothing Then Exit Property
  281. '展开
  282. If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
  283. '若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
  284. If Not IsLoaded Then Exit Property
  285. '更新高度
  286. SwapControl.Visibility = Visibility.Visible
  287. TriggerForceResize()
  288. '改变箭头
  289. AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "MyCard Swap " & Uuid, True)
  290. End Set
  291. End Property
  292. Private _IsSwaped As Boolean = False
  293. Public Property SwapLogoRight As Boolean = False
  294. Private IsMouseDown As Boolean = False
  295. Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
  296. Public Event Swap(sender As Object, e As RouteEventArgs)
  297. Public Const SwapedHeight As Integer = 40
  298. Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
  299. Dim Pos As Double = Mouse.GetPosition(Me).Y
  300. If Not IsSwaped AndAlso
  301. (SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
  302. IsMouseDown = True
  303. End Sub
  304. Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
  305. If Not IsMouseDown Then Return
  306. IsMouseDown = False
  307. Dim Pos As Double = Mouse.GetPosition(Me).Y
  308. If Not IsSwaped AndAlso
  309. (SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
  310. Dim ee = New RouteEventArgs(True)
  311. RaiseEvent PreviewSwap(Me, ee)
  312. If ee.Handled Then
  313. IsMouseDown = False
  314. Return
  315. End If
  316. IsSwaped = Not IsSwaped
  317. Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
  318. RaiseEvent Swap(Me, ee)
  319. End Sub
  320. Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
  321. IsMouseDown = False
  322. End Sub
  323. #End Region
  324. End Class
  325. Partial Public Module ModAnimation
  326. Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
  327. If Control.IsHitTestVisible Then
  328. Control.IsHitTestVisible = False
  329. AniStart({
  330. AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
  331. AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
  332. AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
  333. AaCode(
  334. Sub()
  335. If RemoveFromChildren Then
  336. If Control.Parent Is Nothing Then Exit Sub
  337. CType(Control.Parent, Object).Children.Remove(Control)
  338. Else
  339. Control.Visibility = Visibility.Collapsed
  340. End If
  341. If CallBack IsNot Nothing Then CallBack(Control)
  342. End Sub,, True)
  343. }, "MyCard Dispose " & Control.Uuid)
  344. Else
  345. If RemoveFromChildren Then
  346. If Control.Parent Is Nothing Then Exit Sub
  347. CType(Control.Parent, Object).Children.Remove(Control)
  348. Else
  349. Control.Visibility = Visibility.Collapsed
  350. End If
  351. If CallBack IsNot Nothing Then CallBack(Control)
  352. End If
  353. End Sub
  354. End Module