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