Private min, max As Integer
Private pos As Integer = 0
Private endPos As Integer = 0
Private Const SB_HORZ As Integer = &H0
Private Const SB_VERT As Integer = &H1
Private Const WM_HSCROLL As Integer = &H114
Private Const WM_VSCROLL As Integer = &H115
Private Const SB_THUMBPOSITION As Integer = 4
Private Const WM_SETREDRAW As Int32 = &HB
Private scroll_speed As Integer = 20
Private Declare Function SetScrollPos Lib "user32" (hwnd As IntPtr, nBar As Integer, nPos As Integer, bRedraw As Boolean) As Integer
Private Declare Function GetScrollPos Lib "user32" (hwnd As IntPtr, nBar As Integer) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hwnd As IntPtr, nBar As Integer, wParam As Integer, lParam As Integer) As Integer
Private Declare Function GetScrollRange Lib "user32" (hwnd As IntPtr, nBar As Integer, ByRef lpMinPos As Integer, ByRef lpMaxPos As Integer) As Boolean
Private Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Sub Scroll_timer_Tick(sender As Object, e As EventArgs) Handles Scroll_timer.Tick
GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
max = max - RichTextBox1.ClientSize.Height
pos = GetScrollPos(RichTextBox1.Handle, SB_VERT)
Debug.WriteLine("Max=" & max & "--Min=" & min & "--Current=" & pos)
If Scroll_timer.Tag = "down" Then
If (pos >= endPos) Then
Me.Scroll_timer.Enabled = False
Exit Sub
End If
If endPos >= max Then
endPos = max
End If
pos = pos + scroll_speed
SetScrollPos(RichTextBox1.Handle, SB_VERT, pos, True)
PostMessage(RichTextBox1.Handle, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * pos, 0)
Else
If endPos <= 1 Then
endPos = 1
End If
If (pos <= endPos) Then
Me.Scroll_timer.Enabled = False
Exit Sub
End If
If (pos - scroll_speed) < 1 Then
pos = 0
Else
pos = pos - scroll_speed
End If
SetScrollPos(RichTextBox1.Handle, SB_VERT, pos, True)
PostMessage(RichTextBox1.Handle, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * pos, 0)
End If
End Sub
Private Sub RichTextBox1_MouseWheel_Click(sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseWheel
Dim temp As HandledMouseEventArgs = e
temp.Handled = True
Dim temp_pos = GetScrollPos(RichTextBox1.Handle, SB_VERT)
If Scroll_timer.Enabled = True Then
temp_pos = endPos
Else
End If
If e.Delta > 0 Then
Debug.WriteLine("Scrolled up!" & e.Delta)
GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
endPos = temp_pos - e.Delta
If endPos <= 1 Then
endPos = 1
End If
Debug.WriteLine(endPos)
Scroll_timer.Tag = "up"
Me.Scroll_timer.Enabled = True
Else
Debug.WriteLine("Scrolled down!" & e.Delta & "--Current: " & temp_pos)
GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
max = max - RichTextBox1.ClientSize.Height
If temp_pos + Math.Abs(e.Delta) >= max Then
endPos = max - 1
Else
endPos = temp_pos + Math.Abs(e.Delta) - 1
End If
Debug.WriteLine(endPos)
Scroll_timer.Tag = "down"
Me.Scroll_timer.Enabled = True
End If
End Sub
Function DoubleBufferedx(ByVal dgv As DataGridView, ByVal setting As Boolean)
Dim dgvType As Type = dgv.GetType()
Dim pi As System.Reflection.PropertyInfo = dgvType.GetProperty("DoubleBuffered", System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.NonPublic)
pi.SetValue(dgv, setting, Nothing)
Return True
End Function
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim params As CreateParams = MyBase.CreateParams
params.ExStyle = params.ExStyle Or &H2000000
Return params
End Get
End Property