We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now


Syntax Coloring

s_mccolgan asked
Medium Priority
Last Modified: 2010-04-30

 Below, you will find the method I have used in order
 to do Syntax Coloring (HTML).
 It does have a few problems.
 It only works when the RTF starts a New File,
 if you open a HTML document with it, all is loss,
 it fails to color the current text as well as any text
 the user inputs.
' Form1.rtfTextBox
Private Sub rtfTextBox_Change()
End Sub
 ' In a Module

Public Sub ColorMeHtml()
' Small Portion of Code
    With Form1.rtfTextBox
        If Right$(.Text, 6) = "<html>" Then
            .SelStart = Len(.Text) - 6
            .SelLength = 6
            .SelColor = &H8000&
            .SelStart = Len(.Text)
        ElseIf Right$(.Text, 7) = "<title>" Then
            .SelStart = Len(.Text) - 7
            .SelLength = 7
            .SelColor = vbBlue
            .SelStart = Len(.Text)
        'ElseIf and it goes on...
       End If
    End With
End Sub

 Experts, here is my Question.
 With the above code, how can I continue to do
 Syntax Coloring when I open a files.
 OR for the same amount of points,
 A better Function to do Syntax coloring.
 Must work on Opened files as well as new ones.

 NOTE: Please do NOT post an example DL file that
 searches for start "<" and end ">" and colors what is in   between.
 This is not what I wish to do.
 Thank you.
Watch Question


With Form1.rtfTextBox
  .LoadFile FileToLoad
  For i = 1 To Len(.Text)
    If Mid(.Text, i, 6) = "<html>" Then
      .SelStart = i -1
      .SelLength = 6
      .SelColor = &H8000&
    End If
'other tags go here
End With

I hope this is usefull.



No, NOT at all.
I want to Color Syntax as I type, my example seems to work only on new
files. Fails to color when a file has already been opened.
Remember lads, this is not to be used in your form_load event.
Add my code to a sample project, then start typeing... All ok?
Now clear what you have done and copy paste some HTML or open one.
Now type, all is lost, no color. This is what I want fixed. OR a better function
to do it all.
kponder, thank you for trying but maybe you didn't read the Q. right, or
hey, I hope the above has clarified it.

Unlock this solution with a free trial preview.
(No credit card required)
Get Preview
An improved version:

Public Function GetColor(ByVal sString As String) As Long
sString = LCase(sString)

Select Case sString
    Case "<html>"
        GetColor = &H8000&
    Case "<title>"
        GetColor = vbBlue
    Case "<error>"
        GetColor = vbRed
    Case Else
        GetColor = vbBlack
End Select

End Function

Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)

Dim lStartPos As Long
Dim lEndPos As Long
Dim sUChar As String

Select Case KeyAscii
    Case 8
        'Backspace Key
        lStartPos = Me.RichTextBox1.SelStart + 1
        lEndPos = InStr(lStartPos + 1, Me.RichTextBox1.Text, ">")
        If lEndPos > 0 Then
            SetTextColor Me.RichTextBox1, lStartPos, lEndPos
        End If
        Me.RichTextBox1.SelStart = lStartPos - 1
    Case 60
        ' < character
        lStartPos = Me.RichTextBox1.SelStart + 1
        Me.RichTextBox1.SelText = Chr$(KeyAscii)
        lEndPos = InStr(lStartPos + 1, Me.RichTextBox1.Text, ">")
        If lEndPos > 0 Then
            SetTextColor Me.RichTextBox1, lStartPos, lEndPos
        End If
        KeyAscii = 0
        Me.RichTextBox1.SelStart = lStartPos
    Case 32 To 126
        Me.RichTextBox1.SelText = Chr$(KeyAscii)
        lEndPos = Me.RichTextBox1.SelStart
        lStartPos = GetStartPos(Left$(Me.RichTextBox1.Text, lEndPos - 1))
        If lStartPos > 0 Then
            SetTextColor Me.RichTextBox1, lStartPos, lEndPos
        End If
        KeyAscii = 0
    Case Else
        ' Do Nothing
End Select

End Sub

Function GetStartPos(ByVal sString As String) As Long
Dim boolContinue As Boolean
Dim lStartPos As Long
Dim sCharToCheck As String

    lStartPos = Len(sString)
    boolContinue = True
    While lStartPos > 0 And boolContinue
        sCharToCheck = Mid$(sString, lStartPos, 1)
        Select Case sCharToCheck
            Case "<"
                boolContinue = False
            Case ">"
                lStartPos = 0
                boolContinue = False
            Case Else
                lStartPos = lStartPos - 1
        End Select
    GetStartPos = lStartPos
End Function

Function SetTextColor(oRTF As RichTextBox, ByVal StartPos As Long, ByVal EndPos As Long) As Boolean

Dim sText As String

    EndPos = EndPos + 1
    oRTF.SelStart = StartPos - 1
    oRTF.SelLength = EndPos - StartPos
    sText = oRTF.SelText
    oRTF.SelColor = GetColor(sText)
    oRTF.SelStart = EndPos - 1
    oRTF.SelColor = vbBlack

    SetTextColor = True
End Function

I think this version works a little better.  Check it out.




Could you please tell me why your newer version is better?
What have you done that makes it better?

Thank you
The older version works great when you are just typing along, but if you backtrack and change something it doesn't work correctly.  Say you use the arrow keys to go back and change a tag so it is spelled correctly, I don't think the older verion will fix it.  The file processing of the old version doesn't work quite right, and I haven't been able to figure out why.

Have Fun,
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a free trial preview!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.