View Full Version : highlight a section of words only

03-07-2006, 06:42 PM
This code highlights words entirely. I look for the word nation it highlights words like abomination. So I only want the function to highlight whatever I'm looking for.

dim strKeywords, strText, strFore, strAft, bolInComplete
dim Text1, Text2, Text3, Text4, Text5, Text6
dim keywordarray, counter


Do until RS.eof
strText =rs("text_data")

IF Text1<>"" THEN
strFore="<font color=red><b>"
strText=HighlightKeywords(strText,Text1, strFore, strAft,bolInComplete)
End If
IF Text2<>"" THEN
strFore="<font color=blue><b>"
strText=HighlightKeywords(strText,Text2, strFore, strAft,bolInComplete)
End If
IF Text3<>"" THEN
strFore="<font color=green><b>"
strText=HighlightKeywords(strText,Text3, strFore, strAft,bolInComplete)
End If
IF Text4<>"" THEN
strFore="<font color=orange><b>"
strText=HighlightKeywords(strText,Text4, strFore, strAft,bolInComplete)
End If
IF Text5<>"" THEN
strFore="<font color=purple><b>"
strText=HighlightKeywords(strText,Text5, strFore, strAft,bolInComplete)
End If
IF Text6<>"" THEN
strFore="<font color=aqua><b>"
strText=HighlightKeywords(strText,Text6, strFore, strAft,bolInComplete)
End If

Response.Write "<sup>" & rs("verse") & "</sup>" & strText & "</br>"


response.write "No verses found"
End If

Function HighlightKeywords(byVal strText, byRef strKeywords, byRef strFore, byRef strAft, byVal bolInComplete)

' Dim the variables.
dim arrKeywords
dim strPattern, strReplace
dim i
dim arrstrFore
' Split the list of keywords into an array for easy iteration.
arrKeywords = Split(strKeywords,"/")

' Loop through the array of keywords and build the strings needed for the highlighting.
For i=0 to UBound(arrKeywords,1)
' Build the pattern string. Basically what we are saying is:
' Find all instances of this word that are distinct words not in pointed brackets.

' If we are not to find incomplete words then use the rigid pattern.
If Not bolInComplete Then
strPattern ="(?!<)\b(" & arrKeywords(i) & ")\b(?!>)"
'strPattern = arrKeywords(i)
' Else allow for characters following the keyword before the word break.
strPattern ="(?!<)\b(\w*" & arrKeywords(i) & "\w*)\b(?!>)"
'strPattern =arrKeywords(i)
End If

' Build the replace string. This tells the regexp what to replace the instances found
' with. We use the $1 to say: Use the value that was there. This is good for use when
' you don't want to change the case of the existing word.
strReplace = strFore & "$1" & strAft
'strReplace = "$1"

' Call the helper routine.
strText = Highlight(strText,strPattern,strReplace,True)

'response.write arrstrFore(i)
'response.write arrKeywords(i)


' Return the newly formatted string.
HighlightKeywords = strText
End Function

Function Highlight(byVal strText, byRef strPattern, byRef strReplace,byRef bolIgnoreCase)

' Dim the Variables
dim mobjRegExp
dim i

' Initialize the Regular Expressions Object.
Set mobjRegExp = New RegExp

' Set it to find all matches.
mobjRegExp.Global = True

' This parameter tells RegExp if it should be case sensitive or insensitive.
' This is a parameter that should be specified by the calling function.
mobjRegExp.IgnoreCase = bolIgnoreCase

' The pattern to find. This is the most difficult part of using RegExps.
mobjRegExp.Pattern = strPattern

' Call the replace method of the RegExp object. This will do all the work.
strText = mobjRegExp.Replace(strText,strReplace)

' Kill the object.
Set mobjRegExp = Nothing

' Return the newly formatted string.
Highlight = strText
End Function


03-08-2006, 01:47 PM
Try this:

Function Highlight(str)
If IsEmpty(str) Or IsNull(str) Then Exit Function
Str = Replace(str,request.form("word"),"<font color=red>" & request.form("word") & "</font>")
Highlight = Str
End Function

06-23-2006, 05:57 AM
I don't know if I accidentally play around with the script. But now it's showing error:

Microsoft VBScript runtime error '800a139a'
Unexpected quantifier
/wheelofgod/showverse.asp, line 210
Line 210 shows:

strText = mobjRegExp.Replace(strText,strReplace)

06-23-2006, 01:30 PM
I don't know if this is what you meant for but try this code:

Function HighlightText(text, keyword)
Str = Replace(text, keyword, "<font color=red>" & keyword & "</font>")
HighlightText = Str
End Function

Oops, I didn't see that i've already replied to this post with the same code...

And about your error.
I don't know how to fix it sorry :/