frmmain.frm

多种图表的绘制及其运用

   ''''''''''''''''''''''''''''

    frmScreen.clearScreen
    frmVars.clearVars
    frmStack.clearStack
    
    ' this replaces (simulates the "FUNCTION") - just file isn't loaded:
    
    ' [*] save param of previous function:
    frmStack.PUSH (frmVars.ifVarGetValue("PARAM"))
    
    frmStack.PUSH "PAR-OS" ' parameter(s).
    frmStack.PUSH "RET-OS" ' where to store result in.
    frmStack.PUSH "CS-OS"    ' CS.
    frmStack.PUSH "IP-OS"    ' IP.
    
    ' find block with "START" action,
    '        and start execution from there:
    Set currentRunPointer = findBlock("START")
    setSelector currentRunPointer
    cmdRun.Enabled = False              ' Disable Start button,
    '''cmdStop.SetFocus                    '   until Stop pressed.
    ''' "SetFocus" makes problems when frmMain is not visible.
          
    ' disable all controls that can prevent the right execution:
    enableOtherControls False
    
    ' get the number of seconds elapsed since midnight:
    STARTED_TIME = Timer
    
    StartExecution          ' Start execution.

End Sub

Public Sub StartExecution()
    timerRunner.Enabled = True

    ' in case timerRunner.Interval=0 , then timer doesn't
    ' execute, so we are using an eternal loop (this makes
    ' a turbo speed execution).
    ' Loop doesn't execute when timerRunner.Interval<>0!
    If timerRunner.Interval = 0 Then
        ' when timer gets disabled, loop stops:
        Do While timerRunner.Enabled
            timerRunner_Timer
            ' to prevent hang-ups
            '   (though this slows down the speed a little):
            DoEvents
        Loop
    Else
        ' #020104:
        ' in case not turbo speed, then enable the pause:
        chkPause.Enabled = True
    End If
End Sub


Public Sub TerminateExecution()
    If bGUI Then ' theObjectShape is set only with GUI.
        ' make sure the selected object for editing
        '  will be the same object that is selected
        '   currenlty (where we stoped):
        If Not (currentRunPointer Is Nothing) Then ' jic.
            SELECTED_SHAPE = currentRunPointer.theObjectShape.Index
        End If
        PREV_SELECTED_SHAPE = -1
    End If
    
    Set currentRunPointer = Nothing ' no need to keep it.


    ' in case we're waiting for input, stop it:
    frmScreen.timerInput.Enabled = False

    ' stop the main program timer:
    timerRunner.Enabled = False

    ' enable "Run" button:
    cmdRun.Enabled = True

    ' enalbe all controls again:
    enableOtherControls True


    If bWINDOW_ACTIVATED Then ' bWINDOW_LOADED Then
        ' don't let frmWindow execute UNLOAD()
        '  and start the timer:
        FORCE_CLOSE = True
        If Not bWINDOW_IS_RESIZING Then
            Unload frmWindow
        End If
    End If

    ' in case we are running from prompt:
    If CLOSE_APP_ON_END Then
        ' wait until frmScreen is closed, or
        '  some message is closed:
 ' '   removed because it makes problems -
 ' '   (frmWindow never closes):
 ' '      Do While frmScreen.Visible Or frm_mBox.Visible
 ' '          DoEvents
 ' '      Loop
 ' ' so now it's up to frmScreen and frm_mBox to call Terminate_APPLICATION()
 ' '   when they are closed:
        If (b_frmScreenVisible = False) And (b_frm_mBoxVisible = False) Then
            Terminate_APPLICATION
        Else
            bTERMINATE_ON_CLOSE = True
        End If
    End If


    ' #020104:
    chkPause.Enabled = False
    chkPause.Value = vbUnchecked
    
End Sub

' disable/enable all controls that can prevent the right execution:
Private Sub enableOtherControls(b As Boolean)
    fraToolBar1.Visible = b
    fraToolBar2.Visible = b
    mnuFile.Enabled = b
    mnuChangeShape.Enabled = b
    mnuDelete.Enabled = b
    mnuAddCaptionToLine.Enabled = b
    
    If b = False Then
        ' it's required to disable the executing speed
        '   changer only when it is set to zero:
        If scroll_ExecutionDelay.Value = 0 Then
            scroll_ExecutionDelay.Enabled = False
        Else
            ' do no allow to set executing speed to
            '  zero while running the flow because it is
            '    done by a loop and not the timer delay:
            scroll_ExecutionDelay.Min = 1
        End If
    Else
        scroll_ExecutionDelay.Min = 0 ' allow to set any speed.
        scroll_ExecutionDelay.Enabled = True
    End If
End Sub

Private Sub scroll_ExecutionDelay_Scroll()
    scroll_ExecutionDelay_Change
End Sub

' the speed of execution:
Private Sub scroll_ExecutionDelay_Change()
    timerRunner.Interval = scroll_ExecutionDelay.Value
    
    ' #020104:
    ' the eternal delay?
    If scroll_ExecutionDelay.Value = scroll_ExecutionDelay.Max Then
        lblDelay.Caption = cLang("delay") & ": P"
        timerRunner.Interval = 1
    Else
        lblDelay.Caption = cLang("delay") & ":" & scroll_ExecutionDelay.Value
    End If
End Sub

Private Sub timerRunner_Timer()
    
    'Debug.Print currentRunPointer.zAction
    
    ' catch all errors:
    On Error GoTo err1
    
    ' variants:
    Dim OP1, OP2
    
    ' for string operations:
    Dim s1 As String
    Dim s2 As String
    
    ' if currentRunPointer is not connected, then exit:
    If currentRunPointer Is Nothing Then
        TerminateExecution
        Exit Sub
    End If
    
    ' this is done twice in this sub:
    setSelector currentRunPointer
        
        
        
    ' 1.88
    ' make sure the selected object for editing
    '  will be the same object that is selected
    '   currenlty (where we stoped):
    If bGUI Then
        If Not (currentRunPointer Is Nothing) Then ' jic.
            SELECTED_SHAPE = currentRunPointer.theObjectShape.Index
        End If
        PREV_SELECTED_SHAPE = -1
    End If
        
        
        
    Select Case currentRunPointer.zAction
    
    Case "START"
        ' read parameter(s) from stack:
        If (frmStack.SP + 3) < frmStack.grid.Rows Then
          frmVars.setVar "PARAM", frmStack.grid.TextMatrix(frmStack.SP + 3, 2)
        Else
          mBox "Wrong function call - cannot read parameters from stack."
        End If
        
        ' parameter should be read from stack
        ' before pushing the local variables.
        
        ' push all local variables,
        '   (no need to search, since we keep the list in start block):
        push_LOCAL_vars currentRunPointer.zParam1
        
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
        
        
    Case "INPUT"
        Dim sTemp As String
        If frmScreen.WindowState = vbMinimized Then
            frmScreen.WindowState = vbNormal
        End If
        frmScreen.Show , Me
        ' old version ' sTemp = InputBox(currentRunPointer.zParam1, cLang("input"))
        sTemp = frmScreen.inputLine(currentRunPointer.zParam1)
        ' in case flow is stopped in the middle of input,
        '   currentRunPointer is reset, so we exit to prevent
        '     an error:
        If currentRunPointer Is Nothing Then Exit Sub
        frmVars.setVar currentRunPointer.zParam2, sTemp
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
      
    Case "OUTPUT"
        If frmScreen.WindowState = vbMinimized Then
            frmScreen.WindowState = vbNormal
        End If
        frmScreen.Show , Me
        If currentRunPointer.zParam2 = "" Then
            frmScreen.printLine currentRunPointer.zParam1
        ElseIf currentRunPointer.zParam1 = "" Then
            frmScreen.printLine frmVars.getVar(currentRunPointer.zParam2)
        Else
            frmScreen.printLine currentRunPointer.zParam1 & " " & frmVars.getVar(currentRunPointer.zParam2)
        End If
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).

    Case "DEFINITION"   ' also re-defintion.
        Dim p1 As String
        Dim p2 As String
        p1 = currentRunPointer.zParam1
        p2 = currentRunPointer.zParam2
        ' dots inside "" are ignored (assumed that it is a contant):
        If ((InStr(1, p1, ".") > 0) And (Mid(p1, 1, 1) <> """")) _
            Or ((InStr(1, p2, ".") > 0) And (Mid(p2, 1, 1) <> """")) Then
            If bWINDOW_LOADED Then
                If frmWindow.processObjectDefinition(p1, p2) Then
                    Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
                Else
                    ' in case of any error error is shown by the function.
                    ''Set currentRunPointer = Nothing
                    TerminateExecution  ' stop program!
                End If
            Else
                mBox "This operation requires" & vbNewLine & "window to be loaded!"
                ''Set currentRunPointer = Nothing
                TerminateExecution  ' stop program!
            End If
        Else
            frmVars.setVar p1, frmVars.ifVarGetValue(p2)
            Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
        End If
                
                
    Case "IF_EQUAL"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        If Val(OP1) = Val(OP2) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("YES"))
        Else
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("NO"))
        End If
        
    Case "IF_LESS"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        If Val(OP1) < Val(OP2) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("YES"))
        Else
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("NO"))
        End If
        
    Case "IF_GREATER"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        If Val(OP1) > Val(OP2) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("YES"))
        Else
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("NO"))
        End If
        
    Case "IF_GREATER_EQUAL"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        If Val(OP1) >= Val(OP2) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("YES"))
        Else
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("NO"))
        End If
        
    Case "IF_LESS_EQUAL"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        If Val(OP1) <= Val(OP2) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("YES"))
        Else
            Set currentRunPointer = getNextBlock(currentRunPointer, cLang("NO"))
        End If
        
        
    
    Case "ADD"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        frmVars.setVar currentRunPointer.zParam3, (Val(OP1) + Val(OP2))
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
         
    Case "SUBTRACT"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        frmVars.setVar currentRunPointer.zParam3, (Val(OP1) - Val(OP2))
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
        
    Case "MULTIPLY"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        frmVars.setVar currentRunPointer.zParam3, (Val(OP1) * Val(OP2))
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
                  
    Case "DIVIDE"
        OP1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        OP2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        frmVars.setVar currentRunPointer.zParam3, (Val(OP1) / Val(OP2))
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
                  
                  
                  
    Case "JOIN"
        s1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        s2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        s1 = removeQuotes(s1)  ' quotes around are ignored
        s2 = removeQuotes(s2) '
        frmVars.setVar currentRunPointer.zParam3, (s1 & s2)
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
         
    Case "COMP"
        s1 = frmVars.ifVarGetValue(currentRunPointer.zParam1)
        s2 = frmVars.ifVarGetValue(currentRunPointer.zParam2)
        s1 = removeQuotes(s1)  ' quotes around are ignored
        s2 = removeQuotes(s2) '
        frmVars.setVar currentRunPointer.zParam3, StrComp(s1, s2, vbTextCompare)
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
         
                  
    Case "SQL"
        ' #020105:
        Data1.DatabaseName = currentPATH & currentRunPointer.zParam1
        Data1.Refresh
        dbModule.runSQL currentRunPointer.zParam2
        Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
        
    Case "INTERSECTION"
      Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
    
    Case "FUNCTION"
        Dim sCommand As String
        Dim sParameters As String
        Dim sResultKeeper As String
        sCommand = currentRunPointer.zParam1
        sParameters = currentRunPointer.zParam2
        sResultKeeper = currentRunPointer.zParam3
        If executeInternalFunction(sCommand, sParameters, sResultKeeper) Then
            Set currentRunPointer = getNextBlock(currentRunPointer, "") ' any (should be one).
        Else
            frmStack.PUSH (frmVars.ifVarGetValue("PARAM")) ' [*] save param of previous function.
            ' PUSHING: 1. parameter(s), 2. where to store return, 3. CS, 4. IP
            frmStack.PUSH frmVars.ifVarGetValue(sParameters)   ' parameter(s).
            frmStack.PUSH sResultKeeper ' where to store result in.
            frmStack.PUSH ExtractFileName(currentFileName)  ' CS - return to that program.
            
            ' in case of "STACK OVERFLOW" (PUSH fails)
            '   currentRunPointer is set to nothing, and flow
            '     is terminated, so no need to proceed here:
            If currentRunPointer Is Nothing Then
                Exit Sub
            End If
            
            Dim blockToReturnTo As cBlock
            Set blockToReturnTo = getNextBlock(currentRunPointer, "")  ' any (should be one).
            If Not (blockToReturnTo Is Nothing) Then
                shp_Selector.Visible = False ' hide selector.
                frmStack.PUSH blockToReturnTo.TagID    ' IP - next command to return to (alpha...).
                ' #020105:
                If load_FILE(currentPATH & sCommand & ".fpp") Then   ' load another program (function).
                    Set currentRunPointer = findBlock("START")
                    setSelector currentRunPointer
                Else
                    setSelector currentRunPointer   ' just to show where we stoped.