33 '控件
44 Inherits Grid
55 Private ReadOnly MainGrid As Grid
6- Public ReadOnly Property MainChrome As SystemDropShadowChrome
6+ Public ReadOnly Property MainChrome As MyDropShadow
77 Private ReadOnly MainBorder As Border
88 Public Property BorderChild As UIElement
99 Get
6363
6464 'UI 建立
6565 Public Sub New ()
66- MainChrome = New SystemDropShadowChrome With {.Margin = New Thickness(- 9.5 , - 9 , 0 . 5 , - 0 . 5 ), .Opacity = 0 . 1 , .CornerRadius = New CornerRadius( 6 )}
67- MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1" )
66+ MainChrome = New MyDropShadow With {
67+ .Margin = New Thickness(- 3 , - 3 , - 3 , - 3 - GetWPFSize( 1 )), .ShadowRadius = 3 , .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius( 5 )}
68+ MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1" )
6869 Children.Insert( 0 , MainChrome)
69- MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb( 205 , 255 , 255 , 255 )), .CornerRadius = New CornerRadius( 6 ), .IsHitTestVisible = False }
70+ MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb( 245 , 255 , 255 , 255 )), .CornerRadius = New CornerRadius( 5 ), .IsHitTestVisible = False }
7071 Children.Insert( 1 , MainBorder)
7172 MainGrid = New Grid
7273 Children.Add(MainGrid)
7374 End Sub
7475 Private IsLoad As Boolean = False
7576 Private Sub Init() Handles Me .Loaded
76- If IsLoad Then Exit Sub
77+ If IsLoad Then Return
7778 IsLoad = True
7879 '初次加载限定
7980 If MainTextBlock Is Nothing Then
108109 '这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎
109110 '但是现在……反正勉强能用……懒得改了就这样吧.jpg
110111 '别骂了别骂了.jpg
111- If IsNothing(Stack.Tag) Then Exit Sub
112+ If IsNothing(Stack.Tag) Then Return
112113 '排序
113114 Select Case Type
114115 Case 3
186187 Stack.Tag = Nothing
187188 End Sub
188189
189- '事件
190+ '动画
191+ Private Const DropShadowIdleOpacity As Double = 0.07
192+ Private Const DropShadowHoverOpacity As Double = 0.4
190193 Public Property HasMouseAnimation As Boolean = True
191194 Private Sub MyCard_MouseEnter(sender As Object , e As MouseEventArgs) Handles Me .MouseEnter
192- If Not HasMouseAnimation Then Exit Sub
195+ If Not HasMouseAnimation Then Return
193196 Dim AniList As New List( Of AniData)
194- If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2" , 150 ))
195- If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2" , 150 ))
197+ If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2" , 90 ))
198+ If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2" , 90 ))
196199 AniList.AddRange({
197- AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2" , 180 ),
198- AaColor(MainBorder, Border.BackgroundProperty, New MyColor( 230 , 255 , 255 , 255 ) - MainBorder.Background, 180 ),
199- AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180 )
200+ AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4" , 90 ),
201+ AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90 )
200202 })
201203 AniStart(AniList, "MyCard Mouse " & Uuid)
202204 End Sub
203205 Private Sub MyCard_MouseLeave(sender As Object , e As MouseEventArgs) Handles Me .MouseLeave
204- If Not HasMouseAnimation Then Exit Sub
206+ If Not HasMouseAnimation Then Return
205207 Dim AniList As New List( Of AniData)
206- If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1" , 250 ))
207- If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1" , 250 ))
208+ If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1" , 90 ))
209+ If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1" , 90 ))
208210 AniList.AddRange({
209- AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1" , 300 ),
210- AaColor(MainBorder, Border.BackgroundProperty, New MyColor( 205 , 255 , 255 , 255 ) - MainBorder.Background, 300 ),
211- AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300 )
211+ AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1" , 90 ),
212+ AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90 )
212213 })
213214 AniStart(AniList, "MyCard Mouse " & Uuid)
214215 End Sub
222223 Private IsHeightAnimating As Boolean = False
223224 Private ActualUsedHeight As Double '回滚实际高度（例如 NaN）
224225 Private Sub MySizeChanged(sender As Object , e As SizeChangedEventArgs) Handles Me .SizeChanged
225- If Not UseAnimation Then Exit Sub
226+ If Not UseAnimation Then Return
226227 Dim DeltaHeight As Double = If (IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
227228 '卡片的进入时动画已被页面通用切换动画替代
228- If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Exit Sub
229+ If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
229230 StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False )
230231 End Sub
231- Private Sub StartHeightAnimation(DeltaHeight As Double , PreviousHeight As Double , IsLoadAnimation As Boolean )
232- If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
232+ Private Sub StartHeightAnimation(Delta As Double , PreviousHeight As Double , IsLoadAnimation As Boolean )
233+ If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
233234
234235 Dim AnimList As New List( Of AniData)
235- If DeltaHeight > 10 OrElse (DeltaHeight < - 10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片，高度减小时的弹跳会吞掉按钮下边框
236- '高度增加较大，使用弹起动画
237- Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05 , 3 , 10 ) * Math.Sign(DeltaHeight)
238- AnimList.AddRange({
239- AaHeight( Me , DeltaHeight + Delta, 300 , If (IsLoadAnimation, 30 , 0 ), If (DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
240- AaHeight( Me , -Delta, 150 , 260 , Ease:= New AniEaseOutFluent(AniEasePower.Strong))
241- })
236+ Dim AbsDelta = Math.Abs(Delta)
237+
238+ If AbsDelta <= 800 Then
239+ '短距离，直接使用 150ms 的缓动动画
240+ AnimList.Add(AaHeight( Me , Delta, 150 ,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
242241 Else
243- '普通的改变就行啦
244- AnimList.AddRange({
245- AaHeight( Me , DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4 , 150 , 250 ),, New AniEaseOutFluent)
246- })
242+ Dim EaseLength As Integer , EaseTime As Integer
243+ Dim InitSpeed As Integer '到达缓动区前的初速度
244+ If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0 . 1 Then
245+ '收回距离过长 (>0.1s)，强制以 100ms 完成匀速段，然后让减速段更长
246+ EaseLength = 200
247+ EaseTime = 150
248+ InitSpeed = (AbsDelta - EaseLength) / 0.1
249+ ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0 . 6 Then
250+ '展开距离过长 (>0.6s)，以 5000 速度展示 300ms 匀速段，剩下的距离全部归入减速段
251+ InitSpeed = 5000
252+ EaseLength = AbsDelta - InitSpeed * 0.3
253+ EaseTime = 400
254+ Else
255+ '中程，匀速地快速展开（或收回）
256+ EaseLength = 150
257+ EaseTime = 200
258+ InitSpeed = 4000
259+ End If
260+ '匀速段
261+ AnimList.Add(AaHeight( Me , (AbsDelta - EaseLength) * Math.Sign(Delta),
262+ (AbsDelta - EaseLength) / InitSpeed * 1000 ))
263+ '减速段
264+ AnimList.Add(AaHeight( Me , EaseLength * Math.Sign(Delta),
265+ EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000 , EaseLength), True ))
247266 End If
267+
248268 AnimList.Add(AaCode(
249269 Sub ()
250270 IsHeightAnimating = False
251271 Height = ActualUsedHeight
252- If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
272+ If IsSwaped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
253273 End Sub ,, True ))
254274 AniStart(AnimList, "MyCard Height " & Uuid)
255-
256275 IsHeightAnimating = True
257276 ActualUsedHeight = If (IsSwaped, SwapedHeight, Height)
258277 Height = PreviousHeight
286305 Return _IsSwaped
287306 End Get
288307 Set (value As Boolean )
289- If _IsSwaped = value Then Exit Property
308+ If _IsSwaped = value Then Return
290309 _IsSwaped = value
291- If SwapControl Is Nothing Then Exit Property
310+ If SwapControl Is Nothing Then Return
292311 '展开
293312 If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
294313 '若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
295- If Not IsLoaded Then Exit Property
314+ If Not IsLoaded Then Return
296315 '更新高度
297316 SwapControl.Visibility = Visibility.Visible
298317 TriggerForceResize()
299318 '改变箭头
300- AniStart(AaRotateTransform(MainSwap, If (_IsSwaped, If (SwapLogoRight, 270 , 0 ), 180 ) - CType (MainSwap.RenderTransform, RotateTransform).Angle, 400 ,, New AniEaseOutBack (AniEasePower.Weak )),"MyCard Swap " & Uuid, True )
319+ AniStart(AaRotateTransform(MainSwap, If (_IsSwaped, If (SwapLogoRight, 270 , 0 ), 180 ) - CType (MainSwap.RenderTransform, RotateTransform).Angle, 250 ,, New AniEaseOutFluent (AniEasePower.ExtraStrong )),"MyCard Swap " & Uuid, True )
301320 End Set
302321 End Property
303322 Private _IsSwaped As Boolean = False
310329 Private Sub MyCard_MouseLeftButtonDown(sender As Object , e As MouseButtonEventArgs) Handles Me .MouseLeftButtonDown
311330 Dim Pos As Double = Mouse.GetPosition( Me ).Y
312331 If Not IsSwaped AndAlso
313- (SwapControl Is Nothing OrElse Pos > If (IsSwaped, SwapedHeight, SwapedHeight - 6 ) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
332+ (SwapControl Is Nothing OrElse Pos > If (IsSwaped, SwapedHeight, SwapedHeight - 6 ) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置；或已经不在可视树上的误判
314333 IsMouseDown = True
315334 End Sub
316335 Private Sub MyCard_MouseLeftButtonUp(sender As Object , e As MouseButtonEventArgs) Handles Me .MouseLeftButtonUp
319338
320339 Dim Pos As Double = Mouse.GetPosition( Me ).Y
321340 If Not IsSwaped AndAlso
322- (SwapControl Is Nothing OrElse Pos > If (IsSwaped, SwapedHeight, SwapedHeight - 6 ) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
341+ (SwapControl Is Nothing OrElse Pos > If (IsSwaped, SwapedHeight, SwapedHeight - 6 ) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置；或已经不在可视树上的误判
323342
324343 Dim ee = New RouteEventArgs( True )
325344 RaiseEvent PreviewSwap( Me , ee)
@@ -350,7 +369,7 @@ Partial Public Module ModAnimation
350369 AaCode(
351370 Sub ()
352371 If RemoveFromChildren Then
353- If Control.Parent Is Nothing Then Exit Sub
372+ If Control.Parent Is Nothing Then Return
354373 CType (Control.Parent, Object ).Children.Remove(Control)
355374 Else
356375 Control.Visibility = Visibility.Collapsed
@@ -360,7 +379,7 @@ Partial Public Module ModAnimation
360379 }, "MyCard Dispose " & Control.Uuid)
361380 Else
362381 If RemoveFromChildren Then
363- If Control.Parent Is Nothing Then Exit Sub
382+ If Control.Parent Is Nothing Then Return
364383 CType (Control.Parent, Object ).Children.Remove(Control)
365384 Else
366385 Control.Visibility = Visibility.Collapsed
0 commit comments