如何在RichTextBox中实现平滑滚动?

这就需要用到两个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

圈主 管理员

热门评论
:
该帖子评论已关闭
图片审查中...
编辑答案: 我的回答: 最多上传一张图片和一个附件
x
x
个人中心
今日签到
有新私信 私信列表
搜索