Solved

Have the caret follow the cursor.

Posted on 1998-11-28
20
335 Views
Last Modified: 2011-08-18

Hi fellow VbLings,

Could someone please show me how to have the caret of the
RichTextBox control follow the cursor under the
MouseMove Event.

Please, for the amount of points I am posting here,
have it positioned in the following way.
The bottom of the caret must be placed at the cursors tip
and must not go beyond the actual text.


Thank you.
0
Comment
Question by:team_idc
  • 9
  • 8
  • 3
20 Comments
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447201
Simulate a mouse click at the mouse move message. So check with spy32 which messages are send when clicking on a rich edit control and use sendmessage to send the same message. It will work but it requires some investigation.
0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447202
BTW: Do you really think any user understands this feature?
0
 

Author Comment

by:team_idc
ID: 1447203
I am confused by your comment.

I am looking for something like several API functions.
GetCursorPos returns the cursor position, and ScreenToClient converts it to RTB client coordinates.
Then SendMessage with something to return the character position based on the coordinates. Then something to change the .SelStart property based
on what that SendMessage API function returns.

This probably sounds like the whole answer, but when codeing it,
I can not get it to work.

I can not be that far off though.
0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447204
Do you know the tool spy32? I tell what messages a certain windows receives.
So what you basically want to do it when you mouse the mouse over the rich edit control that it should mouse the caret as when.
Fact is than when you click on the richedit control. The control will move the caret. So what you could do is simulate a click.
So with spy32. See what messages the rich edit control receives when you click on the control. Send this messages to the rich edit control.
A good try may be to send an WM_LBUTTONDOWN with the current coordinates and a WM_LBUTTONUP.

0
 

Author Comment

by:team_idc
ID: 1447205

Mirkwood,
I am sorry, I know you want to help but I do not know of a tool called spy32.
Even though I would know the message sent, I do not know how to even send it.

Mirkwood, do you not think that you method would cause problems to the cursors
movement? I mean, it would always be simulating a click.

However, if you are determind, could you please check it out and tell me what I must do for this to work? (Code wise)


0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447206
You must be the luckiest guy in the world. I did it for you. (I'm currently in Russia for work, but it is saterday and very cold outside)

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447207
Put private before all the declarations:

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long


Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 Const MK_LBUTTON = &H1
Declare Function PostMessageAny Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function PostMessageLong Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim px As Long
    Dim py As Long
    px = (x) / Screen.TwipsPerPixelX
    py = (y) / Screen.TwipsPerPixelY
    PostMessageLong rew, WM_LBUTTONDOWN, 0, px + py * 65536
    PostMessageLong rew, WM_LBUTTONUP, 0, x + px + py * 65536
End Sub

0
 

Author Comment

by:team_idc
ID: 1447208

Mirkwood,
It is really nice of you to take the time to write it out,
however, I must inform that I do not thing that your solution
works very well.
For example, it took a while to open the form because it kept on
clicking and when I tried to type text, well I think it was going faster then me.
Hardly any text appeared.
This is what I asked you before you answered the question...
(read above) "Mirkwood, do you not think that you method would cause problems to the cursors movement?"

To give more information to this question and a chance for you to answer it without someone else taking your points.

The reason for this odd question is due to Microsoft themselves.
They forgot to include the positioning feature in the Manual
Drag & Drop.

In automatic mode, when you drag & drop, you have the caret follow the cursor. Great positioning feature. However,
Auto mode means no control. Therefore, the user can drop an image in something that was meant to be text.
Now, thank god their is the manual mode. We can customize
what we want and what we do not. But what boils me up is
that the positioning feature is gone!
Therefore, user must first click on the RTB, then the treeview
control (for example), the drag and drop anywhere on the RTB,
it does not matter, it will get placed where you first clicked.

Now, Mirkwood and gentlemen, this is crazy!
How do you fix this?

Maybe I have just lost the ball...

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447209
Try the following. The button just turned the tracking on/off. I'm you only need to turn it on when you need it. (On the manual drop)

Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private 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
Private Const MK_LBUTTON = &H1
Private Declare Function PostMessageAny Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function PostMessageLong Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Dim rew As Long
Dim turnedon As Boolean

Private Sub Command1_Click()
    turnedon = Not turnedon
End Sub

Private Sub Form_Load()
    turnedon = False
    rew = FindWindowEx(Me.hwnd, 0, "RichTextWndClass", "")
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (turnedon) Then
        Dim px As Long
        Dim py As Long
        px = (x) / Screen.TwipsPerPixelX
        py = (y) / Screen.TwipsPerPixelY
        PostMessageLong rew, WM_LBUTTONDOWN, 0, px + py * 65536
        PostMessageLong rew, WM_LBUTTONUP, 0, x + px + py * 65536
    End If
End Sub

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447210
Funny, why the hell did I use findwindow to find the window and not simply use richtextbox1.hwnd? I don't know. Must be the Russian dark beer.
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:team_idc
ID: 1447211
Mirkwood,
sending the left click button cause the item to be droped.

I want this type of effect...
Private Sub RichTextBox1_OLEDragOver(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    If Data.GetFormat(vbCFText) Or Data.GetFormat(vbCFFiles) Then
        Debug.Print x
        Debug.Print y
        RichTextBox1.SetFocus
        On Error Resume Next
        x = x / Screen.TwipsPerPixelX / 6
        RichTextBox1.SelStart = x

       
        Effect = vbDropEffectCopy And Effect
       
        Exit Sub
    End If
    Effect = vbDropEffectNone
End Sub


Now, the above code sucks because it works with the X only.
However, when you drag an item, you are able to place where...

But the more you add text... well, the caret gets loses its place.


0
 

Author Comment

by:team_idc
ID: 1447212
You should try Irish Booze.

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447213
You can also use setcaretpos.

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (turnedon) Then
        Dim px As Long
        Dim py As Long
        px = (x) / Screen.TwipsPerPixelX
        py = (y) / Screen.TwipsPerPixelY
        SetCaretPos px, py
    End If
End Sub


0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1447214
Hmmm, the autodrop is cool. No I can force someone to drop the information on me when he dragging over me ROFLOL
0
 

Author Comment

by:team_idc
ID: 1447215

Are you trying your answers Mirkwood?
SetCaretPos only moves it to play with you.
It doesn't really move the caret.
Type or Drop something and you will be back to point A.
0
 
LVL 15

Expert Comment

by:ameba
ID: 1447216
Just checked similar examples:
Treeview and listview:
- to select item (during manual OLEDrag or in MouseMove) we can use
    Set ctl.SelectedItem = ctl.HitTest(x, y)

old Grid Control:
- in Drag example there are functions like
HighlightRowAtPoint(X As Single, Y As Single) or
ApiRectFromPoint(ctl As Grid, X As Single, Y As ...
    ' Loop through each row, accumulating row height until we reach
    ' the row containing the point.
    For curRow = 0 To ctl.Rows - 1
        totHeight = totHeight + ctl.RowHeight(curRow) + ...
.............

RTBox:
- since you cannot use msg WM_LBUTTONDOWN or I also tried mouse_event to set RTBox.SelStart, you must use e.g.:
Function RTFHitTest(RTF As Control, x As Single, y As Single) As Long
' returns position under mouse

' Scenario:
'1. HideCaret
'2. EM_GETFIRSTVISIBLELINE      Gets index of top line in an edit control
'3. EM_LINEINDEX      Retrieves the character index of an MLE line
' now you have position of the first visible character
    RTF.SelStart = pos
' Determine Line:
restart:
'4. use GetCaretPos to get caretx,carety
 if carety < y/15 then
    ' selstart is too small (i.e. caretpos is too high)
    ' curLineno = curLineno + 1
    ' determine position for next line (using EM_LINEINDEX)    
    RTF.SelStart = pos
    goto restart
 else
    ' we found the line
 endif

' Determine Character in line:
' start from first character in line, set Selstart, use getcaret and compare to x/15, loop until caretx > x/15.
' If x condition has not been reached, set the last character in line, to be the result (!)
    ShowCaret
End Function

' usage (in event which gives x, y)
RTBox.SelStart = RTFHitTest(RTBox, x, y)   'or similar

team_idc, will you try this scenario?
ameba

PS
HideCaret is used, because better no one see what is happenning with Caret position.
0
 

Author Comment

by:team_idc
ID: 1447217

I will try it right now.
However,
would you be so kind in posting your email?

It is hard to communicate here.
0
 
LVL 15

Expert Comment

by:ameba
ID: 1447218
Just click on From: ameba to see my profile

I will also try "scenario". Hm, not sure if wordwrap will influence. Looks complicated.
0
 

Author Comment

by:team_idc
ID: 1447219

Ameba,
is this function functional?

0
 
LVL 15

Accepted Solution

by:
ameba earned 500 total points
ID: 1447220
' References:
' http://leb.net/wine/WinDoc/msdn/sdk/platforms/doc/sdk/win32/mess/src/msg04_9.htm
' http://support.microsoft.com/support/kb/articles/q137/8/05.asp
' Start new vb project
' Go to Components and check "Microsoft Rich Text Control"
' To your default form add 1 command button, set property Cancel=True
' and 1 Rich Text Control
' Paste this code
Option Explicit
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Const EM_CHARFROMPOS = &HD7
Private Declare Function SendMessagePT Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Long, ByVal msg As Long, _
       ByVal wParam As Long, ByRef lParam As POINTAPI) As Long
Private midcMode As Boolean

Private Sub Command1_Click()
    midcMode = Not midcMode
    If midcMode Then
        RichTextBox1.SetFocus
    Else
        Command1.SetFocus
    End If
End Sub

Private Sub Form_Load()
    Command1.Caption = "idc Mode"
    ' add some text
    RichTextBox1.FileName = "c:\config.sys"
    RichTextBox1.Text = RichTextBox1.Text & RichTextBox1.Text & RichTextBox1.Text
End Sub

Private Sub RichTextBox1_LostFocus()
    midcMode = 0
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Static exc As Boolean
    Dim pos As Long
    If exc Then Exit Sub
    exc = True
    If midcMode And x > 0 And x < RichTextBox1.Width And _
                    y > 0 And y < RichTextBox1.Height Then
        Dim px As Integer, py As Integer
        px = Screen.TwipsPerPixelX
        py = Screen.TwipsPerPixelY
        Dim pt As POINTAPI
        pt.x = x / px
        pt.y = y / py
        pos = SendMessagePT(RichTextBox1.hwnd, EM_CHARFROMPOS, 0&, pt)
        Debug.Print pos
        If pos > -1 Then
            RichTextBox1.SelStart = pos
        End If
    End If
    exc = False
End Sub


0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now