Colorize VB Code in a RTF Control

Here are a function to colorize VB Code in a RTF control.

If you have VB Code in a RTF control, you can colorize it the same way as in VB.

You have to make a call to "InitColorize" before using it.

Sample


' *** Add VB code in a RTF control

Call InitColorize
Call ColorizeWords(rtfVBCode)

' *** Now your VB code in your RTF control is colorized

Source Code


' #VBIDEUtils#****************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 30/10/98
' * Time             : 14:47
' * Module Name      : Colorize_Module
' * Module Filename  : Colorize.bas
' ****************************************************************
' * Comments      : Colorize in black, blue, green the VB keywords
' *
' *
' ****************************************************************

Option Explicit

Private gsBlackKeywords    As String
Private gsBlueKeyWords     As String

Public Sub ColorizeWords(rtf As RichTextBox)
   ' #VBIDEUtils#*************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 30/10/98
   ' * Time             : 14:47
   ' * Module Name      : Colorize_Module
   ' * Module Filename  : Colorize.bas
   ' * Procedure Name   : ColorizeWords
   ' * Parameters       :
   ' *                    rtf As RichTextBox
   ' *************************************************************
   ' * Comments   : Colorize in black, blue, green the VB keywords
   ' *
   ' *
   ' *************************************************************

   Dim sBuffer    As String
   Dim nI         As Long
   Dim nJ         As Long
   Dim sTmpWord   As String
   Dim nStartPos  As Long
   Dim nSelLen    As Long
   Dim nWordPos   As Long

   Dim cHourglass As class_Hourglass
   Set cHourglass = New class_Hourglass

   sBuffer = rtf.Text
   sTmpWord = ""
   With rtf
     For nI = 1 To Len(sBuffer)
     Select Case Mid(sBuffer, nI, 1)
       Case "A" To "Z", "a" To "z", "_"
       If sTmpWord = "" Then nStartPos = nI
       sTmpWord = sTmpWord & Mid(sBuffer, nI, 1)

     Case Chr(34)
       nSelLen = 1
       For nJ = 1 To 9999999
          If Mid(sBuffer, nI + 1, 1) = Chr(34) Then
            nI = nI + 2
            Exit For
          Else
            nSelLen = nSelLen + 1
            nI = nI + 1
          End If
       Next

     Case Chr(39)
       .SelStart = nI - 1
       nSelLen = 0
       For nJ = 1 To 9999999
         If Mid(sBuffer, nI, 2) = vbCrLf Then
           Exit For
         Else
           nSelLen = nSelLen + 1
           nI = nI + 1
         End If
       Next
       .SelLength = nSelLen
       .SelColor = RGB(0, 127, 0)

     Case Else
       If Not (Len(sTmpWord) = 0) Then
         .SelStart = nStartPos - 1
         .SelLength = Len(sTmpWord)
         nWordPos = InStr(1, gsBlackKeywords, "*" " sTmpWord " _
                          "*", 1)
         If nWordPos <> 0 Then
           .SelColor = RGB(0, 0, 0)
           .SelText = Mid(gsBlackKeywords, nWordPos + 1, _
                          Len(sTmpWord))
         End If
         nWordPos = InStr(1, gsBlueKeyWords, "*" " sTmpWord " _
                          "*", 1)
         If nWordPos <> 0 Then
           .SelColor = RGB(0, 0, 127)
           .SelText = Mid(gsBlueKeyWords, nWordPos + 1, _
                          Len(sTmpWord))
          End If
          If UCase(sTmpWord) = "REM" Then
            .SelStart = nI - 4
            .SelLength = 3
            For nJ = 1 To 9999999
              If Mid(sBuffer, nI, 2) = vbCrLf Then
                Exit For
              Else
                .SelLength = .SelLength + 1
                nI = nI + 1
              End If
            Next
            .SelColor = RGB(0, 127, 0)
            .SelText = LCase(.SelText)
          End If
        End If
        sTmpWord = ""
      End Select
    Next
    .SelStart = 0

   End With
   
End Sub

Public Sub InitColorize()
   ' #VBIDEUtils#*************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 30/10/98
   ' * Time             : 14:47
   ' * Module Name      : Colorize_Module
   ' * Module Filename  : Colorize.bas
   ' * Procedure Name   : InitColorize
   ' * Parameters       :
   ' *************************************************************
   ' * Comments         : Initialize the VB keywords
   ' *
   ' *
   ' *************************************************************

   gsBlackKeywords = "*Abs*Add*AddItem*AppActivate*Array*Asc*Atn
                      *Beep*Begin*BeginProperty*ChDir*ChDrive
                      *Choose*Chr*Clear*Collection*Command*Cos
                      *CreateObject*CurDir*DateAdd*DateDiff
                      *DatePart*DateSerial*DateValue*Day*DDB
                      *DeleteSetting*Dir*DoEvents*EndProperty
                      *Environ*EOF*Err*Exp*FileAttr*FileCopy
                      *FileDateTime*FileLen*Fix*Format*FV
                      *GetAllSettings*GetAttr*GetObject*GetSetting
                      *Hex*Hide*Hour*InputBox*InStr*Int*Int
                      *IPmt*IRR*IsArray*IsDate*IsEmpty*IsError
                      *IsMissing*IsNull*IsNumeric*IsObject*Item
                      *Kill*LCase*Left*Len*Load*Loc*LOF*Log*LTrim
                      *Me*Mid*Minute*MIRR*MkDir*Month*Now*NPer
                      *NPV*Oct*Pmt*PPmt*PV*QBColor*Raise*Randomize
                      *Rate*Remove*RemoveItem*Reset*RGB*Right*RmDir
                      *Rnd*RTrim*SaveSetting*Second*SendKeys*SetAttr
                      *Sgn*Shell*Sin*Sin*SLN*Space*Sqr*Str*StrComp
                      *StrConv*Switch*SYD*Tan*Text*Time*Time*Timer
                      *TimeSerial*TimeValue*Trim*TypeName*UCase
                      *Unload*Val*VarType*WeekDay*Width*Year*"
   gsBlueKeyWords = "*#Const*#Else*#ElseIf*#End If*#If*Alias*Alias
                     *And*As*Base*Binary*Boolean*Byte*ByVal*Call
                     *Case*CBool*CByte*CCur*CDate*CDbl*CDec
                     *CInt*CLng*Close*Compare*Const*CSng*CStr
                     *Currency*CVar*CVErr*Decimal*Declare
                     *DefBool*DefByte*DefCur*DefDate*DefDbl
                     *DefDec*DefInt*DefLng*DefObj*DefSng
                     *DefStr*DefVar*Dim*Do*Double*Each*Else
                     *ElseIf*End*Enum*Eqv*Erase*Error*Exit
                     *Explicit*False*For*Function*Get*Global
                     *GoSub*GoTo*If*Imp*In*Input*Input
                     *Integer*Is*LBound*Let*Lib*Like*Line
                     *Lock*Long*Loop*LSet*Name*New*Next*Not
                     *Object*On*Open*Option*Or*Output*Print
                     *Private*Property*Public*Put*Random*Read
                     *ReDim*Resume*Return*RSet*Seek*Select*Set
                     *Single*Spc*Static*String*Stop*Sub*Tab
                     *Then*Then*True*Type*UBound*Unlock*Variant
                     *Wend*While*With*Xor*Nothing*To*"

End Sub


Comments

  • Great ! Thanx ! But...

    Posted by Legacy on 01/09/2004 12:00am

    Originally posted by: Khoi Nguyen

    How can we added this to Change event so it will colorize when why type like VB or VS ? I tried but it is a nested code and always raise a runtime error.

    Reply
  • error & question..

    Posted by Legacy on 12/27/2002 12:00am

    Originally posted by: oldbell


    I have an Error on

    'Dim cHourglass As class_Hourglass
    Set cHourglass = New class_Hourglass'

    what's the class_Hourglass ??

    ~.~

    good luck.~

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • On-demand Event Event Date: January 28, 2015 Check out this webcast and join Jeff Sloyer, IBM Developer Evangelist and Master Inventor, for a tutorial for building cloud-based applications. Using IBM's platform as a service, Bluemix, Jeff will show you how to architect and assemble cloud-based applications built for cloud scale. Leveraging the power of microservices, developers can quickly translate monolithic applications to a cloud-based microarchitecture. This hour-long session introduces the concepts and …

  • Live Event Date: February 11, 2015 @ 1:00 p.m. ET / 10:00 a.m. PT New computing platforms, expanding information environments, recurrent security breaches and evolving regulatory frameworks are factors that security executives must contend with and address when developing their security strategy. In response to these dynamics, security executives are seeking stronger, more nimble and more pervasive security technologies to help protect business-critical information from unauthorized disclosure, loss or …

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date