Create a new module and paste this code into it. Call the module basRichTextFunctions
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basRichTextFunctions
' Written By: C&D Programming Corp.
' Create Date: 10/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
' Message to send to a Rich Text Box Control to get the current character position
' based on the mouse position
Public Const CHAR_POS = 215
Public Type POINTAPI
X As Long
Y As Long
End Type
Public 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 our definition of an alphanumeric. If yours is different, adjust
' this function.
'
Public Function IsAlphaNumeric(sChar As String) As Boolean
sChar = UCase(sChar)
IsAlphaNumeric = ((sChar >= "0" And sChar <= "9") Or _
(sChar >= "A" And sChar <= "Z") Or _
sChar = "_")
End Function
Public Function MouseOverWord(oRichTextBox As RichTextBox, X As Single, Y As Single) As String
Dim tPoint As POINTAPI
Dim lPosition As Long
Dim lStart As Long
Dim lEnd As Long
Dim sCharacter As String
Dim sText As String
' figure out the character position in the RTControl.
tPoint.X = X \ Screen.TwipsPerPixelX
tPoint.Y = Y \ Screen.TwipsPerPixelY
lPosition = SendMessage(oRichTextBox.hWnd, CHAR_POS, 0, tPoint)
' if the no position get outta here.
If lPosition <= 0 Then Exit Function
' get raw text from RTControl.
sText = oRichTextBox.Text
' search backwards for the first non-alphanumeric character
For lStart = lPosition To 1 Step -1
sCharacter = Mid$(oRichTextBox.Text, lStart, 1)
If Not IsAlphaNumeric(sCharacter) Then
Exit For
End If
Next
' search forwards from the position the mouse is over until the first
' non-alphanumeric.
For lEnd = lPosition To Len(sText)
sCharacter = Mid$(sText, lEnd, 1)
If Not IsAlphaNumeric(sCharacter) Then
Exit For
End If
Next
' if there is a word there, parse it out, else return nothing.
If lStart < lEnd Then
MouseOverWord = Mid$(sText, lStart + 1, lEnd - lStart - 1)
Else
MouseOverWord = ""
End If
End Function