470,810 Members | 1,975 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 470,810 developers. It's quick & easy.

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

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.POINTE R_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_FON T,
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
-------------------------
VB .Net code till here.
-------------------------
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 21 '05 #1
5 10670
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

Atara wrote:
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.POINTE R_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_FON T,
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
-------------------------
VB .Net code till here.
-------------------------
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Nov 21 '05 #2
Yes, I am trying to highlight certain text strings.

I will appreciate any code sample.
Thanks
Atara

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 21 '05 #3
I would be interested to see this code. Could you post it please?

--

Bob

--------------------------------------
I'll have a B please Bob.

"Marc Cramer" <cr*******@comcast.net> wrote in message
news:7P********************@comcast.com...
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

Atara wrote:
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.POINTE R_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_FON T,
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
-------------------------
VB .Net code till here.
-------------------------
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Nov 21 '05 #4
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()
'================================================= ===========================================
Marc Cramer

Bob Hollness wrote: I would be interested to see this code. Could you post it please?

Nov 21 '05 #5

Thank you for your code sample.
Atara.
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 21 '05 #6

This discussion thread is closed

Replies have been disabled for this discussion.

Similar topics

4 posts views Thread by _B | last post: by
3 posts views Thread by ddd | last post: by
9 posts views Thread by Marina | last post: by
6 posts views Thread by Joerg Battermann | last post: by
3 posts views Thread by Mike | last post: by
reply views Thread by mihailmihai484 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.