Results 1 to 10 of 10

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

  1. #1

    Thread Starter
    Frenzied Member vbNeo's Avatar
    Join Date
    May 2002
    Location
    Jutland, Denmark
    Posts
    1,994

    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:
    1. Public Function ColorHTML(RTF As RichTextBox)
    2.  
    3. 'This is NOT realtime coloring - Run after file load etc.
    4. Dim iTagEnd, iTagStart, iTagLength  As Integer
    5. Dim sTag As String
    6.  
    7. 'We Need it to go fast, so **** visibility
    8. RTF.Visible = False
    9.  
    10. For i = 1 To Len(RTF.Text)
    11. If Not Mid(RTF.Text, i, 2) = "<%" Then 'ASP Tag, ignore it
    12.  If Mid(RTF.Text, i, 1) = "<" Then
    13.    If InStr(i, RTF.Text, ">") > 0 Then
    14.    iTagStart = InStr(i, RTF.Text, "<")
    15.    iTagEnd = InStr(i, RTF.Text, ">")
    16.    iTagLength = iTagEnd - iTagStart
    17.    RTF.SelStart = iTagStart
    18.    RTF.SelLength = iTagLength - 1
    19.    sTag = RTF.SelText
    20.    RTF.SelText = ""
    21.    RTF.SelColor = &H800000
    22.    RTF.SelText = sTag
    23.    RTF.SelColor = vbBlack
    24.   End If
    25.  End If
    26. End If
    27. Next
    28. 'We're not coloring anymore - so it's cool if we can see it ;)
    29. RTF.Visible = True
    30. RTF.SelColor = vbBlack
    31. End Function

    3. Now make a command button on your form, and in it's Click event put:
    VB Code:
    1. 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!
    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.

  2. #2
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427
    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:
    1. Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    2.  
    3. Public Sub ColorHTML(RTF As RichTextBox)
    4.  
    5. 'This is NOT realtime coloring - Run after file load etc.
    6. Dim iTagEnd  As Integer
    7. Dim iTagStart As Integer
    8. Dim iTagLength  As Integer
    9. Dim i As Integer
    10. Dim sTag As String
    11.  
    12. 'We Need it to go fast, so temporarily delay showing changes
    13. LockWindowUpdate RTF.hWnd
    14.  
    15. For i = 1 To Len(RTF.Text)
    16. If Not Mid(RTF.Text, i, 2) = "<%" Then 'ASP Tag, ignore it
    17.  If Mid(RTF.Text, i, 1) = "<" Then
    18.    If InStr(i, RTF.Text, ">") > 0 Then
    19.    iTagStart = InStr(i, RTF.Text, "<")
    20.    iTagEnd = InStr(i, RTF.Text, ">")
    21.    iTagLength = iTagEnd - iTagStart
    22.    RTF.SelStart = iTagStart
    23.    RTF.SelLength = iTagLength - 1
    24.    sTag = RTF.SelText
    25.    RTF.SelText = ""
    26.    RTF.SelColor = &H800000
    27.    RTF.SelText = sTag
    28.    RTF.SelColor = vbBlack
    29.   End If
    30.  End If
    31. End If
    32. Next
    33. 'We're not coloring anymore
    34. LockWindowUpdate 0&
    35.  
    36. RTF.SelColor = vbBlack
    37. End Sub

  3. #3

    Thread Starter
    Frenzied Member vbNeo's Avatar
    Join Date
    May 2002
    Location
    Jutland, Denmark
    Posts
    1,994

    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.

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

    VB Code:
    1. Public Sub ColorText(tb As RichTextBox, color as long)
    2. Dim s As Long
    3. Dim e As Long
    4. For i = 1 To Len(tb.Text)
    5. s = InStr(i, tb.Text, "<")
    6. If s <> 0 Then e = InStr(s, tb.Text, ">")
    7. If s <> 0 And e <> 0 Then
    8. tb.SelStart = s - 1
    9. tb.SelLength = (e - s) + 1
    10. tb.SelColor = color
    11. i = e
    12. End If
    13. Next
    14. End Sub

    btw this is realtime
    a 17 year old kid who has nothing better to do !
    and i never said i was right !!!

  5. #5

    Thread Starter
    Frenzied Member vbNeo's Avatar
    Join Date
    May 2002
    Location
    Jutland, Denmark
    Posts
    1,994

    Well

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

    VB Code:
    1. Public Sub ColorRealHTML(txtMain As RichTextBox)
    2. Static InTag As Boolean
    3. If m_ColorSyntax = True Then
    4. If KeyAscii = Asc("<") Then
    5. KeyAscii = 0
    6. InTag = True
    7. txtMain.SelText = "<"
    8. txtMain.SelColor = &H800000
    9. End If
    10. If KeyAscii = Asc(">") = True Then txtMain.SelColor = vbBlack: InTag = False
    11. If InStrRev(txtMain.Text, "<", txtMain.SelStart) Then
    12. If InStr(txtMain.SelStart + 1, txtMain.Text, ">") Then
    13. txtMain.SelColor = &H800000
    14. InTag = True
    15. Else
    16.  
    17. End If
    18. Else
    19. End If
    20. If InTag = False Then txtMain.SelColor = vbBlack
    21. End If
    22. 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.

  6. #6
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253
    Cool

  7. #7
    Lively Member
    Join Date
    Nov 2002
    Location
    UK
    Posts
    83
    Edited a bit, now colors like this:

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

    VB Code:
    1. Public Sub ColorHTML(RTF As RichTextBox)
    2. Dim iTagEnd  As Integer
    3. Dim iTagStart As Integer
    4. Dim iTagLength  As Integer
    5. Dim iStrStart As Integer
    6. Dim iStrEnd As Integer
    7.  
    8. Dim i As Integer
    9. Dim sTag As String
    10.  
    11. 'We Need it to go fast, so temporarily delay showing changes
    12. LockWindowUpdate RTF.hWnd
    13.  
    14. For i = 1 To Len(RTF.Text)
    15. 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
    16.  If Mid(RTF.Text, i, 1) = "<" Then
    17.     If InStr(i, RTF.Text, ">") > 0 Then
    18.     iTagStart = InStr(i, RTF.Text, "<")
    19.     iTagEnd = InStr(i, RTF.Text, ">")
    20.     iTagLength = iTagEnd - iTagStart
    21.    
    22.     RTF.SelStart = iTagStart - 1
    23.     RTF.SelLength = iTagLength + 1
    24.     sTag = RTF.SelText
    25.     RTF.SelText = ""
    26.     RTF.SelColor = vbBlue
    27.     RTF.SelText = sTag
    28.     RTF.SelColor = vbBlack
    29.    
    30.     For a = iTagStart To iTagEnd
    31.          If InStr(a, RTF.Text, """") > 0 Then
    32.             iStrStart = InStr(a, RTF.Text, """")
    33.             iStrEnd = InStr(iStrStart + 1, RTF.Text, """")
    34.             RTF.SelStart = iStrStart - 1
    35.             RTF.SelLength = (iStrEnd - iStrStart) + 1
    36.             sTag = RTF.SelText
    37.             RTF.SelText = ""
    38.             RTF.SelColor = &H8000000D
    39.             RTF.SelText = sTag
    40.             RTF.SelColor = vbBlack
    41.             a = iStrEnd + 1
    42.          End If
    43.     Next a
    44.     i = iTagEnd
    45.   End If
    46.  End If
    47. End If
    48. Next
    49. 'We're not coloring anymore
    50. LockWindowUpdate 0&
    51.  
    52. RTF.SelColor = vbBlack
    53. End Sub

  8. #8

    Thread Starter
    Frenzied Member vbNeo's Avatar
    Join Date
    May 2002
    Location
    Jutland, Denmark
    Posts
    1,994

    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.

  9. #9
    Lively Member
    Join Date
    Nov 2002
    Location
    UK
    Posts
    83
    lol, If I were gonna do that, i'd have to make summore changes first. That is still quite slow.

  10. #10

    Thread Starter
    Frenzied Member vbNeo's Avatar
    Join Date
    May 2002
    Location
    Jutland, Denmark
    Posts
    1,994

    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
  •  



Click Here to Expand Forum to Full Width