VB - HTML Tag Coloring(Both Realtime and non realtime)

I was playing around with my own lil' notepad editor, and I needed some syntax coloring, so I made this little baby:

1. Put a RichTextBox control on your form, call it "RTF1"

2. Add a module to your project, and insert the following function:

VB Code:

Public Function ColorHTML(RTF As RichTextBox)
 
'This is NOT realtime coloring - Run after file load etc.
Dim iTagEnd, iTagStart, iTagLength  As Integer
Dim sTag As String
 
'We Need it to go fast, so **** visibility
RTF.Visible = False
 
For i = 1 To Len(RTF.Text)
If Not Mid(RTF.Text, i, 2) = "<%" Then 'ASP Tag, ignore it
 If Mid(RTF.Text, i, 1) = "<" Then
   If InStr(i, RTF.Text, ">") > 0 Then
   iTagStart = InStr(i, RTF.Text, "<")
   iTagEnd = InStr(i, RTF.Text, ">")
   iTagLength = iTagEnd - iTagStart
   RTF.SelStart = iTagStart
   RTF.SelLength = iTagLength - 1
   sTag = RTF.SelText
   RTF.SelText = ""
   RTF.SelColor = &H800000
   RTF.SelText = sTag
   RTF.SelColor = vbBlack
  End If
 End If
End If
Next
'We're not coloring anymore - so it's cool if we can see it ;)
RTF.Visible = True
RTF.SelColor = vbBlack
End Function

3. Now make a command button on your form, and in it's Click event put:

VB Code:

ColorHTML RTF1

4. Run your program and click the command button, everyting inside "< >" will be colored dark blue.

I know this isn't the fastest function - you can almost certainly optimize it, but it works, and it's a good place to start from.

Cheers!

I dimensioned your variables properly (in Dim iTagEnd, iTagStart, iTagLength As Integer, the first two are variants), changed it to a Sub since you aren't returning anything and substituted LockWindowUpdate for hiding the RTB.

VB Code:

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
 
Public Sub ColorHTML(RTF As RichTextBox)
 
'This is NOT realtime coloring - Run after file load etc.
Dim iTagEnd  As Integer
Dim iTagStart As Integer
Dim iTagLength  As Integer
Dim i As Integer
Dim sTag As String
 
'We Need it to go fast, so temporarily delay showing changes
LockWindowUpdate RTF.hWnd
 
For i = 1 To Len(RTF.Text)
If Not Mid(RTF.Text, i, 2) = "<%" Then 'ASP Tag, ignore it
 If Mid(RTF.Text, i, 1) = "<" Then
   If InStr(i, RTF.Text, ">") > 0 Then
   iTagStart = InStr(i, RTF.Text, "<")
   iTagEnd = InStr(i, RTF.Text, ">")
   iTagLength = iTagEnd - iTagStart
   RTF.SelStart = iTagStart
   RTF.SelLength = iTagLength - 1
   sTag = RTF.SelText
   RTF.SelText = ""
   RTF.SelColor = &H800000
   RTF.SelText = sTag
   RTF.SelColor = vbBlack
  End If
 End If
End If
Next
'We're not coloring anymore
LockWindowUpdate 0&
 
RTF.SelColor = vbBlack
End Sub

Thanks Martin! That's much better =).

This is even simpler, i created this function in like 2 minutes too:

VB Code:

Public Sub ColorText(tb As RichTextBox, color as long)
Dim s As Long
Dim e As Long
For i = 1 To Len(tb.Text)
s = InStr(i, tb.Text, "<")
If s <> 0 Then e = InStr(s, tb.Text, ">")
If s <> 0 And e <> 0 Then
tb.SelStart = s - 1
tb.SelLength = (e - s) + 1
tb.SelColor = color
i = e
End If
Next
End Sub

btw this is realtime

I couldn't get yours to work, so I made this one:

VB Code:

Public Sub ColorRealHTML(txtMain As RichTextBox)
Static InTag As Boolean
If m_ColorSyntax = True Then
If KeyAscii = Asc("<") Then
KeyAscii = 0
InTag = True
txtMain.SelText = "<"
txtMain.SelColor = &H800000
End If
If KeyAscii = Asc(">") = True Then txtMain.SelColor = vbBlack: InTag = False
If InStrRev(txtMain.Text, "<", txtMain.SelStart) Then
If InStr(txtMain.SelStart + 1, txtMain.Text, ">") Then
txtMain.SelColor = &H800000
InTag = True
Else
 
End If
Else
End If
If InTag = False Then txtMain.SelColor = vbBlack
End If
End Sub

By the way, I'm a 16 year old kid with nothing better to do =).

Cool :cool:

Edited a bit, now colors like this:

<my htmltag= "tested">This is text</my>

VB Code:

Public Sub ColorHTML(RTF As RichTextBox)
Dim iTagEnd  As Integer
Dim iTagStart As Integer
Dim iTagLength  As Integer
Dim iStrStart As Integer
Dim iStrEnd As Integer
 
Dim i As Integer
Dim sTag As String
 
'We Need it to go fast, so temporarily delay showing changes
LockWindowUpdate RTF.hWnd
 
For i = 1 To Len(RTF.Text)
If Not Mid(RTF.Text, i, 2) = "<%" And Not Mid(LCase(RTF.Text), i, 5) = "<?php" And Not Mid(RTF.Text, i, 4) = "<!--" Then 'ASP Tag, ignore it
 If Mid(RTF.Text, i, 1) = "<" Then
    If InStr(i, RTF.Text, ">") > 0 Then
    iTagStart = InStr(i, RTF.Text, "<")
    iTagEnd = InStr(i, RTF.Text, ">")
    iTagLength = iTagEnd - iTagStart
    
    RTF.SelStart = iTagStart - 1
    RTF.SelLength = iTagLength + 1
    sTag = RTF.SelText
    RTF.SelText = ""
    RTF.SelColor = vbBlue
    RTF.SelText = sTag
    RTF.SelColor = vbBlack
    
    For a = iTagStart To iTagEnd
         If InStr(a, RTF.Text, """") > 0 Then
            iStrStart = InStr(a, RTF.Text, """")
            iStrEnd = InStr(iStrStart + 1, RTF.Text, """")
            RTF.SelStart = iStrStart - 1
            RTF.SelLength = (iStrEnd - iStrStart) + 1
            sTag = RTF.SelText
            RTF.SelText = ""
            RTF.SelColor = &H8000000D
            RTF.SelText = sTag
            RTF.SelColor = vbBlack
            a = iStrEnd + 1
         End If
    Next a
    i = iTagEnd
  End If
 End If
End If
Next
'We're not coloring anymore
LockWindowUpdate 0&
 
RTF.SelColor = vbBlack
End Sub

Good Job =). Now assemble it all in the ultimate opensource HTML richtextbox activeX (I'm to darn it lazy to do it ;))

lol, If I were gonna do that, i'd have to make summore changes first. That is still quite slow.

Ya, I know - it was also something that was quickly patched together... It'd be better to change the 'raw' RTF code instead...