frmmain.frm

多种图表的绘制及其运用

      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Index           =   0
      Left            =   1410
      TabIndex        =   1
      Top             =   3375
      Visible         =   0   'False
      Width           =   1125
   End
   Begin VB.Line arrDown 
      BorderColor     =   &H000000FF&
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   187
      X2              =   211
      Y1              =   287
      Y2              =   275
   End
   Begin VB.Line arrUp 
      BorderColor     =   &H0000FF00&
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   186
      X2              =   212
      Y1              =   265
      Y2              =   272
   End
   Begin VB.Shape aDot 
      BackColor       =   &H00FF00FF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H0000FF00&
      FillColor       =   &H00FFFF00&
      Height          =   60
      Index           =   0
      Left            =   3345
      Shape           =   3  'Circle
      Top             =   4050
      Visible         =   0   'False
      Width           =   60
   End
   Begin VB.Label lblID 
      Alignment       =   2  'Center
      Caption         =   "id#"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808080&
      Height          =   180
      Left            =   1200
      TabIndex        =   0
      Top             =   600
      Width           =   420
   End
   Begin VB.Line ln 
      BorderColor     =   &H00000000&
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   222
      X2              =   344
      Y1              =   76
      Y2              =   217
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Begin VB.Menu mnuNew 
         Caption         =   "New"
      End
      Begin VB.Menu mnu_DELIMETER_0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuLoad 
         Caption         =   "Load..."
      End
      Begin VB.Menu mnu_DELIMETER_1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExamplesMenu 
         Caption         =   "Examples"
         Begin VB.Menu mnuExample 
            Caption         =   "Factorial Calculation (Recursive)"
            Index           =   0
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Factorial Calculation (Loop)"
            Index           =   1
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Exponent Calculation (Recursive)"
            Index           =   2
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Simple Window and Print"
            Index           =   3
         End
         Begin VB.Menu mnuExample 
            Caption         =   "A basic Image-Map application for the Web"
            Index           =   4
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Window with picture and line drawing"
            Index           =   5
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Hello World"
            Index           =   6
         End
         Begin VB.Menu mnuExample 
            Caption         =   "String Compare"
            Index           =   7
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Conditional Execution"
            Index           =   8
         End
         Begin VB.Menu mnuExample 
            Caption         =   "String Concatenation"
            Index           =   9
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Simple Loop 1"
            Index           =   10
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Simple Loop 2"
            Index           =   11
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Function Call"
            Index           =   12
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Test of Screen Scrolling"
            Index           =   13
         End
         Begin VB.Menu mnuExample 
            Caption         =   "Basic SQL test"
            Index           =   14
            Visible         =   0   'False
         End
      End
      Begin VB.Menu mnu_DELIMETER_6 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMakeExecutable 
         Caption         =   "Make Executable..."
      End
      Begin VB.Menu mnu_DELIMETER_2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "Save"
      End
      Begin VB.Menu mnuSaveAs 
         Caption         =   "Save As..."
      End
      Begin VB.Menu mnu_DELIMETER_5 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuChangeShape 
      Caption         =   "Change Shape"
      Begin VB.Menu mnuChangeBackColor 
         Caption         =   "Change Back Color"
      End
      Begin VB.Menu mnuChangeTextColor 
         Caption         =   "Change Text Color"
      End
      Begin VB.Menu mnuChangeBorderColor 
         Caption         =   "Change Border Color"
      End
      Begin VB.Menu mnu_DELIMETER_3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuChangeSize 
         Caption         =   "Change Size"
      End
      Begin VB.Menu mnu_DELIMETER_4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAddCaptionToLine 
         Caption         =   "Add Caption To Line"
      End
   End
   Begin VB.Menu mnuDelete 
      Caption         =   "Delete"
      Begin VB.Menu mnuDeleteLine 
         Caption         =   "Delete Line"
      End
      Begin VB.Menu mnuDeleteBlock 
         Caption         =   "Delete Block"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "Help"
      Begin VB.Menu mnuHelpToStudent 
         Caption         =   "Help Topics"
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "About"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' =========================================================
'  === Project of Data-flow Visual Programming Language ===
' =========================================================
' Copyright Emu8086, Inc. Free Code !
'
'
' URL: http://www.emu8086.com/vb/



' [e-mail]
' =========================================================
'  The main running form.
' =========================================================

Option Explicit

Dim distX As Single
Dim distY As Single

Public WithEvents theBlockCollection As Block_Collection
Attribute theBlockCollection.VB_VarHelpID = -1
Public WithEvents theLineCollection As Line_Collection
Attribute theLineCollection.VB_VarHelpID = -1

' keeps the name of a block, after one of the
'  buttons on the toolbar is clicked:
Dim sTOOLBAR_CLICK As String

' #020105:
Dim bSHOW_MESSAGE_WHEN_ALREADY_CONNECTED As Boolean

Private Sub chk_LOAD_GUI_Click()
    If chk_LOAD_GUI.Value = vbChecked Then
        bGUI = True
    Else
        bGUI = False
    End If
End Sub

Private Sub chkPause_Click()
    If chkPause.Value = vbChecked Then
        timerRunner.Enabled = False
        cmdNextStep.Enabled = True
    Else
        timerRunner.Enabled = True
        cmdNextStep.Enabled = False
    End If
End Sub

Private Sub cmdConnect_Click()
    Dim cl As cLine
    Dim cbk As cBlock
    Dim sAct As String

    If (PREV_SELECTED_SHAPE <> -1) And (SELECTED_SHAPE <> -1) Then
    
        ' #020105:
        ' check if already connected:
        Dim c As cLine
        For Each c In theLineCollection
            If (c.sFrom = shp(PREV_SELECTED_SHAPE).Tag) And (c.sTo = shp(SELECTED_SHAPE).Tag) _
             Or (c.sTo = shp(PREV_SELECTED_SHAPE).Tag) And (c.sFrom = shp(SELECTED_SHAPE).Tag) Then
                If bSHOW_MESSAGE_WHEN_ALREADY_CONNECTED Then
                    mBox cLang("Already connected!")
                End If
                Exit Sub
            End If
        Next c
    
        
        ' connect line:
        Set cl = theLineCollection.AddLine(shp(PREV_SELECTED_SHAPE).Tag, shp(SELECTED_SHAPE).Tag, "")

        ' check if it's an "IF" operation, and thus add any possible
        '     caption:
        Set cbk = theBlockCollection(shp(PREV_SELECTED_SHAPE).Tag)
        sAct = cbk.zAction
        If Mid(sAct, 1, 3) = "IF_" Then     ' any "if" action.
            If has_YES_Connection(cbk) Then
                cl.sCaption = cLang("NO")
            Else
                cl.sCaption = cLang("YES")
            End If
            cl.updateLine   ' to make sure caption is centered correctly.
        End If
        
        bIS_MODIFIED = True
    Else
        mBox "Two objects should be selected!"
    End If
End Sub

' returns TRUE when block has a line that goes from it and has "YES"
'  caption:
Private Function has_YES_Connection(cbk As cBlock) As Boolean
    Dim cl As cLine
    
    For Each cl In theLineCollection
       If cl.sFrom = cbk.theObjectShape.Tag Then
            If UCase(cl.sCaption) = cLang("YES") Then
                has_YES_Connection = True
                Exit Function
            End If
       End If
    Next cl
    
    has_YES_Connection = False
End Function

' allows to edit program's blocks:
Private Sub cmdEdit_Click()
    If SELECTED_SHAPE = -1 Then
        mBox cLang("Block not selected!")
        Exit Sub
    End If

    Dim cb As cBlock
    Set cb = theBlockCollection(shp(SELECTED_SHAPE).Tag)
    
    Select Case cb.zAction
    
    Case "START"
        Load frmDlgGeneral
        frmDlgGeneral.txtLocalVars.Text = cb.zParam1
        frmDlgGeneral.Show 1, Me
        Unload frmDlgGeneral
    
    Case "DEFINITION"   ' also re-defintion.
        Load frmDlgAction
        frmDlgAction.TabStrip1.Tabs("DEFINITION").Selected = True
        frmDlgAction.cboxVarName.Text = cb.zParam1
        frmDlgAction.txtVarValue.Text = cb.zParam2
        frmDlgAction.Show 1, Me
        Unload frmDlgAction
    
    Case "ADD", "MULTIPLY", "SUBTRACT", "DIVIDE"
        Load frmDlgAction
        frmDlgAction.TabStrip1.Tabs("ARITHMETIC").Selected = True
        frmDlgAction.cboxOperand1.Text = cb.zParam1
        frmDlgAction.cboxOperand2.Text = cb.zParam2
        If cb.zAction = "ADD" Then
            frmDlgAction.cboxOperation.ListIndex = 0
        ElseIf cb.zAction = "SUBTRACT" Then
            frmDlgAction.cboxOperation.ListIndex = 1
        ElseIf cb.zAction = "MULTIPLY" Then
            frmDlgAction.cboxOperation.ListIndex = 2
        ElseIf cb.zAction = "DIVIDE" Then
            frmDlgAction.cboxOperation.ListIndex = 3
        End If
        frmDlgAction.cboxResult.Text = cb.zParam3
        frmDlgAction.Show 1, Me
        Unload frmDlgAction
        
        
    Case "JOIN", "COMP"
        Load frmDlgAction
        frmDlgAction.TabStrip1.Tabs("STRINGS").Selected = True
        frmDlgAction.cboxString1.Text = cb.zParam1
        frmDlgAction.cboxString2.Text = cb.zParam2
        If cb.zAction = "JOIN" Then
            frmDlgAction.cboxStringOperation.ListIndex = 0
        ElseIf cb.zAction = "COMP" Then
            frmDlgAction.cboxStringOperation.ListIndex = 1
        End If
        frmDlgAction.cboxStringResult.Text = cb.zParam3
        frmDlgAction.Show 1, Me
        Unload frmDlgAction
        
        
        
    Case "SQL"
        Load frmDlgAction
        frmDlgAction.TabStrip1.Tabs("SQL").Selected = True
        frmDlgAction.cboxDatabase.Text = cb.zParam1
        frmDlgAction.txtSQL.Text = cb.zParam2
        frmDlgAction.Show 1, Me
        Unload frmDlgAction
                
    Case "INPUT"
       Load frmDlgInput
       frmDlgInput.txtText = cb.zParam1
       frmDlgInput.cboxVarName.Text = cb.zParam2
       frmDlgInput.Show 1, Me
       Unload frmDlgInput