50 lines
2.6 KiB
VB.net
50 lines
2.6 KiB
VB.net
Public Class MyScrollViewer
|
|
Inherits ScrollViewer
|
|
|
|
Public Property DeltaMult As Double = 1
|
|
|
|
Private RealOffset As Double
|
|
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
|
|
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
|
|
Dim SourceType = e.Source.GetType
|
|
If Content.TemplatedParent Is Nothing AndAlso (
|
|
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
|
|
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
|
|
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
|
|
(TypeOf e.Source Is Visual AndAlso
|
|
PresentationSource.FromVisual(e.Source)?.RootVisual?.GetType().FullName = "System.Windows.Controls.Primitives.PopupRoot")) Then
|
|
'如果当前是在对有滚动条的下拉框或文本框执行，则不接管操作
|
|
Return
|
|
End If
|
|
e.Handled = True
|
|
PerformVerticalOffsetDelta(-e.Delta)
|
|
'关闭 Tooltip (#2552)
|
|
'通过 IsOpen 关闭 Tooltip 而不是降低 Border 不透明度 (#5744)
|
|
Application.ShowingTooltips.ForEach(Sub(tooltip) tooltip.IsOpen = False)
|
|
End Sub
|
|
Public Sub PerformVerticalOffsetDelta(Delta As Double)
|
|
AniStart(
|
|
AaDouble(
|
|
Sub(AnimDelta As Double)
|
|
RealOffset = (RealOffset + AnimDelta).Clamp(0, ExtentHeight - ActualHeight)
|
|
ScrollToVerticalOffset(RealOffset)
|
|
End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
|
|
End Sub
|
|
Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged
|
|
RealOffset = VerticalOffset
|
|
If FrmMain IsNot Nothing AndAlso (e.VerticalChange OrElse e.ViewportHeightChange) Then FrmMain.BtnExtraBack.ShowRefresh()
|
|
End Sub
|
|
Private Sub MyScrollViewer_IsVisibleChanged(sender As Object, e As DependencyPropertyChangedEventArgs) Handles Me.IsVisibleChanged
|
|
FrmMain.BtnExtraBack.ShowRefresh()
|
|
End Sub
|
|
|
|
Public ScrollBar As MyScrollBar
|
|
Private Sub Load() Handles Me.Loaded
|
|
ScrollBar = GetTemplateChild("PART_VerticalScrollBar")
|
|
End Sub
|
|
|
|
Private Sub MyScrollViewer_PreviewGotKeyboardFocus(sender As Object, e As KeyboardFocusChangedEventArgs) Handles Me.PreviewGotKeyboardFocus
|
|
If e.NewFocus IsNot Nothing AndAlso TypeOf e.NewFocus Is MySlider Then e.Handled = True '#3854，阻止获得焦点时自动滚动
|
|
End Sub
|
|
End Class
|