Link to home
Start Free TrialLog in
Avatar of team_idc
team_idc

asked on

Have the caret follow the cursor.


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.
Avatar of Mirkwood
Mirkwood

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.
BTW: Do you really think any user understands this feature?
Avatar of team_idc

ASKER

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.
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.


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)


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)

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


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...

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

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.
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.


You should try Irish Booze.

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


Hmmm, the autodrop is cool. No I can force someone to drop the information on me when he dragging over me ROFLOL

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.
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.

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

It is hard to communicate here.
Just click on From: ameba to see my profile

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

Ameba,
is this function functional?

ASKER CERTIFIED SOLUTION
Avatar of ameba
ameba
Flag of Croatia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial