convert to VB .Net code - Highlight text using mshtml.IMarkupServices

A

Atara

I am trying to convert the following code to VB .Net, I still have some
gaps (the lines that are marked with (*))
and also I need an ending condition for the while loop.

any help would be appreciated.

Thanks. Atara.

-------------------------
Original code:
-------------------------

void highLight(IHTMLDocumentPtr doc, const CString& highlightText, bool
bHighLight, const CString& highlightAttr)
{
//Usage: highLight(pHTMLDoc, _T("google"), _T("COLOR=#0000ff "));

CComQIPtr<IMarkupServices> pMS;
CComQIPtr<IMarkupContainer> pMC;
CComPtr<IMarkupPointer> ptrBegin, ptrEnd;

_bstr_t attr(highlightAttr);
_bstr_t textToFind(highlightText);

pMS = doc;
pMC = doc;
if(pMS && pMC)
{
pMS->CreateMarkupPointer(&ptrBegin);
pMS->CreateMarkupPointer(&ptrEnd);

ptrBegin->SetGravity(POINTER_GRAVITY_Right);
ptrEnd->SetGravity(POINTER_GRAVITY_Left); // by default

ptrBegin->MoveToContainer(pMC, TRUE);
ptrEnd->MoveToContainer(pMC, FALSE);

while(TRUE)
{ // Find text
HRESULT hr = ptrBegin->FindText(textToFind, 0, ptrEnd, NULL);

if (S_FALSE == hr) break; // did not find the text

IHTMLElementPtr pFontEl;
hr = pMS->CreateElement(TAGID_FONT, attr, &pFontEl); // create
FONT element with attributes for selection
hr = pMS->InsertElement(pFontEl, ptrBegin, ptrEnd); // Insert
created element to context
ptrBegin->MoveToPointer(ptrEnd); // Continue
searching
}
}
}

-------------------------
Original code till here.
-------------------------

-------------------------
VB .Net code:
-------------------------

Dim pMS As mshtml.IMarkupServices = CType(Me.Document,
mshtml.IMarkupServices)
Dim pMC As mshtml.IMarkupContainer = CType(Me.Document,
mshtml.IMarkupContainer)
Dim ptrBegin, ptrEnd As mshtml.IMarkupPointer

Dim flags As UInt32 = Convert.ToUInt32(0)
Dim newAttr As String = " COLOR=#0000ff "

If (Not (pMS Is Nothing) And Not (pMC Is Nothing)) Then
pMS.CreateMarkupPointer(ptrBegin)
pMS.CreateMarkupPointer(ptrEnd)


ptrBegin.SetGravity(mshtml._POINTER_GRAVITY.POINTER_GRAVITY_Right)
ptrEnd.SetGravity(mshtml._POINTER_GRAVITY.POINTER_GRAVITY_Left)

ptrBegin.MoveToContainer(pMC, True) ' (*) Option Strict On
disallows implicit conversions from 'Boolean' to 'Integer'.
ptrEnd.MoveToContainer(pMC, False) ' (*) Option Strict On
disallows implicit conversions from 'Boolean' to 'Integer'.

Dim hr As IntPtr ' HRESULT
Dim pNewElem As mshtml.IHTMLElement ' IHTMLElementPtr

While (True) ' (*) needs break condition instead of hr, since
findText does not return value!
hr = ptrBegin.findText(searchStr, flags, ptrEnd, Nothing)
' (*) searchStr: Value of type 'String' cannot be converted to
'System.UInt16'

If (hr = S_FALSE) Then Exit While
' (*) S_FALSE is not declared,

hr = pMS.createElement(mshtml._ELEMENT_TAG_ID.TAGID_FONT,
newAttr, pNewElem) ' (*) newAttr: Value of type 'String' cannot be
converted to 'System.UInt16'
pMS.InsertElement(pNewElem, ptrBegin, ptrEnd)
ptrBegin.MoveToPointer(ptrEnd)
End While
End If
 
M

Marc Cramer

Hello...
If you are trying to do highlighting of words in an mshtml document such
as find and highlight all instances of "VB.NET" or just highlight the
selected text then I have code I have written to do this, along with the
ability to remove all the current highlights. Asking because I am not
sure what the uses are of IMarkupServices.

If this is what you are referring to let me know and I'll post the code
as a reply to this thread.

Thanks,

Marc Cramer
 
A

Atara

Yes, I am trying to highlight certain text strings.

I will appreciate any code sample.
Thanks
Atara
 
M

Marc Cramer

Here you go...
Let me know if you all have any questions or comments
Friend WithEvents Browser As AxSHDocVw.AxWebBrowser
Private m_HighlightText As ArrayList
'============================================================================================
Friend Sub Highlight(ByVal TextToHighlight As String, Optional ByVal ExactMatchColor As String = "Yellow", Optional ByVal WordMatchColors As String = "lime, aqua, violet, aquamarine, paleturquoise, gold, lavender, wheat, lightgrey, tomato")
' yellow, lime, aqua, violet, aquamarine, paleturquoise, gold, lavender, wheat, lightgrey, tomato
If TextToHighlight.Trim <> "" Then
Dim Bookmark As String = ""
Dim TextRange As mshtml.IHTMLTxtRange = DirectCast(DirectCast(DirectCast(Browser.Document, mshtml.HTMLDocumentClass).body, mshtml.IHTMLBodyElement).createTextRange(), mshtml.IHTMLTxtRange)

' add to highlight list...so we can highlight as we navigate
If ExactMatchColor <> "" Then AddToHighlightList(TextToHighlight)

' if we have multiple words then lets handle one at a time...
If TextToHighlight.Trim.IndexOf(" ") > -1 Then
Dim Counter As Integer = 0
Dim Colors() As String = Split(WordMatchColors.Replace(" ", ""), ",")
Dim Word As String = ""
Dim Words() As String = Split(TextToHighlight.Trim)
For Each Word In Words
If Word.Trim <> "" Then
Do While TextRange.findText(Word.Trim)
' save where we are if needed...
If Bookmark.Trim = "" Then Bookmark = TextRange.getBookmark
' highlight the text
TextRange.execCommand("BackColor", False, Colors(Counter))
' move cursor to end of this selection
TextRange.collapse(False)
Loop
If Bookmark.Trim <> "" Then
' we have a bookmark lets go back to it...
TextRange.moveToBookmark(Bookmark)
' make sure we can see it...
TextRange.scrollIntoView()
End If
' increment the counter to get next color
Counter = Counter + 1
' if we are past the colorlist length start over...
If Counter > Colors.Length - 1 Then Counter = 0
' reset our text range...
TextRange = DirectCast(DirectCast(DirectCast(Browser.Document, mshtml.HTMLDocumentClass).body, mshtml.IHTMLBodyElement).createTextRange(), mshtml.IHTMLTxtRange)
End If
Next Word
End If

' now lets find any exact matches and highlight correctly
Do While TextRange.findText(TextToHighlight.Trim)
' save where we are if needed...
If Bookmark.Trim = "" Then Bookmark = TextRange.getBookmark
' highlight the text
TextRange.execCommand("BackColor", False, ExactMatchColor)
' move cursor to end of this selection
TextRange.collapse(False)
Loop
If Bookmark.Trim <> "" Then
' we have a bookmark lets go back to it...
TextRange.moveToBookmark(Bookmark)
' make sure we can see it...
TextRange.scrollIntoView()
End If
End If
End Sub 'Highlight(ByVal TextToHighlight As String, Optional ByVal ExactMatchColor As String = "Yellow", Optional ByVal WordMatchColors As String = "lime, aqua, violet, aquamarine, paleturquoise, gold, lavender, wheat, lightgrey, tomato")
'============================================================================================
Friend Sub HighlightSelectedText(ByVal HighlightAll As Boolean, Optional ByVal ExactMatchColor As String = "yellow")
Dim TextRange As mshtml.IHTMLTxtRange = DirectCast(DirectCast(DirectCast(Browser.Document, mshtml.HTMLDocumentClass).selection, mshtml.IHTMLSelectionObject).createRange(), mshtml.IHTMLTxtRange)

Do While TextRange.text.EndsWith(" ") = True
TextRange.moveEnd("character", -1)
Loop
Do While TextRange.text.StartsWith(" ") = True
TextRange.moveStart("character", 1)
Loop

If TextRange.text.Trim.Length <> 0 Then
If HighlightAll = False Then
' add to highlight list...so we can highlight as we navigate
AddToHighlightList(TextRange.text)
' highlight it...
TextRange.execCommand("BackColor", False, ExactMatchColor)
Else
Highlight(TextRange.text, ExactMatchColor)
End If
End If
End Sub 'HighlightSelectedText(ByVal HighlightAll As Boolean, Optional ByVal ExactMatchColor As String = "yellow")
'============================================================================================
Private Sub AddToHighlightList(ByVal TextToHighlight As String)
If m_HighlightText.Contains(TextToHighlight) = False Then m_HighlightText.Add(TextToHighlight)
End Sub 'AddToHighlightList(ByVal TextToHighlight As String)
'============================================================================================
Friend Sub RemoveHighlight()
If m_HighlightText.Count > 0 Then
Dim ArrayListEnumerator As IEnumerator = m_HighlightText.GetEnumerator
While ArrayListEnumerator.MoveNext = True
Highlight(DirectCast(ArrayListEnumerator.Current, String), "", "")
End While
m_HighlightText.Clear()
End If
End Sub 'RemoveHighlight()
'============================================================================================
Click to expand...

Marc Cramer
 
Top