modruntime.bas

用VB实现的编译器的源代码

                End If
            Else
                ReturnValue = VarOutp
            End If
            
        Case "+"  ' +globalVariable
            PublicVars("FreefileNumber") = FreeFile
            ReturnValue = PublicVars(FragmentRaw)
        
        Case "#"  ' #ParameterName
            ReturnValue = CurrentLocal.getParameterContent(CurrentLocal.CurrentRunningMethod, FragmentRaw)
            
        Case "!"  ' !true !false
            If FragmentRaw = "true" Then ReturnValue = True
            If FragmentRaw = "false" Then ReturnValue = False
        
        Case ";"  ' ;Object
            If FragmentRaw = "this" Then FragmentRaw = CurrentLocal.name
            ReturnValue = getObject(FragmentRaw)
                            
        Case "?"
            Select Case Left(FragmentRaw, 1)
                Case "F" 'ASCII File
                    TempStr = ""
                    Open Mid(FragmentRaw, 3) For Input As #1
                        Do Until EOF(1)
                            Line Input #1, Line
                            TempStr = TempStr & Line & vbCrLf
                        Loop
                    Close #1
                    ReturnValue = TempStr
                    
                Case "R" 'Reference
                    ReturnValue = "OBJID_" & Mid(FragmentRaw, 3)
                
                Case "N" 'New Object
                    Randomize Timer
                    i = Int(Rnd * 32768)
                    J = Int(Rnd * i)
                    k = Int(Rnd * J)
                    CreateNewObject "Object" & i, Mid(FragmentRaw, 3)
                    GlobalDataExchangeVariable = i
                    ReturnValue = "Object" & i
                
            End Select
            
        Case "{"
            FragmentRaw = Left(FragmentRaw, Len(FragmentRaw) - 1)
            CrackUp = Split(FragmentRaw, " ")
            FunctionCall$ = CStr(CrackUp(0))
            sFunctionCall = Split(FunctionCall, ".")
            ObjectID$ = CStr(sFunctionCall(0))
            If ObjectID = "this" Then ObjectID = CurrentLocal.name: ToDebug ("This=" & CurrentLocal.name)
            Set TempCL = CurrentLocal
            MethodID$ = CStr(sFunctionCall(1))
            getObject(ObjectID).ExecuteFunction MethodID$, _
                    getValueFromExpression(FragmentRaw, 1), _
                    getValueFromExpression(FragmentRaw, 2), _
                    getValueFromExpression(FragmentRaw, 3), _
                    getValueFromExpression(FragmentRaw, 4), _
                    getValueFromExpression(FragmentRaw, 5), _
                    getValueFromExpression(FragmentRaw, 6), _
                    getValueFromExpression(FragmentRaw, 7), _
                    getValueFromExpression(FragmentRaw, 8)
            Set CurrentLocal = TempCL
            ReturnValue = FunctionReturn
            
        Case "@"  ' Number @12345
            'ALT ReturnValue = CDbl(FragmentRaw)
            ReturnValue = Val(FragmentRaw)
            
        Case Else
            ReturnValue = Val(Identifier & FragmentRaw)
        
    End Select
    
    ParseExpressionFragment = ReturnValue
End Function

Public Function getControl(Owner As Class, CID As String) As Object
    Set getControl = AllControls(CInt(Owner.ControlCollection(CID)))
End Function

Public Sub registerControl(OwnerObject As Class, CID As String, NewControl As Object)
    Set AllControls(NewControlIndex) = NewControl
    OwnerObject.ControlCollection.Add CID, NewControlIndex
    NewControlIndex = NewControlIndex + 1
End Sub

Public Sub ReadGlobalVars()
    On Error Resume Next
    f = 0
    Do Until ProgramLines(f) = "global" Or f > Pointer
     f = f + 1
    Loop
    HSMode = False
    
    PublicVars.Add "AppPath", App.Path
    PublicVars.Add "ScreenXConstant", Screen.TwipsPerPixelX
    PublicVars.Add "ScreenYConstant", Screen.TwipsPerPixelY
    PublicVars.Add "ScreenWidth", Screen.Width
    PublicVars.Add "ScreenHeight", Screen.Width
    PublicVars.Add "MsgBoxReturn", 0
    PublicVars.Add "Misc", ""
    PublicVars.Add "FreefileNumber", FreeFile
    
    PublicVars.Add "cMsgYes", vbYes
    PublicVars.Add "cMsgNo", vbNo
    PublicVars.Add "cMsgCancel", vbCancel
    PublicVars.Add "cMsgOK", vbOK
    PublicVars.Add "cMsgAbort", vbAbort
    PublicVars.Add "cMsgRetry", vbRetry
    PublicVars.Add "cMsgIgnore", vbIgnore
    PublicVars.Add "cMsgStModal", vbSystemModal
    PublicVars.Add "cMsgStQuestion", vbQuestion
    PublicVars.Add "cMsgStInfo", vbInformation
    PublicVars.Add "cMsgStExclamation", vbExclamation
    PublicVars.Add "cMsgStError", vbCritical
    PublicVars.Add "cMsgStYesNo", vbYesNo
    PublicVars.Add "cMsgStYesNoCancel", vbYesNoCancel
    PublicVars.Add "cMsgStOKCancel", vbOKCancel
    PublicVars.Add "cMsgStAbortRetryIgnore", vbAbortRetryIgnore
    
    ToDebug "Found public variable declarations in line " & f
    Do
        If Left(ProgramLines(f), "8") = "variable" Then
            PublicVars.Add Mid(ProgramLines(f), 10), getValueFromExpression(ProgramLines(f + 2))
            ToDebug "Declaring public variable " & Mid(ProgramLines(f), 10) & " = " & getValueFromExpression(ProgramLines(f + 2))
        End If
        f = f + 1
    Loop Until ProgramLines(f) = "end global"
End Sub

Public Sub CreateNewObject(name As String, BaseClass As String)
    On Error Resume Next
    Dim TempClass As Class
    Classes.Add name, Nothing
    Set Classes(name) = New Class
    Set TempClass = Classes(name)
    TempClass.name = name
    TempClass.BaseClass = BaseClass
    ToDebug "Creating new object " & name & " from class " & BaseClass
    For f = 0 To Pointer
        If ProgramLines(f) = "class " & BaseClass Then
            TempClass.ReferenceLine = f
            Do Until ProgramLines(f) = "<methods>"
                f = f + 1
                If Left(ProgramLines(f), 8) = "variable" Then
                    TempClass.Variables.Add Mid(ProgramLines(f), 10), getValueFromExpression(ProgramLines(f + 2))
                    ToDebug " Variable " & Mid(ProgramLines(f), 10) & " is defined. Start value is " & getValueFromExpression(ProgramLines(f + 2))
                End If
                If Left(ProgramLines(f), 6) = "method" Then
                    For g = 2 To CInt(ProgramLines(f + 1)) + 1
                        TempClass.createMethodParameter g - 1, Mid(ProgramLines(f), 8), ProgramLines(f + g)
                        ToDebug " Method " & Mid(ProgramLines(f), 8) & " gets the parameter " & ProgramLines(f + g)
                    Next g
                End If
            Loop
        End If
    Next f
    TempClass.ExecuteVoid "constructor", "", "", "", "", "", "", "", ""
End Sub

Public Sub Interprete(Statement As String, ReferenceObject As Class)
    If HSMode = True Then DoEvents
    If InStr(Statement, SplitChar) Then
        LinesArray = Split(Statement, SplitChar)
        For f = LBound(LinesArray) To UBound(LinesArray)
            Interprete Trim(CStr(LinesArray(f))), ReferenceObject
        Next f
        Exit Sub
    End If
    Dim Q As Class
    ToDebug "INTERPRETING: " & Statement
    D = Split(Statement, " ")
    Select Case D(0)
    
        Case "assignForm"
            Select Case D(1)
                Case "fixed"
                    Set ReferenceObject.ThisClassesForm = New frmFixed
                Case "flex"
                    Set ReferenceObject.ThisClassesForm = New frmFlex
                Case "dialog"
                    Set ReferenceObject.ThisClassesForm = New frmDialog
                Case "tool"
                    Set ReferenceObject.ThisClassesForm = New frmTool
            End Select
            Set ReferenceObject.ThisClassesForm.Owner = ReferenceObject
            Set ReferenceObject.ThisClassesForm.ClassicalOwner = ReferenceObject
            ReferenceObject.ThisClassesForm.Caption = getValueFromExpression(Statement, 1)
            ReferenceObject.ThisClassesForm.Width = getValueFromExpression(Statement, 2) * Screen.TwipsPerPixelX
            ReferenceObject.ThisClassesForm.Height = getValueFromExpression(Statement, 3) * Screen.TwipsPerPixelY
            ReferenceObject.ThisClassesForm.Show
            Set AllControls(NewControlIndex) = ReferenceObject.ThisClassesForm
            ReferenceObject.ControlCollection.Add "Form", NewControlIndex
            NewControlIndex = NewControlIndex + 1
            
        Case "setFormIcon"
            ReferenceObject.ThisClassesForm.Icon = LoadPicture(getValueFromExpression(Statement))
        
        Case "toLog"
            ToDebug getValueFromExpression(Statement)
        
        Case "windowLoop"
            Do Until BreakWinLoop
                Sleep 2
                DoEvents
            Loop
            BreakWinLoop = False
            getObject("AppMain").ExecuteVoid "event_AppMain_quitUI", "", "", "", "", "", "", "", ""
            
        Case "addControl"
            Select Case D(1)
                Case "PictureBox"
                    Load ReferenceObject.ThisClassesForm.PictureBox(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.PictureBox(NewControlIndex)
                
                Case "Label"
                    Load ReferenceObject.ThisClassesForm.Label(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.Label(NewControlIndex)
                
                Case "TextBox"
                    Load ReferenceObject.ThisClassesForm.TextBox(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.TextBox(NewControlIndex)
                
                Case "Frame"
                    Load ReferenceObject.ThisClassesForm.Frame(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.Frame(NewControlIndex)
                
                Case "CommandButton"
                    Load ReferenceObject.ThisClassesForm.CommandButton(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.CommandButton(NewControlIndex)
                
                Case "CheckBox"
                    Load ReferenceObject.ThisClassesForm.CheckBox(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.CheckBox(NewControlIndex)
                
                Case "OptionButton"
                    Load ReferenceObject.ThisClassesForm.OptionButton(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.OptionButton(NewControlIndex)
                
                Case "ComboBox"
                    Load ReferenceObject.ThisClassesForm.ComboBox(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.ComboBox(NewControlIndex)
                
                Case "ListBox"
                    Load ReferenceObject.ThisClassesForm.ListBox(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.ListBox(NewControlIndex)
                
                Case "Timer"
                    Load ReferenceObject.ThisClassesForm.Timer(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.Timer(NewControlIndex)

                Case "TextArea"
                    Load ReferenceObject.ThisClassesForm.TextArea(NewControlIndex)
                    registerControl ReferenceObject, CStr(D(2)), ReferenceObject.ThisClassesForm.TextArea(NewControlIndex)
            End Select
        
        Case "set"
            If D(1) = "global" Then
                PublicVars(D(2)) = getValueFromExpression(Statement, 1)
                If GlobalDataExchangeVariable > 0 Then
                    Classes.Item(D(2)) = "-Object" & GlobalDataExchangeVariable
                End If
                Exit Sub
            End If
            ObjectPath = Split(CStr(D(1)), ".")
            ObjectID$ = CStr(ObjectPath(0))
            If ObjectID = "this" Then ObjectID = CurrentLocal.name
            PropertyID$ = CStr(ObjectPath(1))
            VariableContent = getObject(ObjectID).Variables(PropertyID)
            If Len(VariableContent) > Len("OBJID_") Then
                If Left(VariableContent, 6) = "OBJID_" Then
                    CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbLet, getValueFromExpression(Statement, 1)
                    Exit Sub
                End If
            End If
            Set o = getObject(ObjectID)
            o.Variables(PropertyID) = getValueFromExpression(Statement, 1)
        
        Case "declare"
            ReferenceObject.Variables.Add CStr(D(1)), getValueFromExpression(Statement, 1)
        
        Case "quitUI"
            BreakWinLoop = True
        
        Case ">"
            ObjectPath = Split(CStr(D(1)), ".")
            ObjectID$ = CStr(ObjectPath(0))
            If ObjectID = "this" Then ObjectID = CurrentLocal.name: ToDebug "This=" & CurrentLocal.name
            PropertyID$ = CStr(ObjectPath(1))
            VariableContent = getObject(ObjectID).Variables(PropertyID)
            If Len(VariableContent) > Len("OBJID_") Then
                If Left(VariableContent, 6) = "OBJID_" Then
                    Select Case CInt(D(2))
                        Case 0
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod
                        
                        Case 1
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod, getValueFromExpression(Statement, 1)
                        
                        Case 2
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod, getValueFromExpression(Statement, 1), _
                                                                                                                                                         getValueFromExpression(Statement, 2)
                        
                        Case 3
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod, getValueFromExpression(Statement, 1), _
                                                                                                                                                         getValueFromExpression(Statement, 2), _
                                                                                                                                                         getValueFromExpression(Statement, 3)
                        
                        Case 4
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod, getValueFromExpression(Statement, 1), _
                                                                                                                                                         getValueFromExpression(Statement, 2), _
                                                                                                                                                         getValueFromExpression(Statement, 3), _
                                                                                                                                                         getValueFromExpression(Statement, 4)
                        
                        Case 5
                            CallByName AllControls(CInt(getObject(ObjectID).ControlCollection(Mid(VariableContent, 7)))), CStr(ObjectPath(2)), VbMethod, getValueFromExpression(Statement, 1), _
                                                                                                                                                         getValueFromExpression(Statement, 2), _
                                                                                                                                                         getValueFromExpression(Statement, 3), _
                                                                                                                                                         getValueFromExpression(Statement, 4), _
                                                                                                                                                         getValueFromExpression(Statement, 5)
                    End Select
                    Exit Sub