-
Oct 26th, 2003, 03:17 PM
#1
Thread Starter
Frenzied Member
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:
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!
Last edited by vbNeo; Nov 3rd, 2003 at 01:01 PM.
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
-
Oct 26th, 2003, 03:42 PM
#2
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
-
Oct 26th, 2003, 04:26 PM
#3
Thread Starter
Frenzied Member
Nice
Thanks Martin! That's much better =).
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
-
Oct 31st, 2003, 05:04 PM
#4
Member
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
a 17 year old kid who has nothing better to do !
and i never said i was right !!!
-
Nov 3rd, 2003, 01:03 PM
#5
Thread Starter
Frenzied Member
Well
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 =).
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
-
Nov 3rd, 2003, 05:06 PM
#6
-
Dec 10th, 2003, 09:25 AM
#7
Lively Member
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
-
Dec 10th, 2003, 09:47 AM
#8
Thread Starter
Frenzied Member
hehe
Good Job =). Now assemble it all in the ultimate opensource HTML richtextbox activeX (I'm to darn it lazy to do it )
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
-
Dec 10th, 2003, 02:07 PM
#9
Lively Member
lol, If I were gonna do that, i'd have to make summore changes first. That is still quite slow.
-
Dec 10th, 2003, 03:40 PM
#10
Thread Starter
Frenzied Member
hehe
Ya, I know - it was also something that was quickly patched together... It'd be better to change the 'raw' RTF code instead...
"Lies, sanctions, and cruise missiles have never created a free and just society. Only everyday people can do that."
- Zack de la Rocha
Hear me roar.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|