What I want to do is to insert the cursor at a specific row and colum
after the user has scrolled the text. What happens is that the text
jumps a few pixels.
If you subclass the window, you can
watch for a WM_VSCROLL message. When
that occurs, if the wParam low word is
SB_ENDSCROLL then you know that a mouse-up
to stop scrolling has occurred. At that point I
send an EM_LINESCROLL message with parameters
of 0 to cause the top line of text to line up with
the top of the textbox window:
Public Const WM_VSCROLL = &H115
Public Const SB_ENDSCROLL = 8&
Public Const EM_LINESCROLL = &HB6&
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Long) As Long
LRet = SendMessageLong(h, EM_LINESCROLL, 0&, 0)
'-- (where "h" is the textbox hWnd.)
That might be easiest if you have such a scrollbar.
If you decide to try subclassing you can find
samples online. vbaccelerator.com should be a good
place to start.
Subclassing is very easy to do, and it opens up lots
of options that you don't otherwise have, but it's
also very easy to crash when you're testing with
subclassing in the IDE. In any case, if you can get the
event one way or the other, the EM_LINESCROLL
call is easy to do.
I happen to be sitting around with a cold today,
so I worked up a basic subclass sample. The problem
with subclassing is that if the IDE breaks for an error
then the whole thing crashes. VBAccelerator has a
DLL to help with that. Matthew Curland also provides
a DLL and some good subclassing tips in his book
"Advanced Visual Basic 6". Using a DLL you can fix it
so that VB won't crash as long as you don't end a
test run with an error. In other words, if the IDE breaks
for an error you have to either fix or comment out the
problem code before ending the test run. Then you
won't crash. Without the DLL, any error causing a break
will result in an immediate crash.
Getting into subclass optimizing might be more than
you want to deal with right now. In that case, the best
approach is just to comment out the call to the Hook
sub on Form.Load while you work on your code. Only
uncomment it when you know everything is working
well and you're ready to compile.
Basically, the way it works is that each window (form,
textbox, etc.) gets a steady stream of messages, from
Windows, from the parent form, from your SendMessage
calls, etc. What a subclass does is to reroute those
messages to detour through your custom "WindowProc"
function. (WindowProc is just the traditional name. You
can call it anything.) In most cases you then send the
messages on to the target window, unless you intend to
completely replace that window's response to the message.
When you use something like a textbox the messages
are normally all hidden. VB is handling them. (Many of the
methods of controls, like Textbox.SelStart, are just wrappers
around SendMessage calls.) Because of that, your access to the
control is limited by the methods and properties that the
control "exposes". By subclassing you can access the window
(which the control wraps) directly.
In the sample code here the subclass only does the one thing
that you want. It watches for an SB_ENDSCROLL message and
then makes the EM_LINESCROLL call. If desired it could include
an extensive Select Case to create custom handling of mouse
clicks, keyboard events, etc.
The module code here must be in a .bas module separate from
your form. Aside from the declares, it includes the Hook, Unhook,
and WindowProc functions. It also includes the public variable,
LHook, that holds the address of the windows message handling
function.
You call Hook after the form is loaded, to set up your intercept
of the window messages. You MUST call unhook before closing
the form. Here that's done in Form.QueryUnload. If you use a
Sub Main and a module-based close-down then you might need
to act based on the UnloadMode value, but that's another issue.
'-- This code goes in form F1, which has a multi-line textbox
'-- named T1.
'-- Watch out for wordwrap and funky email carriage
'- return characters. ---------
Option Explicit
Private Sub Form_Load()
Hook T1.hwnd
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unhook T1.hwnd
End Sub
'---------- This code goes in a .bas module: ---------
Option Explicit
Private Const GWL_WNDPROC = -4
Private Const WM_VSCROLL = &H115
Private Const SB_ENDSCROLL = 8&
Private Const EM_LINESCROLL = &HB6&
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal
wparam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wparam As Long, ByVal lParam
As Long) As Long
Public LHook As Long '--handle for subclass, stores address of original
message handler.
Public Sub Hook(HWnd1 As Long) '--subclass textbox.
If (LHook = 0) Then
LHook = SetWindowLong(HWnd1, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Public Sub Unhook(HWnd1 As Long)
Dim LRet As Long
'-- Set the message handler back to the original.
If (LHook <> 0) Then
LRet = SetWindowLong(HWnd1, GWL_WNDPROC, LHook)
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal
wparam As Long, ByVal lParam As Long) As Long
Dim LRet As Long
Select Case uMsg
Case WM_VSCROLL
'-- If low word is SB_ENDSCROLL then line up top line in textbox.
If (wparam And &HFFFF&) > &H7FFF Then
LRet = (wparam And &HFFFF&) - &H10000
Else
LRet = wparam And &HFFFF&
End If
If (LRet = SB_ENDSCROLL) Then
LRet = SendMessageLong(hwnd, EM_LINESCROLL, 0&, 0)
' debug.print "ok" '-- (test the message.)
End If
Case Else
'--
End Select
'--pass on messages to the textbox.
WindowProc = CallWindowProc(LHook, hwnd, uMsg, wparam, lParam)
End Function
'---------- end code. ------------
Note: I did this with a plain, multi-line textbox. In my test
the textbox seems to always line itself up anyway, without
the EM_LINESCROLL call. A RichTextBox seems to act the
same way. But I have found -- at least with a RichTextBox --
that when I programmatically act on the RTB it does not
necessarily always end up with the top line evenly lined up
with the top of the window at the end of scrolling movement.
That problem is what the EM_LINESCROLL call fixes.
You're welcome. Nice to know I got something
useful done on my day home sick. :)
I am not sure exactly what you are trying to do, but there are messages that
you can send to the text box to get additional information without
subclassing. Here is a partial list:
EM_LINEINDEX
EM_GETFIRSTVISIBLELINE
EM_LINEFROMCHAR
EM_CHARFROMPOS
EM_POSFROMCHAR
EM_GETLINECOUNT
The following sample shows how to get the current Row, Col of the caret
position if there was no selection, or the start of the selection. To try
it, add a TextBox, set Mutiline to True, and add a Timer and set Interval to
500.
Option Explicit
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETRECT = &HB2
Private Const EM_GETSEL = &HB0
Private Const EM_GETTHUMB = &HBE
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINESCROLL = &HB6
Private Const EM_SCROLL = &HB5
Private Const EM_SCROLLCARET = &HB7
Private Const EM_SETRECT = &HB3
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
' Returns the Row and Column of caret position if there was no selection, or
the start of the selection. Both are 1 based
Private Sub GetCaretPos(ByVal txt As TextBox, ByRef Row As Long, ByRef Col
As Long)
Dim iFirstCharInCurrentLine As Long ' 0 Based
Dim iCurrentLine As Long ' 1 Based
iCurrentLine = 1 + SendMessage(txt.hwnd, EM_LINEFROMCHAR, -1, ByVal 0&)
iFirstCharInCurrentLine = SendMessage(txt.hwnd, EM_LINEINDEX,
iCurrentLine - 1, ByVal 0&)
Row = iCurrentLine
Col = txt.SelStart - iFirstCharInCurrentLine + 1
End Sub
Private Sub Timer1_Timer()
Dim Row As Long
Dim Col As Long
GetCaretPos Text1, Row, Col
Debug.Print "Row, Col = " & Row, Col
End Sub
Thanks expvb. I'm writing a self formating textbox. If the user
presses an up or down key, the text refreshes in order to provide
feedback. If the line is accepted the program adds padding spaces,
capitals, colors, etc to the text. Else the line is painted red.
The issue I was dealing with was the fact that the text would jump a
few pixels after each refresh, making the feedback less useful because
the connection with the original input was lost.
That method shouldn't crash anything. It sounds like
you may have neglected to use separate public variables
in your hook function(s). If you don't figure it out then
you might want to post your code.