ActiveX Controls einbinden

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

        ' Find current RTF box
        Dim RTFBox As RichTextLib.RichTextBox
        RTFBox = RTFBoxes.Item(doc.parentWindow)


        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

Dokumentation der ActiveX-Schnittstelle für VB.NET
Für die Microsoft-Controls findet sich die Dokumentation im Internet, meist in MSDN (Microsoft Developer Network). In unserem Fall z.B. in dem Artikel Visual Basic: RichTextBox Control. Die Methoden sind dort für VB6 beschrieben und können identisch in VB.NET verwendet werden.

Anzeige der Scrollbalken im RTF-Control
Generell setzt man die Anzeigeattribute eines Controls am besten in der VB.NET-Routine, die zur Initialisierung aufgerufen wird, in unserem Fall also in der Methode rtf_init. Das funktioniert bei dem RTF-Control allerdings nicht für die Eigenschaft ScrollBars, da diese zur Laufzeit readonly ist. Ausschnitt Dokumentation: