这就需要用到两个windows API函数:GetScrollPos和PostMessage。GetScrollPos用来获取RichTextBox的当前位置,PostMessage在这里则是用来向创建当前窗口的线程的消息队列发送垂直滚动(WM_VSCORLL)消息。
代码:
_
Public Shared Function PostMessage(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
_
Public Shared Function GetScrollPos(ByVal hwnd As Integer, ByVal nBar As Integer) As Integer
End Function
Public Const WM_VSCROLL As Integer = 277
Public Const SB_THUMBPOSITION As Integer = 4
Public Const SBS_VERT As Integer = 1
Private previousPos As Integer = 0
Private Sub RTBAutoScroll_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
Me.RichTextBox1.[Select](0, 0)
Me.RichTextBox1.ScrollToCaret()
Me.Timer1.Interval = 300
AddHandler Me.Timer1.Tick, AddressOf timer1_Tick
Dim td As New DateTime()
Me.Text = td.ToString()
End Sub
Private Sub timer1_Tick(ByVal sender As Object, ByVal e As EventArgs)
Dim currentPos As Integer = GetScrollPos(CInt(Me.richTextBox1.Handle), SBS_VERT)
If previousPos currentPos OrElse currentPos = 0 Then
previousPos = currentPos
PostMessage(CInt(Me.richTextBox1.Handle), WM_VSCROLL, SB_THUMBPOSITION + 65536 * (currentPos + 1), 0)
End If
End Sub
Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Button1.Text = "Auto Scroll" Then
Button1.Text = "Pause"
Timer1.Enabled = True
ElseIf Button1.Text = "Pause" Then
Button1.Text = "Auto Scroll"
Timer1.Enabled = False
End If
End Sub