gilgalbiblewhee
01-25-2006, 09:33 AM
How do I highlight a split function text?
dim strKeywords, strText, strFore, strAft, bolInComplete
dim Text1, Text2, Text3, Text4, Text5, Text6
dim keywordarray, counter
Text1=Request("Keyword")
Text2=Request("Keywordb")
Text3=Request("Keywordc")
Text4=Request("Keywordd")
Text5=Request("Keyworde")
Text6=Request("Keywordf")
IF Text1<>"" THEN
keywordarray = split(Text1," ")
StrKeywords = StrKeywords & keywordarray(0)
for counter=1 to ubound(keywordarray)
StrKeywords = StrKeywords & " " & keywordarray(counter)
next
response.write StrKeywords
'StrKeywords = StrKeywords & Text1
END IF
IF Text2<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text2
ELSE
StrKeywords = Text2
END IF
END IF
IF Text3<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text3
ELSE
StrKeywords = Text3
END IF
END IF
IF Text4<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text4
ELSE
StrKeywords = Text4
END IF
END IF
IF Text5<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text5
ELSE
StrKeywords = Text5
END IF
END IF
IF Text6<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text6
ELSE
StrKeywords = Text6
END IF
END IF
strFore="<font color=red><b>,<font color=blue><b>,<font color=green><b>,<font color=orange><b>,<font color=purple><b>,<font color=aqua><b>"
strAft="</b></font>"
bolInComplete=true
Do until RS.eof
strText =rs("text_data")
strText=HighlightKeywords(strText,strKeywords, strFore, strAft,bolInComplete)
Response.Write "<sup>" & rs("verse") & "</sup>" & strText & "</br>"
rs.movenext
Loop
else
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,",")
arrstrFore=Split(strFore,",")
' 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(?!>)"
' Else allow for characters following the keyword before the word break.
Else
strPattern ="(?!<)\b(\w*" & arrKeywords(i) &"\w*)\b(?!>)"
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 = arrstrFore(i) & "$1" & strAft
' Call the helper routine.
strText = Highlight(strText,strPattern,strReplace,True)
'response.write arrstrFore(i)
'response.write arrKeywords(i)
Next'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
dim strKeywords, strText, strFore, strAft, bolInComplete
dim Text1, Text2, Text3, Text4, Text5, Text6
dim keywordarray, counter
Text1=Request("Keyword")
Text2=Request("Keywordb")
Text3=Request("Keywordc")
Text4=Request("Keywordd")
Text5=Request("Keyworde")
Text6=Request("Keywordf")
IF Text1<>"" THEN
keywordarray = split(Text1," ")
StrKeywords = StrKeywords & keywordarray(0)
for counter=1 to ubound(keywordarray)
StrKeywords = StrKeywords & " " & keywordarray(counter)
next
response.write StrKeywords
'StrKeywords = StrKeywords & Text1
END IF
IF Text2<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text2
ELSE
StrKeywords = Text2
END IF
END IF
IF Text3<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text3
ELSE
StrKeywords = Text3
END IF
END IF
IF Text4<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text4
ELSE
StrKeywords = Text4
END IF
END IF
IF Text5<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text5
ELSE
StrKeywords = Text5
END IF
END IF
IF Text6<>"" THEN
IF StrKeywords<>"" THEN
StrKeywords =StrKeywords&","&Text6
ELSE
StrKeywords = Text6
END IF
END IF
strFore="<font color=red><b>,<font color=blue><b>,<font color=green><b>,<font color=orange><b>,<font color=purple><b>,<font color=aqua><b>"
strAft="</b></font>"
bolInComplete=true
Do until RS.eof
strText =rs("text_data")
strText=HighlightKeywords(strText,strKeywords, strFore, strAft,bolInComplete)
Response.Write "<sup>" & rs("verse") & "</sup>" & strText & "</br>"
rs.movenext
Loop
else
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,",")
arrstrFore=Split(strFore,",")
' 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(?!>)"
' Else allow for characters following the keyword before the word break.
Else
strPattern ="(?!<)\b(\w*" & arrKeywords(i) &"\w*)\b(?!>)"
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 = arrstrFore(i) & "$1" & strAft
' Call the helper routine.
strText = Highlight(strText,strPattern,strReplace,True)
'response.write arrstrFore(i)
'response.write arrKeywords(i)
Next'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