Color Coding Text

[Negative0]

Does anyone have a very EFFICIENT way of color coding text. I am using some code I found from Megatron, but its too slow. This is what I am using right now. If there is a large code segment it takes a few seconds to format the code.

'From Megatron
Private Sub HighlightText(sKeyword As String, iColour As Long)
    Dim nStart As Integer, sPrevChar As String, sNextChar As String
                                               
    nStart = InStr(1, LCase(frmMain.rtbFormat.Text), sKeyword)
 
    Do While nStart <> 0
        If nStart > 1 Then
            sPrevChar = Mid$(frmMain.rtbFormat.Text, nStart - 1, 1)
        Else
            sPrevChar = " "
        End If
         DoEvents
        If Len(frmMain.rtbFormat.Text) >= nStart + Len(sKeyword) Then
            sNextChar = Mid$(frmMain.rtbFormat.Text, nStart + Len(sKeyword), 1)
        Else
            sNextChar = " "
        End If
                                                           
        If (sPrevChar = Chr(32) Or sPrevChar = Chr(13) Or _
        sPrevChar = Chr(10) Or sPrevChar = Chr(9) Or sPrevChart = Chr(46)) And _
        (sNextChar = Chr(32) Or sNextChar = Chr(13) Or _
        sNextChar = Chr(10) Or sNextChar = Chr(9) Or sNextChar = Chr(40)) Then
            With frmMain.rtbFormat
                .SelStart = nStart - 1
                .SelLength = Len(sKeyword)
                .SelColor = iColour
                .SelText = StrConv(sKeyword, vbProperCase)
                .SelStart = Len(frmMain.rtbFormat.Text)
                .SelColor = iColour
            End With
        End If
                                                  
        nStart = InStr(nStart + Len(sKeyword), LCase(frmMain.rtbFormat.Text), sKeyword)
    Loop
End Sub
 
 
Public Sub FormatCode(ByRef tmpRTB As RichTextBox)
Dim oldselstart As Long
Dim oldsellen As Long
   
   frmMain.rtbFormat.TextRTF = tmpRTB.TextRTF
   oldselstart = tmpRTB.SelStart
   oldsellen = tmpRTB.SelLength
    With frmMain.rtbFormat
       .SelStart = 0
       .SelLength = Len(.Text)
       .SelColor = lngTextColor
       .SelStart = Len(.Text)
    End With
    
                                       
    ' Add more custom words here
    
HighlightText "if", lngKeywordColor
HighlightText "doevents", lngKeywordColor
HighlightText "then", lngKeywordColor
HighlightText "else", lngKeywordColor
HighlightText "end", lngKeywordColor
HighlightText "with", lngKeywordColor
HighlightText "select", lngKeywordColor
HighlightText "case", lngKeywordColor
HighlightText "private", lngKeywordColor
HighlightText "public", lngKeywordColor
HighlightText "dim", lngKeywordColor
HighlightText "sub", lngKeywordColor
HighlightText "function", lngKeywordColor
HighlightText "do", lngKeywordColor
HighlightText "loop", lngKeywordColor
HighlightText "for", lngKeywordColor
HighlightText "next", lngKeywordColor
HighlightText "each", lngKeywordColor
HighlightText "integer", lngKeywordColor
HighlightText "boolean", lngKeywordColor
HighlightText "long", lngKeywordColor
HighlightText "double", lngKeywordColor
HighlightText "variant", lngKeywordColor
HighlightText "string", lngKeywordColor
HighlightText "single", lngKeywordColor
HighlightText "byte", lngKeywordColor
HighlightText "date", lngKeywordColor
HighlightText "format", lngKeywordColor
HighlightText "cdate", lngKeywordColor
HighlightText "cvar", lngKeywordColor
HighlightText "cbyte", lngKeywordColor
HighlightText "cbool", lngKeywordColor
HighlightText "cint", lngKeywordColor
HighlightText "clng", lngKeywordColor
HighlightText "csng", lngKeywordColor
HighlightText "cdbl", lngKeywordColor
HighlightText "const", lngKeywordColor
HighlightText "option base 1", lngKeywordColor
HighlightText "option base 0", lngKeywordColor
HighlightText "until", lngKeywordColor
HighlightText "while", lngKeywordColor
HighlightText "option explicit", lngKeywordColor
HighlightText "byval", lngKeywordColor
HighlightText "byref", lngKeywordColor
HighlightText "declare", lngKeywordColor
HighlightText "global", lngKeywordColor
HighlightText "true", lngKeywordColor
HighlightText "false", lngKeywordColor
HighlightText "mod", lngKeywordColor
HighlightText "as", lngKeywordColor
HighlightText "lib", lngKeywordColor
HighlightText "open", lngKeywordColor
HighlightText "close", lngKeywordColor
HighlightText "append", lngKeywordColor
HighlightText "output", lngKeywordColor
HighlightText "input", lngKeywordColor
HighlightText "print", lngKeywordColor
HighlightText "write", lngKeywordColor
HighlightText "binary", lngKeywordColor
HighlightText "access", lngKeywordColor
HighlightText "xor", lngKeywordColor
HighlightText "or", lngKeywordColor
HighlightText "and", lngKeywordColor
HighlightText "in", lngKeywordColor
HighlightText "like", lngKeywordColor
HighlightText "typeof", lngKeywordColor
HighlightText "object", lngKeywordColor
HighlightText "ubound", lngKeywordColor
HighlightText "lbound", lngKeywordColor
HighlightText "to", lngKeywordColor
HighlightText "on", lngKeywordColor
HighlightText "error", lngKeywordColor
HighlightText "goto", lngKeywordColor
 
 
 
   Call FindComments(lngCommentColor)
   tmpRTB.TextRTF = frmMain.rtbFormat.TextRTF
   tmpRTB.SelStart = oldselstart
   tmpRTB.SelLength = oldsellen
   tmpRTB.SelColor = lngTextColor
 
End Sub

Any help would be great.

Thanks in advance

[darre1]

i just helped GlenW out with the exact same request !

see here: http://www.vbforums.com/showthread.p...hreadid=166148

[Si_the_geek]

I just had a quick fiddle with that code - I've made it more than 10 times faster!

here you go:

Private Sub HighlightText(keywords, iColour As Long)
 
Dim checkstr1 As String, checkstr2 As String
Dim tmp_text As String
Dim i As Integer
 
checkstr1 = Chr(32) & Chr(13) & Chr(10) & Chr(9) & Chr(46)
checkstr2 = Chr(32) & Chr(13) & Chr(10) & Chr(9) & Chr(40)
tmp_text = LCase(frmMain.rtbFormat.Text)
 
    Dim nStart As Integer, sPrevChar As String, sNextChar As String
                                               
For i = LBound(keywords) To UBound(keywords)
sKeyword = keywords(i)
nStart = InStr(1, tmp_text, sKeyword)
 
    Do While nStart <> 0
        If nStart > 1 Then
            sPrevChar = Mid$(tmp_text, nStart - 1, 1)
        Else
            sPrevChar = " "
        End If
        DoEvents
        If Len(tmp_text) >= nStart + Len(sKeyword) Then
            sNextChar = Mid$(tmp_text, nStart + Len(sKeyword), 1)
        Else
            sNextChar = " "
        End If
 
        If InStr(1, checkstr1, sPrevChar) > 0 _
        And InStr(1, checkstr2, sNextChar) > 0 Then
            With frmMain.rtbFormat
                .SelStart = nStart - 1
                .SelLength = Len(sKeyword)
                .SelColor = iColour
                .SelText = StrConv(sKeyword, vbProperCase)
                .SelStart = Len(tmp_text)
                .SelColor = iColour
            End With
        End If
 
        nStart = InStr(nStart + Len(sKeyword), tmp_text, sKeyword)
    Loop
Next i
 
End Sub
 
Public Sub FormatCode(ByRef tmpRTB As RichTextBox)
Dim oldselstart As Long
Dim oldsellen As Long
   
   frmMain.rtbFormat.TextRTF = tmpRTB.TextRTF
   oldselstart = tmpRTB.SelStart
   oldsellen = tmpRTB.SelLength
    With frmMain.rtbFormat
       .SelStart = 0
       .SelLength = Len(.Text)
       .SelColor = lngTextColor
       .SelStart = Len(.Text)
    End With
    
                                       
    ' Add more custom words here
dim keywords
keywords = Array("if", "doevents", "then", "else", "end", "with", "select", "case", _
                  "private", "public", "dim", "sub", "function", "do", "loop", "for", _
                  "next", "each", "integer", "boolean", "long", "double", "variant", _
                  "string", "single", "byte", "date", "format", "cdate", "cvar", _
                  "cbyte", "cbool", "cint", "clng", "csng", "cdbl", "const", _
                  "option base 1", "option base 0", "until", "while", _
                  "option explicit", "byval", "byref", "declare", "global", _
                  "true", "false", "mod", "as", "lib", "open", "close", "append", _
                  "output", "input", "print", "write", "binary", "access", "xor", _
                  "or", "and", "in", "like", "typeof", "object", "ubound", "lbound", _
                  "to", "on", "error", "goto")
 
   HighlightText keywords, lngKeywordColor
 
 
 
   Call FindComments(lngCommentColor)
   tmpRTB.TextRTF = frmMain.rtbFormat.TextRTF
   tmpRTB.SelStart = oldselstart
   tmpRTB.SelLength = oldsellen
   tmpRTB.SelColor = lngTextColor
 
End Sub

[Negative0]

Thanks Si,

That code is faster. I've made more modifications to it and it works pretty well. I still cannot do real time editing though, but it works for me.

Thanks,

[Ryan]

Have you ever thought about using the CodeMax control?

You'll need to register to download, but it's well worth it.

http://groups.yahoo.com/group/codemax/

[Lord_Rat]

For real time color coding, you should consider setting up a timer and when the timer fires, it color codes a few words at a time.

This is how my icon extractor is working on my tree view and it is pretty smooth sailing.

[darre1]

Si:

in your FormatCode sub you have a tmpRTB parameter that you send to it, but then you dont send it to the HighlightText sub, in that sub ut uses frmMain.rtbFormat. just a thought...

nice one anyway...

another way to make it real fast would be if you knew all of the rich-text "codes" used by a richtextbox, you could then get the code to format in a string and without using the richtextbox's properties, format it, then just paste it to the rtb. that would be lightning quick

[darre1]

Originally posted by Si_the_geek
I just had a quick fiddle with that code - I've made it more than 10 times faster!

yours doesnt check for quote's i.e. "string"

anything in quotes should not be effected - i.e. should not turn blue, unless it is preceded by a ', in which case it turns into a comment.

also a ' doesnt count if its between 2 quotation marks.

these are what slow the procedure down, since you have to check char by char to do that (kinda).

[gaffa]

As Ryan suggested, get the CodeMax control (it used to be at www.winmain.com but I think that site is dead) - it's got the kind of features that makes you wonder why you even considered writing your own syntax colouring code.

Seriously well worth downloading.

- gaffa

[darre1]

i usually write stuff just out of curiousity

[Si_the_geek]

i agree totally Darre1, but it wasn't my code - I just had to have a fiddle to make it more efficient... can't stand loose code

If I had a need for it myself i would have written it completely differently... (made it real time for an editing environment, allowed for quotes & comments etc). I was just wasting a bit of time to boost the speed a little!

[darre1]

i hear you, its just that you speeded it up by removing some of its functionality

the reason its slow is because i've checked character by character where needed, and you have to do that to capture the quotes and embedded 's etc

[Si_the_geek]

Originally posted by darre1
i hear you, its just that you speeded it up by removing some of its functionality

the reason its slow is because i've checked character by character where needed, and you have to do that to capture the quotes and embedded 's etc

Erm... no I haven't - check out the first post in this thread, that it what I modified, not yours (I couldn't actually get yours to run cos of dll versions).

The functionality I provided is exactly the same as was there before. But as you said it is far from perfect. I just had to make it more efficient!

[darre1]

my apologies, i should read more carefully

BTW: mines not perfect either

[Negative0]

yours doesnt check for quote's i.e. "string"

Darre1,

This was only the section of my code that searches for the keywords, i also have a routine that searches for comments and quotes. I have also made some modifications to this version to account for numbers, "_", and other special chars.

For the real time color formatting, I only trigger the event when the user hits the enter key right now, but it will account for whenever the user changes lines and something has changed.

in your FormatCode sub you have a tmpRTB parameter that you send to it, but then you dont send it to the HighlightText sub, in that sub ut uses frmMain.rtbFormat. just a thought...

The tmprtb is the RTB to be formatted. IN the format code routine, all of the text is copied to frmMain.rtbFormat, then copied back to tmprtb after all the formatting has been completed.

Thanks for all you help,