text highlighter 8

[chinedu]

hello everyone,
I need a word highlighting script.
Does anyone know where I can find a sample.

The way I need to use this script is this:

I enter a word, say "ABC", if "ABC" exists on our database, all records associated with "ABC" will be displayed and the word "ABC" will be highlighted.

Any help would be greatly appreciated.
Thanks in advance

 

[Ayac]

Go thorough the document using InStr() to find the first string, replace it with a highlighted version, save it in another string then chop off the highlighted stuff from the original and continue until you are at the end of the string.

Here is an example, something like this should work (it highlights the first 300 words it finds):

PageIn = "WhateverYouHaveinYourDatabaseToHighlight"
SearchTerm = "ABC"
t=1

for i=1 to 300
TempoJusto = right(PageIn,t)
StartNum = InStr(UCase(TempoJusto),UCase(SearchTerm))
If StartNum <> 0 Then
Temp3 = mid(TempoJusto,len(left(TempoJusto,StartNum)),len(SearchTerm))
Temp2 = "<a name='L" & i & "'></a><span style='color:red;font-weight:bold;background-color:#FFFFCC'>" & Temp3 & "</span>"
HighlightedText = HighlightedText & left(TempoJusto,StartNum - 1) & Temp2 & mid(TempoJusto,(StartNum + len(SearchTerm)),25)
t=len(TempoJusto) - len(SearchTerm) - StartNum - 24
End If
Next

If len(HighlightedText)-t < len(PageIn) Then
HighlightedText = HighlightedText + right(PageIn,t)
End If

Response.Write HighlightedText

 

[ChrisHirst]

here's one I prepared earlier
(actually I swapped my CSS class for the inline style)

function HighLight(TextIn,txtToHighlight)
dim temp

temp = replace(TextIn,txtToHighlight,"<span style='color:red;font-weight:bold;background-color:#FFFFCC'>" & txtToHighlight & "</span>") 

HighLight = temp

end function

Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[chinedu]

Thanks Chris and Ayac, I appreciate your help.
But forgive my slow uptake but I am going to be pulling records from the database.
If I enter, as indicated earlier, a keword like ABC which will be searching for company info with company name, I want that ABC highlighted.
I am having problem determining how to use the code you guys provided.

 

[ChrisHirst]

response.write HighLight(objRS.fields("fieldname"),Keyword)

Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[chinedu]

Thanks again Chris,

I ran the code (see below)
and this error:

Microsoft VBScript runtime (0x800A000D)
Type mismatch: 'HighLight'

<script language="javascript">
function HighLight(TextIn,txtToHighlight)
dim temp

temp = replace(TextIn,txtToHighlight,"<span style='color:red;font-weight:bold;background-color:#FFFFCC'>" & txtToHighlight & "</span>")

HighLight = temp

end function
</script>

<%
 response.write HighLight(rstSearch.fields("companyName"),strSearch)
%>

 

[chinedu]

Hi Chris,
I take my statement back that I was getting an error.
I was using it incorrectly.
It is now working, however, I was hoping for a word higlight.
In other words, if they type highlight, I would like to see highlight highlighted.
Is that possible?

 

[ChrisHirst]

as you must have worked out my code is server side vbScript.

It was originally written for a visitor tracking DB script to highlight user-agents and search engine referers.

What is does is to highlight a matching sequence of characters, even if this is part of a longer word so a search for "website" would result in

[COLOR=red yellow]website[/color]
and
[COLOR=red yellow]website[/color]designer

it's possible to write a better script that would only highlight if the preceding and following characters of the match were spaces.
may take a little thought though!



Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[DreXor]

this is another highlight function that you may like as well, works kind of like google's toolbar highlight, not only highlights the entire search context but each word of the phrase seperately. just in case you search for "The Abc Co" instead of just "abc"

<%
' used to highlight text midstream in HTML code GREAT for search results, 
' just highlight the output values with the search item, contains support 
' for multi worded search results as in "yellow hump-backed whales" 
' it'll highlight each portion of the search phrase in the output of the page
' Junk is the mass text, Item is the search phrase, 
' highlightcolor is standard HTML Hex numbers without the # like "FF0000" for red

Function Highlight(Junk,Item,HighlightColor) 
On Error Resume Next
    HighlightTemp = Junk
    StartPoint = InStr(Ucase(Junk),UCASE(Item))
'    response.write "|" & Startpoint & "|unsplit<br>"
    If StartPoint > 0 then
        SPStr = Mid(Junk,StartPoint,Len(Item))
        HighlightTemp = Replace(HighlightTemp,SPStr,"<span style=""background-color : #" & HighlightColor & """>"&SPStr&"</span>")
    End If
    If Instr(item," ") > 0 Then
        HighlightArr = Split(Item," ") 
        HighlightTemp = Junk
        For HighlightArrVar = 0 to Ubound(HighlightArr)
            StartPoint = InStr(Ucase(HighlightTemp),UCASE(HighlightArr(HighlightArrVar)))
'            response.write "|" & Startpoint & "|" & HighlightArr(HighlightArrVar) & "<br>"
            If StartPoint > 0 then
                SPStr = Mid(HighlightTemp,StartPoint,Len(HighlightArr(HighlightArrVar)))
                HighlightTemp = Replace(HighlightTemp,SPStr,"<span style=""background-color : #" & HighlightColor & """>"&SPStr&"</span>")
            End If
        Next
    ElseIf Instr(item,",") > 0 Then
        HighlightArr = Split(Item,",")
        HighlightTemp = Junk
        For HighlightArrVar = 0 to Ubound(HighlightArr)
            StartPoint = InStr(Ucase(HighlightTemp),UCASE(HighlightArr(HighlightArrVar)))
'            response.write "|" & Startpoint & "|" & HighlightArr(HighlightArrVar) & "<br>"
            If StartPoint > 0 then
                SPStr = Mid(HighlightTemp,StartPoint,Len(HighlightArr(HighlightArrVar)))
                HighlightTemp = Replace(HighlightTemp,SPStr,"<span style=""background-color : #" & HighlightColor & """>"&SPStr&"</span>")
            End If
        Next
    End If
    If HighlightTemp <> "" then
        Highlight = HighlightTemp
    Else
        Highlight = Junk
    End If
End Function
%>

 

[ChrisHirst]

ok have fun with these

2 functions, one to highlight, one simple RegExp to check if the word has a full stop (period) or a comma following it.

<%
function HighLight(TextIn,TextToHighlight)
dim i,WordArr,TextOut,bHL
const HLStyle = "<span style='color:red;font-weight:bold;background-color:#FFFFCC'>"

WordArr = Split(TextIn," ")
for i = 0 to Ubound(WordArr)
bHL = False
	if WordArr(i) = TextToHighlight then bHL = True ' highlight this word 
	if PunctMarks(right(WordArr(i),1),"[.,]") then	'check for full stop or comma
		if TextToHighlight = left(WordArr(i),len(WordArr(i))-1) then bHL = True
		' if word matches ignoring the last char highlight it
	end if

	if bHL then
		TextOut = TextOut & " " & HLStyle & WordArr(i) & "</span>"
	else
		TextOut = TextOut & " " &  WordArr(i)
	end if
next
HighLight = TextOut
end function

function PunctMarks(strIn, Pattern)
dim objRE
set objRE = New RegExp 
objRE.pattern = Pattern

PunctMarks = objRE.Test(strIn)

end function
%>

this could of course be easily expanded to check for a match in a longer word and change the highlight colour accordingly.




Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[ChrisHirst]

DreXor you get a star from me for your code.



Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[ChrisHirst]

ok so I decided to add the extra myself.

function HighLight(TextIn,TextToHighlight,bAll)
dim i,WordArr,TextOut,bHL,bHL2

const HLStyle = "<span style='color:red;font-weight:bold;background-color:#FFFFCC'>"
const HLStyle2 = "<span style='color:blue;font-weight:bold;background-color:silver'>"

WordArr = Split(TextIn," ")
for i = 0 to Ubound(WordArr)
bHL = False
bHL2 = False
	if WordArr(i) = TextToHighlight then bHL = True ' highlight this word 
	if PunctMarks(right(WordArr(i),1),"[.,]") then	'check for full stop or comma
		if TextToHighlight = left(WordArr(i),len(WordArr(i))-1) then bHL = True
		' if word matches ignoring the last char highlight it
	end if
	if bAll then 
	' highlight all instances
	if InStr(WordArr(i),TextToHighlight) <> 0 then bHL2 = True
	end if
	
	if bHL then
		TextOut = TextOut & " " & HLStyle & WordArr(i) & "</span>"
	elseif bHL2 then
		TextOut = TextOut & " " & HLStyle2 & WordArr(i) & "</span>"
	else
		TextOut = TextOut & " " &  WordArr(i)
	end if
next
HighLight = TextOut
end function

three parameters in the function call now

HighLight(TextIn,TextToHighlight,bAll)

TextIn string to be parsed
TextToHighlight string to parse for
bAll a boolean to determine all if instances should be highlighted.



Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[chinedu]

You guys are great, 2 stars to both of you for showing off your good stuff.

My problem, as an as indoctrinee is I have minimal understanding of how to call functions.

How should I call this function?
Chris, I know you showed how the call should be called:

HighLight(TextIn,TextToHighlight,bAll)

but given that this is my code:

<%
 response.write HighLight(rstSearch.fields("companyName"),strSearch)
%>

Chris, I know your first code is working for me but I can definitely use some of the stuff you and Drxor have been able to produce.
So how I will replace the way I was calling your first function with this new one?

 

[ChrisHirst]

you call it in just the same way. Calling UDFs (User Defined Functions) is no different to calling Built-in Functions such as lcase(string) or mid(string,start,length) etc.

so to write the function output on to the page is;

<%
dim AllText
AllText = True  'or False for individual words.

response.write HighLight(rstSearch.fields("companyName"),strSearch,AllText)
%>

or to assign the highlighted text to a variable would be

<%
dim newtext
dim AllText
AllText = True

newtext = HighLight(rstSearch.fields("companyName"),strSearch,Alltext)
%>

Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[chinedu]

Chris,
I tried the new code and got this error:

Microsoft VBScript runtime (0x800A000D)
Type mismatch: 'PunctMarks'
/DirectorySearch/DirectorySearch.asp, line 78


I also tried Drexor's but didn't get any errors but it didn't do anything.

 

[ChrisHirst]

is the PunctMarks() function code in an included file ?



Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems

 

[siena]

No,
I put it right after function HighLight()

If it should be an include file,
will be included the same way as:
<!-- #include file =" what should it be called?" -->

 

[chinedu]

I see we are sharing codes, it is ok.

Chris,
should the function be in an include file?

 

[chinedu]

Ok, Chris,
It is working so beautifully now.
Again, thank you for sharing your great knowledge.

 

[ChrisHirst]

if you only need it in the one page it will be fine above or below the <html> and inside the script delimiters.

A Type mismatch on the function name indicates an undefined name, so you are looking for a spelling error or the function is defined outside the delimiters.





Chris.

Indifference will be the downfall of mankind, but who cares?

http://www.candsdesign.co.uk

A website that proves the cobblers kids adage.

http://www.cram-system.com

Nightclub counting systems