Embed ActiveX Controls

Imports guinet
Imports SAPFEWSELib
Imports RichTextLib
Imports SHDocVw

Public Class customer

    Private RTFBox As RichTextLib.RichTextBox

    Public Sub rtf_init(rtf As RichTextLib.RichTextBox, _
               html As SHDocVw.WebBrowser, textname As String)

        ' Appearence
        rtf.BorderStyle = BorderStyleConstants.rtfNoBorder
        rtf.BackColor = RGB(255, 255, 255)


        ' load content from GuiXT long text
        Dim guixt As New guinet.guixt
        rtf.TextRTF = guixt.GetText(textname)

        ' set handler for HTML click
        Dim doc As mshtml.HTMLDocumentClass = html.Document
        AddHandler CType(doc, mshtml.HTMLDocumentEvents2_Event).onclick, _
                       AddressOf WebBrowserClick

        ' Save RTF object in order to find it later on in click handler
        RTFBox = rtf

    End Sub

    Public Sub rtf_get_content(rtf As RichTextLib.RichTextBox, _
                                    textname As String)

        ' read content into GuiXT long text
        Dim guixt As New guinet.guixt
        guixt.SetText(textname, rtf.TextRTF)

    End Sub

    Private Function WebBrowserClick(pEvtObj As mshtml.IHTMLEventObj) As Boolean

       
        ' where did the user click?   
        Dim clickedElement As mshtml.IHTMLElement = pEvtObj.srcElement

        ' search table cell in DOM hierarchy
        While clickedElement IsNot Nothing _
                    AndAlso clickedElement.tagName.ToUpper <> "TD"
            clickedElement = clickedElement.parentElement
        End While

        ' table cell found? else return
        If clickedElement Is Nothing Then
            Return False
        End If


     
        Dim doc As mshtml.HTMLDocumentClass = clickedElement.document

        Select Case clickedElement.id

            Case "bold"
                ' set/delete "bold" 
                If IsDBNull(RTFBox.SelBold) OrElse RTFBox.SelBold = False Then
                    RTFBox.SelBold = True
                Else
                    RTFBox.SelBold = False
                End If

            Case "underline"
                ' set/delete "underline" 
                If IsDBNull(RTFBox.SelUnderline) _ 
                           OrElse RTFBox.SelUnderline = False Then
                    RTFBox.SelUnderline = True
                Else
                    RTFBox.SelUnderline = False
                End If

            Case "italic"
                ' set/delete "italic" 
                If IsDBNull(RTFBox.SelItalic) OrElse RTFBox.SelItalic = False Then
                    RTFBox.SelItalic = True
                Else
                    RTFBox.SelItalic = False
                End If

            Case "bullet"
                ' set/delete "bullet"
                If IsDBNull(RTFBox.SelBullet) OrElse RTFBox.SelBullet = False Then
                    RTFBox.SelBullet = True
                Else
                    RTFBox.SelBullet = False
                End If


            Case Else
                Dim selectedColorRGB As String = _
                          pEvtObj.srcElement.style.backgroundColor

                If Not selectedColorRGB.StartsWith("rgb(") Then
                    Return False
                End If

                ' convert RGB color into integer
                Dim selectedColorInt As Integer = RGBStringToInt(selectedColorRGB)

                ' set/delete color
                If IsDBNull(RTFBox.SelColor) _
                       OrElse RTFBox.SelColor <> selectedColorInt Then
                    RTFBox.SelColor = selectedColorInt
                Else
                    RTFBox.SelColor = RGB(0, 0, 0)
                End If

        End Select

        Return True
    End Function

    Function RGBStringToInt(rgbstring As String) As Integer

        ' color string format is e.g. rgb(128,16,255)
        ' remove "rgb(" And ")"
        rgbstring = rgbstring.Substring(4).Trim(")")

        Dim rgbcomponents() As String = rgbstring.Split(","c)

        Dim R As Integer = CInt(rgbcomponents(0))
        Dim G As Integer = CInt(rgbcomponents(1))
        Dim B As Integer = CInt(rgbcomponents(2))

        ' convert RGB color into integer
        Return ColorTranslator.ToWin32(Color.FromArgb(R, G, B))

    End Function

End Class

Documentation of the ActiveX interface for VB.NET
For the Microsoft controls you can find the documentation in internet, usually in MSDN (Microsoft Developer Network). In our case it is the documentation Visual Basic: RichTextBox Control. The methods are descibed for VB6 an can be used in the same way in VB.NET.

How to display scrollbars in the RTF control
Normally the display attributes of the embedded control can be set in your VB.NET initialization function; in our case this is the method rtf_init. This does not work for the ScrollBars property of the RTF control since it cannot be set at runtime. The Microsoft d ocumentation states: