[RESOLVED] Capture Scroll Event of RichTextBox

[moeur]

I am developing a WYSIWYG editor for this forum which uses a richtextbox so I am going to need something similar to your request. I think this method of inserting a separator line is much better no subclassing or tracking involved.

Public Sub Separator(rtb As RichTextBox, lColor As Long)
    Dim iPos As Long
    Dim strRTF As String
    With rtb
        iPos = .SelStart
        'bracket selection
        .SelText = Chr(&H80) & .SelText & Chr(&H81) ' \'80 \'81
        strRTF = rtb.TextRTF
'add new color
        lColor = AddColorToTable(strRTF, lColor)
'add highlighting
         strRTF = Replace(strRTF, "\'80", "\par\cf" & CStr(lColor) & "\protect ---------------------- Separator ----------------------------- ")
         strRTF = Replace(strRTF, "\'81", "\protect0\cf0\par  ")
 
         .TextRTF = strRTF
        .SelStart = iPos
       End With
End Sub
 
Function AddColorToTable(strRTF As String, lColor As Long) As Integer
Dim iPos As Long, jpos As Long
Dim ctbl As String
Dim tagColors
Dim nColors As Integer
Dim tagNew As String
Dim i As Integer
Dim iLen As Integer
Dim split1 As String
Dim split2 As String
 
    'make new color into tag
    tagNew = "\red" & CStr(lColor And &HFF) & _
        "\green" & CStr(Int(lColor / &H100) And &HFF) & _
        "\blue" & CStr(Int(lColor / &H10000))
    
    'find colortable
    iPos = InStr(strRTF, "{\colortbl")
    
    If iPos > 0 Then 'if table already exists
        jpos = InStr(iPos, strRTF, ";}")
        'color table
        ctbl = Mid(strRTF, iPos + 12, jpos - iPos - 12)
        'array of color tags
        tagColors = Split(ctbl, ";")
        nColors = UBound(tagColors) + 2
        'see if our color already exists in table
        For i = 0 To UBound(tagColors)
            If tagColors(i) = tagNew Then
                AddColorToTable = i + 1
                Exit Function
            End If
        Next i
        
        split1 = Left(strRTF, jpos)
        split2 = Mid(strRTF, jpos + 1)
        strRTF = split1 & tagNew & ";" & split2
        AddColorToTable = nColors
    
    Else
        'color table doesn't exists, let's make one
        iPos = InStr(strRTF, "{\fonttbl") 'beginning of font table
        jpos = InStr(iPos, strRTF, ";}}") + 2 'end of font table
        split1 = Left(strRTF, jpos)
        split2 = Mid(strRTF, jpos + 1)
        strRTF = split1 & "{\colortbl ;" & tagNew & ";}" & split2
        AddColorToTable = 1
    End If
End Function

I'll continue to improve this code, but wanted to get it to you incase you'd rather use it.
I also have code for highlighting and super/sub-scripts too if you need that.

Edit Fixed bug in addcolor function