[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Syntax Coloring

Posted on 1998-11-01
6
Medium Priority
?
226 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 1240 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

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…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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 utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

650 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