asked on

Syntax Coloring

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()
ColorMeHtml
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.

kponder

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
Next
End With

I hope this is usefull.

s_mccolgan

ASKER

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.

ASKER CERTIFIED SOLUTION

mkmccreary

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mkmccreary

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
Wend

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.

Later,
Martin

s_mccolgan

ASKER

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

Thank you

mkmccreary

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,
Martin