Solved

Syntax Coloring

Posted on 1998-11-01
6
214 Views
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()
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.
0
Comment
Question by:s_mccolgan
  • 3
  • 2
6 Comments
 
LVL 1

Expert Comment

by:kponder
ID: 1442741

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.
0
 

Author Comment

by:s_mccolgan
ID: 1442742

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.



0
 
LVL 2

Accepted Solution

by:
mkmccreary earned 310 total points
ID: 1442743
I think I got it.  Check it out, all you have to do is add other select case clauses for different tags.


Private Sub Command1_Click()

Me.RichTextBox1.LoadFile "h:\experts exchange\html\test.htm"
ProcessRTF Me.RichTextBox1

End Sub

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

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

End Function

Function ProcessRTF(oRTFBox As RichTextBox) As Boolean

Dim lStartPos As Long
Dim lRightEndPos As Long
Dim lLeftStartPos As Long
Dim sText As String

sText = oRTFBox.Text

lStartPos = InStr(sText, "<")
While lStartPos <> 0
    lRightEndPos = InStr(lStartPos + 1, sText, ">")
    lLeftStartPos = InStr(lStartPos + 1, sText, "<")
    If lRightEndPos > 0 Then
        If lLeftStartPos > 0 Then
            If lLeftStartPos > lRightEndPos Then
                lRightEndPos = lRightEndPos + 1
                oRTFBox.SelStart = lStartPos - 1
                oRTFBox.SelLength = lRightEndPos - lStartPos
                oRTFBox.SelColor = GetColor(Mid$(sText, lStartPos, lRightEndPos - lStartPos))
            End If
        Else
            lRightEndPos = lRightEndPos + 1
            oRTFBox.SelStart = lStartPos - 1
            oRTFBox.SelLength = lRightEndPos - lStartPos
            oRTFBox.SelColor = GetColor(Mid$(sText, lStartPos, lRightEndPos - lStartPos))
        End If
    End If
    lStartPos = InStr(lStartPos + 1, sText, "<")
Wend
oRTFBox.SelStart = Len(sText)
oRTFBox.SelLength = 0
oRTFBox.SelColor = vbBlack
oRTFBox.SetFocus

End Function

Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
Dim lStartPos As Long
Dim lEndPos As Long
Dim sCharToCheck As String
Dim boolContinue As Boolean
Dim sText As String

Select Case Chr$(KeyAscii)
    Case ">"
        Me.RichTextBox1.SelText = ">"
        lEndPos = Me.RichTextBox1.SelStart
        lStartPos = lEndPos - 1
        boolContinue = True
        While lStartPos > 0 And boolContinue
            sCharToCheck = Mid$(Me.RichTextBox1.Text, lStartPos, 1)
            Select Case sCharToCheck
                Case "<"
                    boolContinue = False
                Case ">"
                    lStartPos = 0
                    boolContinue = False
                Case Else
                    lStartPos = lStartPos - 1
            End Select
        Wend
        If lStartPos > 0 Then
            lEndPos = lEndPos + 1
            Me.RichTextBox1.SelStart = lStartPos - 1
            Me.RichTextBox1.SelLength = lEndPos - lStartPos
            sText = Me.RichTextBox1.SelText
            Me.RichTextBox1.SelColor = GetColor(sText)
            Me.RichTextBox1.SelStart = lEndPos - 1
            Me.RichTextBox1.SelColor = vbBlack
        End If
        KeyAscii = 0
    Case Else
        ' Do Nothing
End Select

End Sub

I have a command button to load and process the initial file, and something under the keypress event.

Enjoy,
Martin
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 2

Expert Comment

by:mkmccreary
ID: 1442744
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
0
 

Author Comment

by:s_mccolgan
ID: 1442745

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

Thank you
0
 
LVL 2

Expert Comment

by:mkmccreary
ID: 1442746
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
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question