Scrolling Around with the RichTextBox Control

• Download source - 6.47 Kb

Scrolling Around with the RichTextBox Control

Some of you may be saying about now, what the...!???!. Well, please read on. Because I actually had a need to vertically scroll multiple RichTextBox controls at the same time, with only one of the RichTextBoxes scrollbars controlling all three of them. Well that should be easy Right!, Yes and No, at least from what I have found so far.

I would like to say at this point, I welcome all the CP user's Input on this matter as I can get. As I searched around the internet, I found very little information on this matter.

Background

In the RichTextBox (and other controls), the scroll message VSCROLL/HSCROLL and THUMBPOSITION of the scroll bar are not inter-connected as one would expect. On a vertical line change up or down, or a horizontal character scroll right or left, the VSCROLL/HSCROLL messages fire an event and the scrollbar moves, but the new position of the thumb never gets sent. Instead, in the case of the RichTextBox, it fires the event RichTextBox1_VScroll (or _HScroll), but still with no thumb position information. This means in my case, "The Thumb has no Idea what the rest of the hand is doing."

This so far, is what I have come up with to deal with scrolling them. I haven't tried, but I think this will also work with other text controls as I did see some horizontal uses for this, including the following article here on CP.

MFC / C++ List Controls General - Synchronization of scrolling between two list controls By Alexander Khudyakov -

• www.codeproject.com/listctrl/synchscroll.asp 

Using the code

It requires the use of two windows API functions, GetScrollPos and PostMessageA, and the infamous NativeWindow Class.

I chose Not to use the NativeWindow class at the last minute to send the GetScrollPos and PostMessageA messages because of a three line, cryptic explanation in the SDK Documentation that said: "Applications should not send these messages directly. Instead, they should use the GetScrollPos function. A window receives this message through its WindowProc function. Applications which implement a custom scroll bar control must respond to these messages for the GetScrollPos function to function properly." How this applies to the NativeWindow class I do not know yet, but I am seeking an answer if anyone knows off hand. My Original Intention was to Use the NativeWindow Class only.

I handled the GetScrollPos and PostMessageA using the RichTextBox VScroll/HScroll events.

    Private Sub RichTextBox1_VScroll( _ 
    ByVal sender As Object, ByVal e As System.EventArgs) _
      Handles RichTextBox1.VScroll
        Dim RTB1Position As Integer
        RTB1Position = GetScrollPos(RichTextBox1.Handle, SBS_VERT)
        PostMessageA(RichTextBox2.Handle, WM_VSCROLL, SB_THUMBPOSITION +_
           &H10000 * RTB1Position, 0)
        PostMessageA(RichTextBox3.Handle, WM_VSCROLL, SB_THUMBPOSITION +_
           &H10000 * RTB1Position, 0)
    End Sub

And the WM_VSCROLL/WM_HSCROLL message's are handled by the NativeWindow Class.

    Public Sub sClass_WindowProcedure( _ 
    ByRef uMsg As Message) Handles sClass1.WindowProcedure, _
      sClass2.WindowProcedure, sClass3.WindowProcedure
        Select Case uMsg.Msg
            Case WM_VSCROLL ' WM_VSCROLL Message's for RTB's
                If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
                    'Debug.WriteLine(GetLowWord(uMsg.WParam.ToInt32))
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox2.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox3.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                 End If
    '
    ' on to the next RTB.... ect.ect.

Points of Interest

There are a few small glitches to be aware of if you apply this to RichTextBoxes where the vertical line counts or the horizontal character counts are different. The scrollbars will get out of sync and won't resync until the Thumb or line Up event is fired again, sometimes moving it back to the last position in the richtextbox you selected. In the case of the Horizontal scroll it will make the shorter ones visibly "shake". But, this is not a problem in my application of this as all the Vertical line counts and the horizontal character counts are the same.

Also, Don't turn off the scroll bars in the property sheet, hide them under a panel control or something similar. The events won't fire on a disabled scrollbar and a handy "Object Not Set" Message will appear!.

Now, What I was Doing:

Sorry, You won't find the source code for this HexDumper/Editor in my submission. But, I will try to get it up here to CP when I get more of it finished, or in the mean time you could just help me with this one or create your own. It is based on the source code I submitted.

I submitted the one at the top of the page, because it shows both scroll directions and how they interact together.

The Full Code Listing

Option Explicit On 

Imports System
Imports System.IO
Imports System.Data
Imports System.Text
Imports System.Drawing
Imports System.Collections
Imports System.Windows.Forms
Imports System.Windows.Forms.Message
Imports System.Runtime.InteropServices.Marshal

Public Class Form1
    Inherits System.Windows.Forms.Form

    '"Windows Form Designer generated code removed here"

    '===================================================================
    ' for NativeWindow and PostMessageA
    '===================================================================
    Private Const WM_HSCROLL = &H114
    Private Const WM_VSCROLL = &H115
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const WM_COMMAND = &H111
    Private Const WM_USER = &H400
    '===================================================================
    ' for GetScroll and PostMessageA
    '===================================================================
    Private Const SBS_HORZ = 0
    Private Const SBS_VERT = 1
    Private Const SB_THUMBPOSITION = 4
    '===================================================================
    ' for SubClassing
    '===================================================================
    Private WithEvents sClass1 As Subclass
    Private WithEvents sClass2 As Subclass
    Private WithEvents sClass3 As Subclass

    Private Sub Form1_Load(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles MyBase.Load
        ' clear the rtb text
        RichTextBox1.Text = ""
        RichTextBox2.Text = ""
        RichTextBox3.Text = ""
        ' setup the sSubclass
        sClass1 = New Subclass(RichTextBox1.Handle)
        sClass2 = New Subclass(RichTextBox2.Handle)
        sClass3 = New Subclass(RichTextBox3.Handle)
        Dim i As Integer
        ' put some formated text in the RichTextBox's
        While i < 100
            RichTextBox1.AppendText(" this is a string " & i & vbCrLf)
            RichTextBox2.AppendText(" this is a string " & i & vbCrLf)
            RichTextBox3.AppendText(" this is a string " & i & vbCrLf)
            If i Mod 4 = 0 Then
                RichTextBox1.AppendText( _
                 " this is a longer string to force HScroll " & i & vbCrLf)
                RichTextBox2.AppendText( _
                 " this is a longer string to force HScroll " & i & vbCrLf)
                RichTextBox3.AppendText( _
                 " this is a longer string to force HScroll " & i & vbCrLf)
            End If
            i += 1
        End While
    End Sub
    Public Sub sClass_WindowProcedure( _ 
    ByRef uMsg As Message) Handles sClass1.WindowProcedure, _
     sClass2.WindowProcedure, sClass3.WindowProcedure
        Select Case uMsg.Msg
            Case WM_VSCROLL ' WM_VSCROLL Message's for RTB's
                If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
                    'Debug.WriteLine(GetLowWord(uMsg.WParam.ToInt32))
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox2.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox3.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
                If uMsg.HWnd.Equals(RichTextBox2.Handle) Then
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox1.Handle, _
                      uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox3.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
                If uMsg.HWnd.Equals(RichTextBox3.Handle) Then
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox1.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox2.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
            Case WM_HSCROLL ' WM_HSCROLL Message's for RTB's
                If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
                    'Debug.WriteLine(GetLowWord(uMsg.WParam.ToInt32))
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox2.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox3.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
                If uMsg.HWnd.Equals(RichTextBox2.Handle) Then
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox1.Handle, _ 
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox3.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
                If uMsg.HWnd.Equals(RichTextBox3.Handle) Then
                    RemoveHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                    Dim msg1 As Message
                    Dim msg2 As Message
                    msg1 = uMsg.Create(RichTextBox1.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    msg2 = uMsg.Create(RichTextBox2.Handle, _
                     uMsg.Msg, uMsg.WParam, uMsg.LParam)
                    sClass2.SendWndProc(msg1)
                    sClass2.SendWndProc(msg2)
                    AddHandler sClass2.WindowProcedure, _
                     AddressOf sClass_WindowProcedure
                End If
        End Select
    End Sub

    Private Sub RichTextBox1_VScroll(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles RichTextBox1.VScroll
        Dim RTB1Position As Integer
        RTB1Position = GetScrollPos(RichTextBox1.Handle, SBS_VERT)
        PostMessageA(RichTextBox2.Handle, WM_VSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB1Position, 0)
        PostMessageA(RichTextBox3.Handle, WM_VSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB1Position, 0)
    End Sub
    Private Sub RichTextBox2_VScroll(ByVal sender As Object,_
     ByVal e As System.EventArgs) Handles RichTextBox2.VScroll
        Dim RTB2Position As Integer
        RTB2Position = GetScrollPos(RichTextBox2.Handle, SBS_VERT)
        PostMessageA(RichTextBox1.Handle, WM_VSCROLL,_
         SB_THUMBPOSITION + &H10000 * RTB2Position, 0)
        PostMessageA(RichTextBox3.Handle, WM_VSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB2Position, 0)
    End Sub
    Private Sub RichTextBox3_VScroll(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles RichTextBox3.VScroll
        Dim RTB3Position As Integer
        RTB3Position = GetScrollPos(RichTextBox3.Handle, SBS_VERT)
        PostMessageA(RichTextBox1.Handle, WM_VSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB3Position, 0)
        PostMessageA(RichTextBox2.Handle, WM_VSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB3Position, 0)
    End Sub
    Private Sub RichTextBox1_HScroll(ByVal sender As Object,_
     ByVal e As System.EventArgs) Handles RichTextBox1.HScroll
        Dim RTB1Position As Integer
        RTB1Position = GetScrollPos(RichTextBox1.Handle, SBS_HORZ)
        PostMessageA(RichTextBox2.Handle, WM_HSCROLL,_
         SB_THUMBPOSITION + &H10000 * RTB1Position, 0)
        PostMessageA(RichTextBox3.Handle, WM_HSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB1Position, 0)
    End Sub
    Private Sub RichTextBox2_HScroll(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles RichTextBox2.HScroll
        Dim RTB2Position As Integer
        RTB2Position = GetScrollPos(RichTextBox2.Handle, SBS_HORZ)
        PostMessageA(RichTextBox1.Handle, WM_HSCROLL,_
         SB_THUMBPOSITION + &H10000 * RTB2Position, 0)
        PostMessageA(RichTextBox3.Handle, WM_HSCROLL,_
         SB_THUMBPOSITION + &H10000 * RTB2Position, 0)
    End Sub

    Private Sub RichTextBox3_HScroll(ByVal sender As Object,_
     ByVal e As System.EventArgs) Handles RichTextBox3.HScroll
        Dim RTB3Position As Integer
        RTB3Position = GetScrollPos(RichTextBox3.Handle, SBS_HORZ)
        PostMessageA(RichTextBox1.Handle, WM_HSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB3Position, 0)
        PostMessageA(RichTextBox2.Handle, WM_HSCROLL, _
        SB_THUMBPOSITION + &H10000 * RTB3Position, 0)
    End Sub
    '===================================================================
    ' API Function: GetScrollPos
    '===================================================================
    Private Declare Function GetScrollPos Lib "user32.dll" ( _
        ByVal hWnd As IntPtr, _
        ByVal nBar As Integer) As Integer
    '===================================================================
    ' API Function: PostMessageA
    '===================================================================
    Private Declare Function PostMessageA Lib "user32.dll" ( _
        ByVal hwnd As IntPtr, _
        ByVal wMsg As Integer, _
        ByVal wParam As Integer, _
        ByVal lParam As Integer) As Boolean
    '===================================================================
    ' Temporary Functions for the Debugger
    '===================================================================
    Public Function GetLowWord(ByRef pintValue As Int32) As Int32
        Return pintValue And &HFFFF
    End Function
    Public Function GetLowWord(ByRef pudtValue As IntPtr) As Int32
        Return GetLowWord(pudtValue.ToInt32)
    End Function
    Public Function GetHighWord(ByRef pintValue As Int32) As Int32
        If (pintValue And &H80000000) = &H80000000 Then
            Return ((pintValue And &H7FFF0000) \ &H10000) Or &H8000&
        Else
            Return (pintValue And &HFFFF0000) \ &H10000
        End If
    End Function
    '===================================================================
    ' End Temporary Functions for the Debugger
    '===================================================================
End Class

Public Class Subclass
    '===================================================================
    ' NativeWindow Subclassing
    '===================================================================
    Inherits System.Windows.Forms.NativeWindow
    Public Event WindowProcedure(ByRef uMsg As Message)

    Public Sub New(ByVal pWindowHandle As IntPtr)
        MyBase.AssignHandle(pWindowHandle)
    End Sub

    Protected Overrides Sub WndProc( _
     ByRef uMsg As System.Windows.Forms.Message)
        MyBase.WndProc(uMsg)
        RaiseEvent WindowProcedure(uMsg)
    End Sub

    Public Sub SendWndProc(ByRef uMsg As System.Windows.Forms.Message)
        MyBase.WndProc(uMsg)
    End Sub

End Class

Please, feel free to let me know if I'm re-inventing the wheel here, There might be a better way, And I could use the feedback.

History

• Submitted: Monday, July 26, 2004