Public Sub HTMLHighlight(rtfBox As RichTextBox)
'// SHL für HTML Editor
Dim sPos As Long
Dim ePos As Long
Dim curpos As Long
 
curpos = rtfBox.SelStart
 
With rtfBox
 
    '// Normale Tags
    sPos = 0
    Do
        sPos = .Find("<", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(">", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cTags
                sPos = ePos
            End If
        End If
    Loop Until sPos < 1
 
    '// Grafiken
    sPos = 0
    Do
        sPos = .Find("<img", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(">", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cImage
                sPos = ePos + 4
            End If
        End If
    Loop Until sPos < 1
 
    '// Links
    sPos = 0
    Do
        sPos = .Find("<a href", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(">", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cLink
                sPos = ePos + 7
            End If
        End If
    Loop Until sPos < 1
    HTMLTag rtfBox, "</a>", cLink
 
    '// Tabellen
    sPos = 0
    Do
        sPos = .Find("<table", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(">", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cTable
                sPos = ePos + 6
            End If
        End If
    Loop Until sPos < 1
    HTMLTag rtfBox, "<td>", cTable
    HTMLTag rtfBox, "</td>", cTable
    HTMLTag rtfBox, "<tr>", cTable
    HTMLTag rtfBox, "</tr>", cTable
    HTMLTag rtfBox, "</table>", cTable
 
    '// Kommentar
    sPos = 0
    Do
        sPos = .Find("<!--", sPos + 1)
        If sPos > 0 Then
            ePos = .Find("-->", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cComment
                sPos = ePos + 4
            End If
        End If
    Loop Until sPos < 1
 
    '// Skript
    sPos = 0
    Do
        sPos = .Find("<script", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(">", sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos + 1
                .SelColor = cScript
                sPos = ePos + 7
            End If
        End If
    Loop Until sPos < 1
    HTMLTag rtfBox, "</script>", cScript
 
    '// Farbcodes
    sPos = 0
    Do
        sPos = .Find("#", sPos + 1)
        If sPos > 0 Then
            ePos = .Find(ST, sPos + 1)
            If ePos > 0 Then
                .SelStart = sPos
                .SelLength = ePos - sPos
                    'Keine zu langen Codes
                    If .SelLength > 7 Then .SelLength = 7
                .SelColor = cColors
                sPos = ePos + 1
            End If
        End If
    Loop Until sPos < 1
 
    'Alte Cursorposition und Farbe
    .SelStart = curpos
    .SelColor = cText
End With
 
End Sub