frmmain.frm

多种图表的绘制及其运用

        
    Case "OUTPUT"
       Load frmDlgOutput
       frmDlgOutput.txtText = cb.zParam1
       frmDlgOutput.cboxVarName.Text = cb.zParam2
       frmDlgOutput.Show 1, Me
       Unload frmDlgOutput
       
    Case "IF_EQUAL", "IF_LESS", "IF_GREATER", "IF_GREATER_EQUAL", "IF_LESS_EQUAL"
        Load frmDlgIf
        frmDlgIf.cboxOperand1.Text = cb.zParam1
        frmDlgIf.cboxOperand2.Text = cb.zParam2
        If cb.zAction = "IF_EQUAL" Then
             frmDlgIf.cboxOperation.ListIndex = 0
        ElseIf cb.zAction = "IF_LESS" Then
             frmDlgIf.cboxOperation.ListIndex = 1
        ElseIf cb.zAction = "IF_GREATER" Then
             frmDlgIf.cboxOperation.ListIndex = 2
        ElseIf cb.zAction = "IF_GREATER_EQUAL" Then
             frmDlgIf.cboxOperation.ListIndex = 3
        ElseIf cb.zAction = "IF_LESS_EQUAL" Then
             frmDlgIf.cboxOperation.ListIndex = 4
        End If
       frmDlgIf.Show 1, Me
       Unload frmDlgIf
        
    Case "FUNCTION"
        Load frmDlgFunction
        frmDlgFunction.cboxFunctionName.Text = cb.zParam1
        frmDlgFunction.cboxParam1.Text = cb.zParam2
        frmDlgFunction.cboxResult.Text = cb.zParam3
        frmDlgFunction.Show 1, Me
        Unload frmDlgFunction
        
    Case "WINDOW"
        Load frmDlgWindow
        frmDlgWindow.setWindowPARAMS cb.zParam1, cb.zParam3
        setControls frmDlgWindow, cb.zParam2, False
        frmDlgWindow.Show 1, Me
        Unload frmDlgWindow    ' important!!!!!!!!!!
        
    Case "INTERSECTION", "STOP"
        mBox cb.zAction & " can not be edited!"
        
    Case Else
        mBox "Edit not supported yet for function: " & cb.zAction & ". sorry"
    
    End Select
         
    ' update all lines, since the block size could be changed:
    theLineCollection.updateAllLines
         
    ' update the selector:
    setSelector cb
    ' make sure it repaints:
     cb.theObjectShape.Refresh
    
End Sub

Private Sub cmdNextStep_Click()
    chkPause.Value = vbUnchecked
End Sub

Private Sub cmdScreen_Click()
    ' 1.88
    If frmScreen.WindowState = vbMinimized Then
        frmScreen.WindowState = vbNormal
    End If
    frmScreen.Show , Me
End Sub

' 1.88
'''Private Sub cmdScreen_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'''    ' used instead of Click because Click event reacts on "enter" key
'''    '   (this is good for frmScreen.processKey KeyAscii).
'''    If frmScreen.WindowState = vbMinimized Then
'''        frmScreen.WindowState = vbNormal
'''    End If
'''    frmScreen.Show , Me
'''End Sub

Private Sub cmdStack_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    frmStack.Show , Me
End Sub

Private Sub cmdStop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' MouseDown is used instead of Click because it's better
    '   when there is always focus on frmScreen (when printing a lot).
    TerminateExecution
End Sub

''''''''''' TOOLBAR ''''''''''''
Private Sub fraToolBar1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' remove selection of any tool when
    '   clicked over the frame:
    sTOOLBAR_CLICK = ""
    Me.MousePointer = vbDefault
End Sub

Private Sub cmdStart_Click()
    If Not bGUI Then Exit Sub

    sTOOLBAR_CLICK = "START"
    
    Me.MouseIcon = imgOval.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdAction_Click()
    If Not bGUI Then Exit Sub
        
    sTOOLBAR_CLICK = "ACTION"
    
    Me.MouseIcon = imgRect.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdInput_Click()
    If Not bGUI Then Exit Sub

    sTOOLBAR_CLICK = "INPUT"
    
    Me.MouseIcon = imgParall.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdOutput_Click()
    If Not bGUI Then Exit Sub

    sTOOLBAR_CLICK = "OUTPUT"
    
    Me.MouseIcon = imgParall.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdJunction_Click()
    If Not bGUI Then Exit Sub

    sTOOLBAR_CLICK = "JUNCTION"
    
    Me.MouseIcon = imgDiamond.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdIntersection_Click()
    If Not bGUI Then Exit Sub
    
    sTOOLBAR_CLICK = "INTERSECTION"
    
    Me.MouseIcon = imgCircle.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdFunction_Click()
    If Not bGUI Then Exit Sub
    
    sTOOLBAR_CLICK = "FUNCTION"
    
    Me.MouseIcon = imgFunc.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdVars_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    frmVars.Show , Me
End Sub

Private Sub cmdWindow_Click()
    If Not bGUI Then Exit Sub
    
    sTOOLBAR_CLICK = "WINDOW"
    
    Me.MouseIcon = imgRect.Picture
    Me.MousePointer = vbCustom
End Sub

Private Sub cmdEnd_Click()
    If Not bGUI Then Exit Sub
    
    sTOOLBAR_CLICK = "END"
    
    Me.MouseIcon = imgOval.Picture
    Me.MousePointer = vbCustom
End Sub
''''''''''' end of TOOLBAR ''''''''''''




Private Sub Form_Load()

    ' #020105:
    bSHOW_MESSAGE_WHEN_ALREADY_CONNECTED = True

' 1.88
''''#020104:
'''    cmdRun.Picture = picRun_internal.Picture
'''    Dim c As Long
'''    c = picRun_internal.Point(12, 2)
'''    If c > 0 Then
'''        cmdRun.MaskColor = c
'''        cmdRun.UseMaskColor = True
'''        ' "stop" uses the same back color as "run":
'''        cmdStop.MaskColor = c
'''        cmdStop.UseMaskColor = True
'''        ' "pause" uses the same back color as "run":
'''        chkPause.MaskColor = c
'''        chkPause.UseMaskColor = True
'''        ' "step" uses the same back color as "run":
'''        cmdNextStep.MaskColor = c
'''        cmdNextStep.UseMaskColor = True
'''    End If
    
' 1.88
' I'm using Transparent GIF files!!!
''''' #020105:
''''    c = pic_menu_back_color.Point(12, 2)
''''    If c > 0 Then
''''        cmdStart.MaskColor = c
''''        cmdStart.UseMaskColor = True
''''
''''        cmdAction.MaskColor = c
''''        cmdAction.UseMaskColor = True
''''
''''        cmdInput.MaskColor = c
''''        cmdInput.UseMaskColor = True
''''
''''        cmdOutput.MaskColor = c
''''        cmdOutput.UseMaskColor = True
''''
''''        cmdJunction.MaskColor = c
''''        cmdJunction.UseMaskColor = True
''''
''''        cmdIntersection.MaskColor = c
''''        cmdIntersection.UseMaskColor = True
''''
''''        cmdFunction.MaskColor = c
''''        cmdFunction.UseMaskColor = True
''''
''''        cmdWindow.MaskColor = c
''''        cmdWindow.UseMaskColor = True
''''
''''        cmdEnd.MaskColor = c
''''        cmdEnd.UseMaskColor = True
''''
''''    End If



    b_frmScreenVisible = False
    b_frm_mBoxVisible = False

    bTERMINATE_ON_CLOSE = False

    MAX_SHAPE = 0
    DRAGGED_SHAPE = -1
    SELECTED_SHAPE = -1
    PREV_SELECTED_SHAPE = -1

    Set theBlockCollection = New Block_Collection
    Set theLineCollection = New Line_Collection
    
    MAX_LINE = 0
    
    bWINDOW_LOADED = False
    bWINDOW_ACTIVATED = False
    bWINDOW_IS_RESIZING = False
    
    bIS_MODIFIED = False
    
    bGUI = True ' by default load GUI.
    
    sTOOLBAR_CLICK = ""
      
End Sub


Private Sub lblURL_Click()
   Call ShellExecute(Me.hwnd, "open", "http://www.emu8086.com/vb/", "", App.Path, SW_SHOWDEFAULT)
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuChangeBackColor_Click()
    If SELECTED_SHAPE <> -1 Then
        CommonDialog1.ShowColor
        theBlockCollection(shp(SELECTED_SHAPE).Tag).BGColor = CommonDialog1.Color
        shp(SELECTED_SHAPE).Refresh
        bIS_MODIFIED = True
    End If
End Sub

Private Sub mnuChangeBorderColor_Click()
    If SELECTED_SHAPE <> -1 Then
        CommonDialog1.ShowColor
        'shp(SELECTED_SHAPE).BorderColor = CommonDialog1.Color
        theBlockCollection(SELECTED_SHAPE).BorderColor = CommonDialog1.Color
        
        shp(SELECTED_SHAPE).Refresh
        bIS_MODIFIED = True
    End If
End Sub

Private Sub mnuChangeSize_Click()
    If SELECTED_SHAPE <> -1 Then
        frmSize.Show , Me
    End If
End Sub

Private Sub mnuChangeTextColor_Click()
    If SELECTED_SHAPE <> -1 Then
        CommonDialog1.ShowColor
        theBlockCollection(shp(SELECTED_SHAPE).Tag).TextColor = CommonDialog1.Color
        shp(SELECTED_SHAPE).Refresh
        bIS_MODIFIED = True
    End If
End Sub

Private Sub mnuDeleteBlock_Click()

    theBlockCollection.removeShape SELECTED_SHAPE
    
End Sub

Private Sub mnuDeleteLine_Click()

    theLineCollection.deleteLine SELECTED_SHAPE, PREV_SELECTED_SHAPE
    
End Sub

Private Sub mnuAddCaptionToLine_Click()
    If (PREV_SELECTED_SHAPE <> -1) And (SELECTED_SHAPE <> -1) Then
        Dim s As String
        s = InputBox("Enter the caption")
        theLineCollection.AddCaptionToLine frmMain.shp(PREV_SELECTED_SHAPE).Tag, frmMain.shp(SELECTED_SHAPE).Tag, s
    Else
        mBox "Two objects should be selected!"
    End If
End Sub

Private Sub mnuExample_Click(Index As Integer)
    If Not Check_If_Saved Then Exit Sub
    
    Dim bR As Boolean
    Dim sFileName As String
    
    ' hide selector:
    shp_Selector.Visible = False
    
    Select Case Index
    
    Case 0
        sFileName = "factorial.fpp"
        
    Case 1
        sFileName = "factorial_regular.fpp"
        
    Case 2
        sFileName = "power.fpp"

    Case 3
        sFileName = "b.fpp"

    Case 4
        sFileName = "d.fpp"

    Case 5
        sFileName = "e.fpp"

    Case 6
        sFileName = "test00_hello.fpp"

    Case 7
        sFileName = "test04_comp.fpp"
        
    Case 8
        sFileName = "test05_if.fpp"
        
    Case 9
        sFileName = "test06_concat.fpp"
        
    Case 10
        sFileName = "test07_loop.fpp"
         
    Case 11
        sFileName = "test08_loop.fpp"
        
    Case 12
        sFileName = "test10_call.fpp"
        
    Case 13
        sFileName = "test11_scroll.fpp"
        
    Case 14
        sFileName = "test09_sql.fpp"
        
    End Select
    
    bR = load_FILE(AddSlash(App.Path) & "Examples\" & sFileName)
    
    If Not bR Then
            mBox "Error loading example: " & AddSlash(App.Path) & "Examples\" & sFileName
    End If
    
    ' reset the selection:
    PREV_SELECTED_SHAPE = -1
    SELECTED_SHAPE = -1
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub