'Custom tags so I can replace space with  , then replace custom tags with html. colorcodeBLU = "[$blue$]" colorcodeGRN = "[$green$]" colorcodeCLOSEFONT = "[$font$]" colorcodeOPENSTR = "[$open$]" colorcodeCLOSESTR = "[$close$]" g_Blu = "" g_Grn = "" g_CloseFont = "" g_OpenStr = "
" g_CloseStr = "
" dim InResWord 'As Boolean dim InComment 'As Boolean 'dim RW RW = Array("Const", "Else", "ElseIf", "If", "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", "Open", "Option", "On", "Or", "Output", "Preserve", "Print", "Private", _ "Property", "Public", "Put", "Random", "Read", "ReDim", "Resume", "Return", "RSet", "Seek", "Select", "Set", "Single", "Spc", "Static", "String", _ "Stop", "Sub", "Tab", "Then", "True", "Type", "UBound", "Variant", "While", "Wend", "With", "Integer,", "Long,", "Byte,", "Single,", "Double,", "Currency,", "Date,", "Variant,", "To") Function CheckReserved(s ) 'As String 'As Variant Dim i 'As Integer Dim tmp 'As String Dim lnOrig 'As String Dim ln 'As Integer tmp = UCase(Trim(s)) ln = Len(tmp) lnOrig = ln If ln > 2 Then If Mid(tmp, Len(tmp) - 1, 2) = "()" Then ln = Len(tmp) - 2 tmp = Mid(tmp, 1, ln) End If If Mid(tmp, Len(tmp), 1) = ")" Then ln = Len(tmp) - 1 tmp = Mid(tmp, 1, ln) End If If Mid(tmp, Len(tmp), 1) = ":" Then ln = Len(tmp) - 1 tmp = Mid(tmp, 1, ln) End If End If For i = 0 To UBound(RW) If UCase(RW(i)) = tmp Then If InResWord Then If ln <> lnOrig Then CheckReserved = Mid(s, 1, ln) & colorcodeCLOSEFONT & Mid(s, ln + 1) InResWord = False Else CheckReserved = s End If Else If ln <> Len(tmp) Then CheckReserved = Mid(s, 1, ln) & colorcodeCLOSEFONT & Mid(s, ln + 1) InResWord = False Else CheckReserved = colorcodeBLU & s InResWord = True End If End If Exit Function End If Next If InResWord Then CheckReserved = colorcodeCLOSEFONT & s Else CheckReserved = s End If InResWord = False End Function Function ProcessBlock(s ) 'As String 'process a raw block of code in the form of text and turn it into 'html with color coding similar to that of the VB IDE ... Dim tmp 'As String Dim i 'As Integer Dim n 'As Integer Dim m 'As Integer Dim lns 'As String Dim wrds 'As String Dim t 'As String dim pbA Dim LinCont Dim sp tmp = colorcodeOPENSTR & vbCrLf InComment = False InResWord = False LinCont = False lns = split(s, vbcrlf) for n = 0 to ubound(lns) lns(n) = RTrim(lns(n)) & " " & vbcrlf next n =0 For i = 0 To UBound(lns) 'iterate over the lines. 'wrds = GetWords(lns(i)) wrds = split(lns(i), " ") for sp = 0 to ubound(wrds) wrds(sp) = wrds(sp) & " " next 'LinCont If InComment = True Then If Mid(Trim(wrds(0)), 1, 1) <> "'" Then If LinCont = False then InComment = False tmp = tmp & colorcodeCLOSEFONT End if End If End If If Mid(Trim(wrds(0)), 1, 1) = "'" Or InComment = True Then If InResWord Then InResWord = False tmp = tmp & colorcodeCLOSEFONT End If If Not InComment Then tmp = tmp & colorcodeGRN & lns(i) Else tmp = tmp & lns(i) End If InComment = True Else For n = 0 To UBound(wrds) If Mid(Trim(wrds(n)), 1, 1) = "'" Then InComment = True If InResWord Then InResWord = False tmp = tmp & colorcodeCLOSEFONT End If tmp = tmp & colorcodeGRN For m = n To UBound(wrds) tmp = tmp & wrds(m) Next Exit For End If t = CheckReserved(wrds(n)) tmp = tmp & t Next End If if ubound(wrds) > 0 then pbA = UBound(wrds) - 1 If Mid(Trim(wrds(pbA)), 1, 1) = "_" then 'Line continue character. LinCont = True else LinCont = False End If end if Erase wrds tmp = tmp & "
" Next Erase lns If InComment Or InResWord Then tmp = tmp & colorcodeCLOSEFONT End If tmp = tmp & colorcodeCLOSESTR & vbCrLf tmp = Replace(tmp, " ", " ") tmp = Replace(tmp, colorcodeBLU, g_Blu) tmp = Replace(tmp, colorcodeGRN, g_Grn) tmp = Replace(tmp, colorcodeCLOSEFONT, g_CloseFont) tmp = Replace(tmp, colorcodeOPENSTR, g_OpenStr) tmp = Replace(tmp, colorcodeCLOSESTR, g_CloseStr) ProcessBlock = tmp End Function