CodeItBetter Programming Another VB Programming Blog

'Controls - How to check on which word the Mouse hover in Rich Text Box

Option Explicit
 
'Add a Rich Text Box and a Label to your form.

Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
    x As Long
    y As Long
End Type
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
 
Public Function RichWordOver(rch As RichTextBox, x As Single, y As Single) As String
    Dim pt As POINTAPI
    Dim pos As Integer, iStartPos As Integer, iEndPos As Integer, iTxtLen As Integer
    Dim ch As String, sText As String
    pt.x = x \ Screen.TwipsPerPixelX
    pt.y = y \ Screen.TwipsPerPixelY
    pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
    If pos <= 0 Then Exit Function
    sText = rch.Text
    For iStartPos = pos To 1 Step -1
        ch = Mid$(rch.Text, iStartPos, 1)
        If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For
    Next iStartPos
    iStartPos = iStartPos + 1
    iTxtLen = Len(sText)
    For iEndPos = pos To iTxtLen
        ch = Mid$(sText, iEndPos, 1)
        If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For
    Next iEndPos
    iEndPos = iEndPos - 1
    If iStartPos <= iEndPos Then RichWordOver = Mid$(sText, iStartPos, iEndPos - iStartPos + 1)
End Function
 
Private Sub Form_Load()
    RichTextBox1.Text = "Some sort of text here ... Some sort of text here ... " & vbCrLf & vbCrLf & "Some sort of text here ... Some sort of text here ... http://codeitbetter.com"
End Sub
 
Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim sText As String
    sText = RichWordOver(RichTextBox1, x, y)
    If Label1.Caption <> sText Then Label1.Caption = sText
End Sub