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 -
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
If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
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
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
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
Private Const SBS_HORZ = 0
Private Const SBS_VERT = 1
Private Const SB_THUMBPOSITION = 4
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
RichTextBox1.Text = ""
RichTextBox2.Text = ""
RichTextBox3.Text = ""
sClass1 = New Subclass(RichTextBox1.Handle)
sClass2 = New Subclass(RichTextBox2.Handle)
sClass3 = New Subclass(RichTextBox3.Handle)
Dim i As Integer
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
If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
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
If uMsg.HWnd.Equals(RichTextBox1.Handle) Then
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
Private Declare Function GetScrollPos Lib "user32.dll" ( _
ByVal hWnd As IntPtr, _
ByVal nBar As Integer) As Integer
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
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 Class
Public Class Subclass
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
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.