Word中高亮程序代码的宏

' script to high light code In document 

Private Function isKeyword(w) As Boolean

    Dim keys As New Collection

    With keys

        .Add " if": .Add "else": .Add "switch": .Add "cAse": .Add "default": .Add "break"

        .Add "goto": .Add "return": .Add "for": .Add "while": .Add "do": .Add "contInue" 

        .Add "typedef": .Add "sizeof": .Add "NULL": .Add "new": .Add "delete": .Add "throw" 

        .Add "try": .Add "catch": .Add "namespace": .Add "operator": .Add "this": .Add "const_cAst" 

        .Add "static_cast": .Add "dynamic_cast": .Add "reInterpret_cAst": .Add "true" 

        .Add "false": .Add "null": .Add "usIng": .Add "typeid": .Add "and": .Add "and_eq" 

        .Add "bitand": .Add "bitor": .Add "compl": .Add "not": .Add "not_eq": .Add "or" 

        .Add "or_eq": .Add "xor": .Add "xor_eq" 

    End With

    isKeyword = isSpecial(w, keys) 

End Function

 

Private Function isSpecial(ByVal w As String, ByRef col As Collection) As Boolean

    For Each i In col

        If w = i Then

            isSpecial = True

            Exit Function

        End If

    Next

    isspeical = False 

End Function

 

Private Function isOperator(w) As Boolean

    Dim ops As New Collection

    With ops

        .Add "+": .Add "-": .Add "*": .Add "/": .Add "&": .Add "^": .Add ";" 

        .Add "%": .Add "#": .Add "!": .Add ":": .Add ",": .Add "." 

        .Add "||": .Add "&&": .Add "|": .Add "=": .Add "++": .Add "--" 

        .Add "'": .Add """" 

    End With

    isOperator = isSpecial(w, ops) 

End Function

 

Private Function isType(ByVal w As String) As Boolean

    Dim types As New Collection

    With types

        .Add "void": .Add "struct": .Add "union": .Add "enum": .Add "char": .Add "short": .Add "Int" 

        .Add "long": .Add "double": .Add "float": .Add "signed": .Add "unsigned": .Add "const": .Add "static" 

        .Add "extern": .Add "auto": .Add "register": .Add "volatile": .Add "bool": .Add "clAss": .Add " private"

        .Add "protected": .Add "public": .Add "fri end": .Add "InlIne": .Add "template": .Add "virtual"

        .Add "Asm": .Add "explicit": .Add "typename" 

End With

 isType = isSpecial(w, types) 

End Function

Sub SyntaxHighlight()

    Dim wordCount As Integer

    Dim d As Integer

    ' set the style of selection 

    Selection.Style = "code" 

    

    d = 0

    wordCount = Selection.Words.Count 

    Selection.StartOf wdWord

    While d < wordCount

        d = d + Selection.MoveRight (wdWord, 1, wdExtend)

        w = Selection.Text 

        If isKeyword(Trim(w)) = True Then

            Selection.Font.Color = wdColorBlue

        ElseIf isType(Trim(w)) = True Then

            Selection.Font.Color = wdColorDarkRed

            Selection.Font.Bold = True

        ElseIf isOperator(Trim(w)) = True Then

            Selection.Font.Color = wdColorBrown

        ElseIf Trim(w) = "//" Then

            'lIne comment 

            Selection.Move End wdLIne, 1

            commentWords = Selection.Words.Count

            d = d + commentWords 

            Selection.Font.Color = wdColorGreen

            Selection.MoveStart wdWord, commentWords

         ElseIf Trim(w) = "/*" Then

            'block comment

            

            While Selection.Characters.LAst <> "/"

                Selection.MoveLeft wdCharacter, 1, wdExtEnd

                Selection.Move EndUntil ("*")

                Selection.MoveRight wdCharacter, 2, wdExtEnd

            Wend

 

            commentWords = Selection.Words.Count

            d = d + commentWords 

            Selection.Font.Color = wdColorGreen

            Selection.MoveStart wdWord, commentWords

        End If

        'move the start of selection to next word

        Selection.MoveStart wdWord

    Wend

    

    ' prepare For set lIne number

    Selection.MoveLeft wdWord, wordCount, wdExtend

    SetLIneNumber 

End Sub

 

Private Sub SetLIneNumber()

    Dim lines As Integer

    lines = Selection.Paragraphs.Count 

    Selection.StartOf wdParagraph

    For l = 1 To lines

        lIneNum = l & " " 

        If l < 10 Then

            lIneNum = lIneNum & " " 

        End If

        Selection.Text = lIneNum

        Selection.Font.Bold = False

        Selection.Font.Color = wdColorAutomatic

        p = Selection.MoveDown (wdLIne, 1, wdMove)

        Selection.StartOf wdLIne

    Next l

End Sub