High Speed Syntax Coloring
(Written by me in Visual Studio 2008, Project attached, as well as a text file for users with version 2005)
Updates
Version 1.01
1: Fixed bugs, such as quotes not coloring if you can't see the first quote on screen
2: All updates now ignore quoted & commented text, so they don't conflict, and they don't waste time
Good
1: The code doesn't flash
2: Colors an entire document of 500 lines with 50 key words in 2 seconds
3: Colors the current line your modifying actively without notice
4: Colors text pasted into the rich text box
5: Includes customized tabs (as well as removing them with back space)
6: Very easily modified key words
Bad
1: It does not work with word wrap
2: If you paste 500 lines, with 50 key words it will take 2 seconds to color it
3: Undo & redo actions are disabled, you will have to make your own (to get a proper effect anyway, (they work, but strangely...))
All you do is download the solution and click test, or download the text document, copy & paste the text into a new solution (you've created), and you'll need to make the rich text box you want to use (named rtbEdit)
License
You can use this code freely, regardless of whether your charging for your application or not.
Feed back
Please reply and tell me what you think of it, I'd appreciate any comments & sugguestions
Cheers
Icyculyr
Last edited by Icyculyr; Apr 16th, 2008 at 04:41 AM.
Thanks, yeah it can, although I wouldn't modify it, I would instead write a new one, as this is more complex as it is to do with coloring individual words..
If I get this straight, only the first word of each line counts.
I'd do it like this:
Code:
Imports System.Text.RegularExpressions
Public Class WordDictionary
Private _rRegex As New List(Of Regex)
Private _cColors As New List(Of Color)
Sub New()
End Sub
Public Sub AddWord(ByVal sWord As String, ByVal cColor As Color)
_rRegex.Add(New Regex("\b" & sWord & "\b"))
_cColor.Add(cColor)
End Sub
Public Function GetColor(ByVal i As Integer) As Color
Return _cColor(i)
End Function
End Class
Now, do that code in a new project (for testing), but also tell me, what exactly happens, every time text changes it needs updating? or only when you click a button etc..?
Basically as the word "mywordfromDictionaryArray" is typed
*highlight that line immediately till present caret position
*and continue the highlighting until user starts a new line.
So the whole line starting with "mywordfromDictionaryArray" will be highlighted
So the code will fire on 2 scenarios:
1. User types (textchanged)
2. User pastes text into the richtextbox (textchanged)
There will not be any button to fire the coloring. It'll be color as you go. Hope this makes it clearer.
You can see an image of what I'm trying to achieve. AS user types "verse" at the beginning of the line, highlighting begins and ends when the line is ended, ie: newline.
Last edited by Referee2424; Jun 12th, 2008 at 11:24 AM.
Well, you'd have it modify only the current line, so
Code:
Imports System.Text.RegularExpressions
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As IntPtr) As Integer
Public Class WordDictionary
Private _rRegex As New List(Of Regex)
Private _sWord As New List(Of String)
Private _cColors As New List(Of Color)
Sub New()
End Sub
Public Sub AddWord(ByVal sWord As String, ByVal cColor As Color)
_rRegex.Add(New Regex("\b" & sWord & "\b"))
If _sWord.IndexOf(sWord) <> -1 Then
Throw New Exception("Duplicate word entered - " & sWord)
End If
_sWord.Add(sWord)
_cColor.Add(cColor)
End Sub
Public Function GetColor(ByVal sWord As String) As Color
Return _cColor(_sWord.IndexOf(sWord))
End Function
End Class
Public wdDictionary As New WordDictionary()
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
wdDictionary.AddWord("Sugar", Color.Red)
wdDictionary.AddWord("Sour", Color.Green)
End Sub
Private Sub RtbCode_TextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles RtbCode.TextChanged
ColorCurrentLine(RtbCode)
End Sub
Public Sub ColorCurrentLine(ByVal RtbBox As RichTextBox)
Dim iStart As Integer = RtbBox.SelectionStart
Dim iLine As Integer = RtbBox.GetLineFromCharIndex(iStart)
Dim sText As String = RtbBox.Lines(iLine)
Dim iFirst As integer = RtbBox.GetFirstCharIndexFromLine(iLine)
Dim iEnd As Integer = sText.Length
'Get First word
Dim sWord As String = ""
Dim sTemp As String = ""
For i As Integer = 0 To sText.Length-1
sTemp = sText.Substring(i, 1)
If sTemp = " " Then 'End of first word is a space
Exit For
End If
sWord &= sTemp
Next i
Dim cColor As Color = Nothing
If wdDictionary._sWord.IndexOf(sWord) <> -1 Then
cColor = wdDictionary.GetColor(sWord)
End If
If cColor Is Nothing Then
'Word not found, ignore it, keep it black.
Return
End If
'Color Entire Line
LockWindowUpdate(RtbBox.Handle)
RtbBox.SelectionLength = 0
RtbBox.Select(iFirst, iEnd)
RtbBox.SelectionColor = cColor
RtbBox.SelectionLength = 0
RtbBox.SelectionStart = iStart
RtbBox.SelectionColor = Color.Black
LockWindowUpdate(IntPtr.Zero)
End Sub
Untested, but that should work for text, if you want pasting as well, you'll have to do that:P
All you do is check there is data from My.Computer.Clipboard, set that text value to RtbBox.SelectedText in a ColorPaste(RtbCode) sub that you will make, on the key down event of your rich text box, you check for e.Control() and also e.KeyCode = Keys.V (Paste), you use e.SuppressKeyPress=True, and you use the coloring stuff as above to do that.
Public Class Form1
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As IntPtr) As Integer
Public wdDictionary As New WordDictionary()
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
wdDictionary.AddWord("Sugar", Color.Red)
wdDictionary.AddWord("Sour", Color.Green)
End Sub
Private Sub rtbCode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rtbCode.TextChanged
ColorCurrentLine(rtbCode)
End Sub
Public Sub ColorCurrentLine(ByVal RtbBox As RichTextBox)
Dim iStart As Integer = RtbBox.SelectionStart
Dim iLine As Integer = RtbBox.GetLineFromCharIndex(iStart)
Dim sText As String = RtbBox.Lines(iLine)
Dim iFirst As Integer = RtbBox.GetFirstCharIndexFromLine(iLine)
Dim iEnd As Integer = sText.Length
'Get First word
Dim sWord As String = ""
Dim sTemp As String = ""
For i As Integer = 0 To sText.Length - 1
sTemp = sText.Substring(i, 1)
If sTemp = " " Then 'End of first word is a space
Exit For
End If
sWord &= sTemp
Next i
Dim cColor As Color = Nothing
If wdDictionary._sWord.IndexOf(sWord) <> -1 Then
cColor = wdDictionary.GetColor(sWord)
End If
If cColor = Nothing Then
'Word not found, ignore it, keep it black.
Return
End If
'Color Entire Line
LockWindowUpdate(RtbBox.Handle)
RtbBox.SelectionLength = 0
RtbBox.Select(iFirst, iEnd)
RtbBox.SelectionColor = cColor
'add a backcolor as yellow
'THIS BACKCOLORFEATURE NEEDS TO BE ADDED TO wdDictionary.AddWord("word", forecolor, backcolor)
RtbBox.SelectionBackColor = Color.Yellow
RtbBox.SelectionLength = 0
RtbBox.SelectionStart = iStart
RtbBox.SelectionColor = Color.Black
'return the backcolor to white
RtbBox.SelectionBackColor = Color.White
LockWindowUpdate(IntPtr.Zero)
End Sub
End Class
I added a new class called WordDictionary.vb and added this.
Code:
Imports System.Text.RegularExpressions
Public Class WordDictionary
Private _rRegex As New List(Of Regex)
Public _sWord As New List(Of String)
Private _cColors As New List(Of Color)
Sub New()
End Sub
Public Sub AddWord(ByVal sWord As String, ByVal cColor As Color)
_rRegex.Add(New Regex("\b" & sWord & "\b"))
If _sWord.IndexOf(sWord) <> -1 Then
Throw New Exception("Duplicate word entered - " & sWord)
End If
_sWord.Add(sWord)
_cColors.Add(cColor)
End Sub
Public Function GetColor(ByVal sWord As String) As Color
Return _cColors(_sWord.IndexOf(sWord))
End Function
End Class
It seems to work great. I have attached the project and image to make things easier. Almost there...
There seems to be a few things going wrong.
Line starting with "SugarY" behaved oddly. The rest of the line after Sugar returns to black.
Try adding text and then backspacing to remove all text. There is an error
Also how can I add background highlighting to the line starting with "Sugar" or "Sour" This BACKCOLORFEATURE needs to be added to wdDictionary.AddWord("word", forecolor, backcolor)
Last edited by Xancholy; Jun 16th, 2008 at 10:58 AM.
Imports System.Text.RegularExpressions
Public Class Form1
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As IntPtr) As Integer
Public Class WordDictionary
Private _rRegex As New List(Of Regex)
Public _sWord As New List(Of String)
Private _cTextColors As New List(Of Color)
Private _cBGColors As New List(Of Color)
Sub New()
End Sub
Public Sub AddWord(ByVal sWord As String, ByVal cTextColor As Color, ByVal cBGColor As Color)
_rRegex.Add(New Regex("\b" & sWord & "\b"))
If _sWord.IndexOf(sWord) <> -1 Then
Throw New Exception("Duplicate word entered - " & sWord)
End If
_sWord.Add(sWord)
_cTextColors.Add(cTextColor)
_cBGColors.Add(cBGColor)
End Sub
Public Function GetTextColor(ByVal sWord As String) As Color
Return _cTextColors(_sWord.IndexOf(sWord))
End Function
Public Function GetBGColor(ByVal sWord As String) As Color
Return _cBGColors(_sWord.IndexOf(sWord))
End Function
End Class
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
wdDictionary.AddWord("Sugar", Color.Red, Color.Green)
wdDictionary.AddWord("Sour", Color.Green, Color.Red)
End Sub
Public wdDictionary As New WordDictionary()
Private Sub RtbCode_TextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles rtbCode.TextChanged
ColorCurrentLine(rtbCode)
End Sub
Public Sub ColorCurrentLine(ByVal RtbBox As RichTextBox)
Dim iStart As Integer = RtbBox.SelectionStart
Dim iLine As Integer = RtbBox.GetLineFromCharIndex(iStart)
If RtbBox.Lines.Length <= 0 Then
Return
End If
Dim sText As String = RtbBox.Lines(iLine)
If sText.Length <= 0 Then
'Return
End If
Dim iFirst As Integer = RtbBox.GetFirstCharIndexFromLine(iLine)
Dim iEnd As Integer = sText.Length
'Get First word
Dim sWord As String = ""
Dim sTemp As String = ""
LockWindowUpdate(RtbBox.Handle)
RtbBox.SelectionLength = 0
RtbBox.Select(iFirst, iEnd)
RtbBox.SelectionColor = Color.Black 'Normal Color
RtbBox.SelectionBackColor = Color.White 'Normal BG Color
RtbBox.SelectionLength = 0
RtbBox.SelectionStart = iStart
For i As Integer = 0 To sText.Length - 1
sTemp = sText.Substring(i, 1)
If sTemp = " " Then 'End of first word is a space
Exit For
End If
sWord &= sTemp
Next i
Dim cColor As Color = Nothing
If wdDictionary._sWord.IndexOf(sWord) <> -1 Then
cColor = wdDictionary.GetTextColor(sWord)
End If
If cColor = Nothing Then
'Word not found, ignore it, keep it black.
LockWindowUpdate(IntPtr.Zero)
Return
End If
'Color Entire Line
RtbBox.SelectionLength = 0
RtbBox.Select(iFirst, iEnd)
RtbBox.SelectionColor = cColor
RtbBox.SelectionBackColor = wdDictionary.GetBGColor(sWord)
RtbBox.SelectionLength = 0
RtbBox.SelectionStart = iStart
RtbBox.SelectionColor = Color.Black
RtbBox.SelectionBackColor = Color.White 'Normal BG Color
LockWindowUpdate(IntPtr.Zero)
End Sub
End Class
Fully working, minor bugs, you probably could have fixed them yourself.
Thanks Icy. That works great when the user types in the rtb. But it doesn't work on copy/paste.
How can I colorize the lines when user PASTES text ? I'm trying this code but it doesn't work.
Code:
Private Sub rtbCode_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles rtbCode.KeyDown
'aware of Paste or Insert
If e.Control AndAlso e.KeyCode = Keys.V _
OrElse e.Shift AndAlso e.KeyCode = Keys.I Then
If Clipboard.ContainsImage OrElse Clipboard.ContainsFileDropList Then
'some images are transferred as filedrops - strip image
e.Handled = True 'stops here
ElseIf Clipboard.ContainsText() Then 'strip formatting
Me.rtbCode.Text = Clipboard.GetText()
e.Handled = True
End If
ColorCurrentLine(rtbCode)
End If
End Sub
Last edited by Xancholy; Jun 17th, 2008 at 09:56 AM.
Also can you please show me how to replace "sugar" with propercase "Sugar" if it occurs at the start of the line, so that the code will fire and color Sugar even if it is typed in lowercase.
Here's a propercase function if it helps
Code:
Private Function ProperCase(ByVal strValue As String) As String
Try
ProperCase = StrConv(strValue, VbStrConv.ProperCase)
Catch ex As System.Exception
'Error hadler goes here
End Try
End Function
Well this has been very helpful but I ran into a small problem. When I do a control+V to paste syntax into the rtbEdit it only colors syntax in the last line but when I run your program and paste stuff every keyword is highlighted. I haven't changed and of your code except for the keywords that are highlighted and what color they are.
oh sorry i fixed my problem but i forgot to let everyone know but the problem was that only the last line of the pasted text would have its keywords highlighted. but it doenst matter now i got it working. thanks again for the awesome code.
hey nice code just what a been lookin for.i got a problem when i create i simple editer.i enable it to open files so when i open files they are then pasted onto the rtb but only the first line gets highlighted and the rest does not.how can i fix this?
this is my open file code that seems to be working
Code:
Using ofd As New OpenFileDialog
'// Set properties
ofd.Title = "Open File"
ofd.Filter = "Text files (*.txt)|*.txt|All files|*.*"
'// Show dialog and only continue when OK was pressed
If ofd.ShowDialog = Windows.Forms.DialogResult.OK Then
'// Set filepath
sFilePath = ofd.FileName
'// Get fileTitle via function
sFileTitle = GetFileTitle(ofd.FileName)
'// Load file into RTB
rtbEdit.LoadFile(sFilePath, RichTextBoxStreamType.PlainText)
'// Set changed/saved status
DocumentChanged = False
DocumentSaved = True
'// Update title
UpdateTitle()
'// updates all of the code in rtbedit
ColorLines(rtbEdit)
lblFilepath.Text = sFilePath
lblLineInfo.Width = Me.Width - lblFilepath.Width
Dim ln As Long = rtbEdit.GetLineFromCharIndex(rtbEdit.SelectionStart)
Dim ch As Integer = rtbEdit.SelectionStart - rtbEdit.GetFirstCharIndexFromLine(ln)
Me.lblLineInfo.Text = "Ln " & ln + 1 & ", Ch " & ch + 1
End If
End Using
hello Icyculyr
I downloaded the file. and im playing around with it ive changed most of the tags.but I was wondering if there is any way of adding more colors?
instead of 3. (ie the blue one the comment one and the "" one)
I need more. and im having trouble adding more i thought making new variables
example
(
Public cTokens As Color = Color.Beige
Public rTokens As New Regex("//")
)
and it does not work. i was also skimming thru the code and there is a LOT of things. and im thinking that your answer will not be an easy one for me. meaning I will have to do Complex things to add new colors.
thx for the comment when its added.
and THANK YOU For this Fantastic File you made.
EDIT --ahhaah I figured it out =] THX again for this.!!