csyntax.cls

VB写的一个IDE开发环境,支持脚本运行,内置了一个简单的编译器,可以直接生成EXE.. 推荐下载!

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSyntax"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Option Compare Binary

Public Event Progress(ByVal Value As Integer) '*处理进度

Private m_initSTX As Boolean            '语法初始化标记
Private m_oString As CStringBuilder     '大字符串连接类

Private m_sTitle            As String   '*语法文件Title

Private m_sLnCommFlag1      As String   '*行注释头一
Private m_sLnCommFlag2      As String   '*行注释头二
Private m_sBlkCommHead1     As String   '*块注释头一
Private m_sBlkCommFoot1     As String   '*块注释尾一
Private m_sBlkCommHead2     As String   '*块注释头二
Private m_sBlkCommFoot2     As String   '*块注释尾二
Private m_objCommFont       As CFont    '*注释字体设置

Private m_sCommRtfHead      As String   '*注释字体RTF格式头
Private m_sCommRtfFoot      As String   '*注释字体RTF格式尾

Private m_objNumFont        As CFont    '*数字字体设置

Private m_sNumRtfHead       As String   '*数字字体RTF格式头
Private m_sNumRtfFoot       As String   '*数字字体RTF格式尾

Private m_iKwdCount         As Integer  '*关键字类型数
Private m_sKwdSet()         As String   '*存入一类关键字的全部组合(以chr(3)分隔)
Private m_sKwdTitle()       As String   '*此关键字类型的名称
Private m_objKwdFont()      As CFont    '*此关键字类型的字体设置
Private m_sKwdRtfHead()     As String   '*关键字字体RTF格式头
Private m_sKwdRtfFoot()     As String   '*关键字字体RTF格式尾

Private m_bCase             As Boolean  '*是否大小字敏感

Private m_sQuotFlag1        As String   '*字符串边界一
Private m_sQuotFlag2        As String   '*字符串边界二
Private m_bMultiLine        As Boolean  '*是否续行有效
Private m_objQuotFont       As CFont    '*字符串字体设置
Private m_sQuotRtfHead      As String   '*字符串字体RTF格式头
Private m_sQuotRtfFoot      As String   '*字符串字体RTF格式尾

Private m_sEscape           As String   '*后面跟敏感字符，此字符后面字符忽略

Private m_objColorManager   As CColor   '*颜色管理类
Private m_sColorRtf         As String   '*RTF内颜色信息

Private m_sWord()         As String     '*对一行字符串分隔成一个词数组

Private m_iQuotState        As Integer  '*当前是否在字符串内[0..不是字符串/1..在字符串一内/2..在字符串二内]
Private m_iCommState        As Integer  '*当前注释状态[0..无注释/1..单行注释一/2..单行注释二/3..多行注释一/4..多行注释二]

Private Const DELIMITER = ",(){}[]-+*%/='~!&|\<>?:;."

'*RTF文件头(First和Last之间插入颜色和字体信息
Private Const HEAD_FIRST = "{\rtf1\ansi\ansicpg936\deff0{\fonttbl}{\colortbl ;"
Private Const HEAD_LAST = "}\viewkind4\uc1\pard\lang2052\f0\fs"  'fs** 控制字体大小

Private Const HEAD_HTML = "<PRE>"
Private Const TAIL_HTML = "</PRE>"

'----------------------VB 语法常量------------------------
Private Const STX_BASE = "#QUOTATION1="",#QUOTATION2=,#CONTINUE_QUOTE=,#LINECOMMENT=',#LINECOMMENT2=rem,#COMMENTON=,#COMMENTOFF=,#COMMENTON2=,#COMMENTOFF2=,#ESCAPE=,#CASE=n"
Private Const STX_QUOTATION = "ForeColor=0,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_COMMENT = "ForeColor=33280,backcolor=,bold=,italic=,underline=,strike="
'Private Const STX_NUMBER = "ForeColor=65535,backcolor=,bold=,italic=,underline=,strike="
'Private Const STX_OPERATOR = "ForeColor=65280,backcolor=,bold=,italic=,underline=,strike="
'Private Const STX_KEYWORD = "ForeColor=8388608,backcolor=,bold=,italic=,underline=,strike="
'Private Const STX_FUNCTION = "ForeColor=8388608,backcolor=,bold=,italic=,underline=,strike="
'Private Const VB_OPERATORS = "&,+,-,*,\,/,^,>,<,>=,<=,<>,=,%"

'    ReadKeys "Keyword", STX_KEYWORD, VB_KEYWORDS
'    ReadKeys "Operator", STX_OPERATOR, VB_OPERATORS 65535
'    ReadKeys "Function", STX_FUNCTION, VB_FUNCTIONS
'    ReadKeys "Propertie", STX_PROPERTIE, VB_PROPERTIES

'**************************************************************
'*HighLightRichEdit
'*功能：对控件进行语法高亮显示
'*说明：
'*传入参数：
'*    ctrl      类型：RichTextBox
'*返回参数：
'*
'*作者：progame  日期：2002-09-29  17:38:22
'**************************************************************
Public Sub HighLightRichEdit(ByRef ctrl As RichTextBox)
Dim oLoc As Long
Dim oLen As Long
    
    If Not m_initSTX Then ReadSTX     '读入语法
    
    oLoc = ctrl.SelStart
    oLen = ctrl.SelLength

    HighLightCtrl ctrl
    
    ctrl.SelStart = oLoc
    ctrl.SelLength = oLen
End Sub

Private Sub ReadSTX()
'*将语法读入
Dim i As Integer
    
    '读语法细节
    Call ReadDetail
    
    '*对字体的字符串预先生成
    m_sQuotRtfHead = m_objQuotFont.getRtfHead(m_objColorManager)
    m_sQuotRtfFoot = m_objQuotFont.getRtfTail
    m_sCommRtfHead = m_objCommFont.getRtfHead(m_objColorManager)
    m_sCommRtfFoot = m_objCommFont.getRtfTail
    
    m_sNumRtfHead = m_objNumFont.getRtfHead(m_objColorManager)
    m_sNumRtfFoot = m_objNumFont.getRtfTail
    
    m_sColorRtf = m_objColorManager.ComStr
    
    For i = 1 To m_iKwdCount
        m_sKwdRtfHead(i) = m_objKwdFont(i).getRtfHead(m_objColorManager)
        m_sKwdRtfFoot(i) = m_objKwdFont(i).getRtfTail
    Next i
    
    m_initSTX = True
End Sub

Private Sub ReadDetail()
'*读取语法的具体实现
Dim sTmp        As String
Dim i           As Integer
Dim l           As Integer
Dim lstr        As String
Dim rstr        As String
Dim readArr()   As String

    
    '*读取字符串的字体配置
    readArr = Split(STX_QUOTATION, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objQuotFont)
    Next
    
     '*读取注释的字体配置
    readArr = Split(STX_COMMENT, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
            
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objCommFont)
    Next
    
     '*读取数字的字体配置
    readArr = Split(STX_NUMBER, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objNumFont)
    Next
    
    On Error Resume Next
    '*读取关键字
    ReadKeys "Keyword", STX_KEYWORD, VB_KEYWORDS
    ReadKeys "Operator", STX_OPERATOR, VB_OPERATORS
    ReadKeys "Function", STX_FUNCTION, VB_FUNCTIONS
    ReadKeys "Propertie", STX_PROPERTIE, VB_PROPERTIES
    
    '*读取基本配置
    readArr = Split(STX_BASE, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        i = InStr(sTmp, "=")
        
        lstr = Trim(Left(sTmp, i - 1))
        rstr = Trim(Right(sTmp, Len(sTmp) - i))
        
        Select Case UCase(lstr)
            Case "#TITLE"
                rstr = rstr
            Case "#QUOTATION1"
                m_sQuotFlag1 = rstr
            Case "#QUOTATION2"
                m_sQuotFlag2 = rstr
            Case "#CONTINUE_QUOTE"
                m_bMultiLine = IIf(LCase(rstr) = "y", True, False)
            Case "#LINECOMMENT"
                m_sLnCommFlag1 = rstr
            Case "#LINECOMMENT2"
                m_sLnCommFlag2 = rstr
            Case "#COMMENTON"
                m_sBlkCommHead1 = rstr
            Case "#COMMENTOFF"
                m_sBlkCommFoot1 = rstr
            Case "#COMMENTON2"
                m_sBlkCommHead2 = rstr
            Case "#COMMENTOFF2"
                m_sBlkCommFoot2 = rstr
            Case "#CASE"
                m_bCase = IIf(LCase(rstr) = "y", True, False)
            Case "#ESCAPE"
                m_sEscape = rstr
            Case Else
               '
        End Select
    Next
End Sub

Private Sub PreFormat(ByRef s As String)
'*进语法文件预处理，因为到时候代码会先进行格式化以适应"}" "{" "\"
    s = Replace(Replace(Replace(s, "\", "\\"), "{", "\{"), "}", "\}")
End Sub

Private Sub ReadKeys(ByVal KeyName As String, ByVal KeySTX As String, ByVal Keywords As String)
'*读取关键字

Dim sTmp As String
Dim readArr() As String
Dim i As Integer
Dim l As Integer

    sTmp = KeyName
    m_iKwdCount = m_iKwdCount + 1
    
    ReDim Preserve m_sKwdSet(1 To m_iKwdCount)
    ReDim Preserve m_sKwdTitle(1 To m_iKwdCount)
    ReDim Preserve m_objKwdFont(1 To m_iKwdCount)
    ReDim Preserve m_sKwdRtfHead(1 To m_iKwdCount)
    ReDim Preserve m_sKwdRtfFoot(1 To m_iKwdCount)
    
    Set m_objKwdFont(m_iKwdCount) = New CFont
    
    m_sKwdTitle(m_iKwdCount) = sTmp
    m_sKwdSet(m_iKwdCount) = Chr(3)
    
    '关键字的字体配置
    readArr = Split(KeySTX, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objKwdFont(m_iKwdCount))
    Next
    
    '读取关键字的详细内容
    readArr = Split(Keywords, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        m_sKwdSet(m_iKwdCount) = m_sKwdSet(m_iKwdCount) & IIf(m_bCase, Trim(sTmp), UCase(Trim(sTmp))) & Chr(3)
    Next

End Sub

Private Sub ReadFont(ByVal sValue As String, ByVal i As Integer, ByRef Font As CFont)
'*读取文件中的字体设置
'*      i       --"="所在位置
'*      font    --要传入的字体类

Dim lstr        As String
Dim rstr        As String
    lstr = Trim(Left(sValue, i - 1))
    rstr = Trim(Right(sValue, Len(sValue) - i))
    If lstr <> "" And rstr <> "" Then
        Select Case LCase(lstr)
            Case "forecolor"
                Font.bForecolor = True
                Font.ForeColor = rstr
                m_objColorManager.AddColor CLng(rstr)
            Case "backcolor"
                Font.bBackcolor = True
                Font.BackColor = rstr
                m_objColorManager.AddColor CLng(rstr)
            Case "bold"
                Font.Bold = IIf(LCase(rstr) = "y", True, False)
            Case "italic"
                Font.italic = IIf(LCase(rstr) = "y", True, False)
            Case "underline"
                Font.Underline = IIf(LCase(rstr) = "y", True, False)
            Case "strike"
                Font.Strike = IIf(LCase(rstr) = "y", True, False)
            Case Else
                '
                
        End Select
    End If
End Sub

Private Sub Class_Initialize()
    Set m_objColorManager = New CColor
    Set m_objCommFont = New CFont
    Set m_objQuotFont = New CFont
    Set m_objNumFont = New CFont
    Set m_oString = New CStringBuilder
End Sub

Private Sub Class_Terminate()
Dim i   As Integer

    Set m_objColorManager = Nothing
    Set m_objCommFont = Nothing
    Set m_objQuotFont = Nothing
    Set m_objNumFont = Nothing
    Set m_oString = Nothing
    
    For i = 1 To m_iKwdCount
        Set m_objKwdFont(i) = Nothing
    Next i
    
    Erase m_objKwdFont
    Erase m_sKwdTitle
    Erase m_sKwdSet
    Erase m_sKwdRtfHead
    Erase m_sKwdRtfFoot
    Erase m_sWord
End Sub

'**************************************************************
'*HighLightCtrl
'*功能：对控件进行语法高亮显示
'*说明：
'*传入参数：
'*    ctrl           类型：RichTextBox      --控件
'*返回参数：
'*
'*作者：progame  日期：2002-09-29  17:38:22
'**************************************************************
Private Sub HighLightCtrl(ByRef ctrl As RichTextBox)
Dim sLine() As String
Dim i       As Long