**NB: I use tx Text Control but you can use a RTF control instead. Pass in the current position of the cursor and the entire text in the text control **
Private Function Boundaries(ByVal lngPos As Long, _
ByVal strBound As String, _
ByRef lngStart As Long, _
ByRef lngEnd As Long) As Boolean
On Error GoTo errorHandler
' **********************************************
' Returns the boundaries, specified by strBound
' Failure returns FALSE and -999 for start & end
' Fails if the lngPos is not found.
' **********************************************
' Notes:
' Empty document = 0 chars.
Dim lngDocEnds As Long
Dim strSearchTable As String
Dim LastChar As String
Boundaries = False
lngStart = -999
lngEnd = -999
Const cFormFeed As Long = 12
Const cCarriageRet As Long = 13
Const cVerticalTab As Long = 11
Const cLineFeed As Long = 10
Const cParagraphMark As Long = 80
Const cQMark As Long = 63
Const cExclamation As Long = 33
Const cFullStop As Long = 46
' Quit if an empty doc is detected.
If LenB(txCtl.Text) = 0 Then
Exit Function
End If
' Get last character in document
lngDocEnds = Len(txCtl.Text)
' Quit if current position passed is invalid.
txCtl.SelStart = lngPos ' Attempts to set the cursor to passed pos.
If txCtl.SelStart <> lngPos Then
Exit Function
End If
Select Case UCase$(strBound)
Case "SENTENCE"
' Notes:
' START <<:
' 1st printable char in doc.
' OR 1st char following a:
' <LF>, <FF>
' <.>, <?>, <!>, <;>
' OR any of the above plus <spc>
If lngPos = 1 Then
' Already at start of document.
lngStart = 0
Else
strSearchTable = vbLf & Chr(cFormFeed) & "." & "?" & "!" & ";"
lngStart = InStrTbl(txCtl.Text, strSearchTable, lngPos, -1, LastChar)
End If
' END >>:
' <.>, <?>, <!>, <:>, <;>
' <VT>, <LF>
If lngPos = lngDocEnds Or lngPos = (lngDocEnds - 1) Then
' Already at end of document
' or just before the terminating <LF>
lngEnd = lngDocEnds - 1
Else
strSearchTable = vbLf & Chr(cVerticalTab) & "." & "?" & "!" & ":" & ";"
lngEnd = InStrTbl(txCtl.Text, strSearchTable, lngPos, 1, LastChar)
End If
Case "PARAGRAPH"
' Notes:
' START <<:
' 1st printable char in doc.
' OR 1st char following a:
' <LF>, <FF>, <VT>
If lngPos = 1 Then
' Already at start of document.
lngStart = 0
Else
strSearchTable = vbLf & Chr(cFormFeed) & Chr(cVerticalTab)
lngStart = InStrTbl(txCtl.Text, strSearchTable, lngPos, -1)
If lngStart <> 0 Then lngStart = lngStart
End If
' END >>:
' <VT>, <LF>
If lngPos = lngDocEnds Or lngPos = (lngDocEnds - 1) Then
' Already at end of document
' or just before the terminating <LF>
lngEnd = lngDocEnds
Else
strSearchTable = vbLf & Chr(cVerticalTab)
lngEnd = InStrTbl(txCtl.Text, strSearchTable, lngPos, 1)
End If
End Select
Boundaries = True
Exit Function
errorHandler:
lngStart = -999
lngEnd = -999
Boundaries = False
End Function
Function InStrTbl(Source As String, SearchTable As String, _
Optional PositionStart As Long = 1, _
Optional Direction As Integer = 1, _
Optional LastChar As String = vbNullString) As Long
' Returns the position of the first match of a string from the search table
Dim counter As Long
Dim localStart As Long
Dim localEnd As Long
If Direction = -1 Then
localEnd = 1
localStart = PositionStart - 1
Else
localEnd = Len(Source)
localStart = PositionStart + 1
End If
For counter = localStart To localEnd Step Direction
If InStr(1, SearchTable, Mid$(Source, counter, 1), vbTextCompare) Then
LastChar = Mid$(Source, counter, 1)
InStrTbl = counter
Exit For
End If
Next counter
End Function