frmmain2.frm

vb开发的连接mysql的工作流设置程序,图形化工作流自定义工具,原先是连接到Domino上的工作流自定义工具,现修改至mysql上,后台管理员设置工作流,前台读取数据库调用.

        With lbl.Item(CInt(ia.Id))
            Select Case Index
            Case 0, 1
                .Move sglx, .Top
                ia.MoveTo sglx, .Top
            Case 2, 3
                .Move .Left, sglx
                ia.MoveTo .Left, sglx
            Case Else
            End Select
        End With
    Next ia
    mIsChange = True
End Sub

Private Sub mnuAll_Click()
    Dim ic As IDraw
    Dim clsSelect As CSelect
    Set clsSelect = New CSelect
    mSelectCol.Clear
    For Each ic In mNodeCol
        clsSelect.Add ic, ic.Id
    Next ic
    Set mSelectCol = clsSelect
    mSelectCol_SelectChange
End Sub

Private Sub mnuClose_Click()
    Dim v
    If mIsChange Then
        v = MsgBox("流程已被修改，是否保存？", _
                vbYesNo + vbQuestion, "保存流程")
        If v = vbYes Then mnuSave_Click
    End If
    Dim i As Integer
    For i = 1 To lbl.UBound
        Unload lbl(i)
    Next i
    Set mNodeCol = New Collection
    Set mLineCol = New Collection
    mSelectCol.Clear
    Set mLine = Nothing
    Set mActiveLine = Nothing
    Set mGlobal = New CGlobal
    mAction = 0
    mIndex = 0
    mBegin = 0 '关闭开始节点的引用
    Me.Caption = "无标题"
    Me.status.Panels(2).Text = "无标题"
    mIsOpen = False
    mIsChange = False
End Sub

Private Sub mnuConnect_Click()
On Error GoTo ErrHandler
    If MNotes.EditEnvironment(True) Then
        MNotes.ShowWorkFlows Me.trv.Nodes
    End If
ErrHandler:
End Sub

Private Sub mnuDel_Click()
    lbl_KeyUp 1, 46, 0
    If Not (mActiveLine Is Nothing) Then
        mActiveLine.Delete
        Set mActiveLine = Nothing
        pic_Paint
    End If
End Sub

Private Sub mnuI_Click() '反选
    Dim clsSelect As CSelect, ic As IDraw
    Set clsSelect = New CSelect
    For Each ic In mNodeCol
        clsSelect.Add ic, ic.Id
    Next ic
    For Each ic In mSelectCol
        clsSelect.Remove ic.Id
    Next ic
    Set mSelectCol = clsSelect
    mSelectCol_SelectChange
End Sub

Private Sub mnuOpen_Click()
    OpenWF ""
    'Set m_clsAction = Nothing
End Sub

Private Sub mnuProp_Click()
    Dim ic As IDraw
    If mAction <> 0 Then
        Set ic = mNodeCol.Item(CStr(mAction))
        ic.ShowProperties
        lbl(mAction).Caption = ic.Caption
        lbl(mAction).ToolTipText = ic.Caption
    Else
        frmMainProperties.Display mGlobal
        For Each ic In mNodeCol
            If ic.ModeName = 2 Then
                ic.AutoAgents = mGlobal.AutoAgents()
            End If
            '
            ic.Properties.Notification = (mGlobal.Notification)
            ic.Properties.NotAllowChangeUser = (mGlobal.AllowChange)
            ic.Properties.NotAllowAgent = (mGlobal.AllowAgent)
        Next ic
        Me.Caption = mGlobal.GName
        Me.status.Panels(2).Text = mGlobal.GName
    End If
    mIsChange = True
End Sub

Private Sub mnuRoute_Click()
    Dim ic As IDraw
    If mAction > 0 Then
        Set ic = mNodeCol.Item(CStr(mAction))
        If ic.ModeName <> 4 Then
            If ic.ModeName = 3 And ic.NextNodes.Count <> 0 Then
            Else
                mIndex = mAction
                Set mLine = New CLine
                mLine.Create Me.pic
                mLine.AddR ic, 1
                mLine.AddR mMouse, 2
            End If
        End If
    End If
End Sub

Private Sub mnuSave_Click()
    Dim S As String
    S = TestErrors
    If S <> "" Then
        MsgBox S
        Exit Sub
    End If
    Dim col As Collection
    Set col = New Collection
    Dim obj As Object
    For Each obj In mNodeCol
        col.Add obj
    Next obj
    For Each obj In mLineCol
        col.Add obj
    Next obj
    Set obj = mNodeCol.Item(CStr(mBegin))
    MNotes.CreateWorkFlow mGlobal, obj, col
    mIsChange = False
    On Error GoTo ErrHandler
    Dim n As Node
    Set n = Me.trv.Nodes.Item(mGlobal.GName)
    Exit Sub
ErrHandler:
    If n Is Nothing Then
        MNotes.ShowWorkFlows Me.trv.Nodes
        Me.trv.Sorted = True
    End If
End Sub

Private Sub mnuTest_Click()
    Dim S As String
    S = TestErrors()
    If S <> "" Then
        MsgBox S, , "错误检测"
    Else
        MsgBox "没有检测到错误", , "错误检测"
    End If
End Sub

Private Sub mSelectCol_SelectChange()
    Dim ic As IDraw
    For Each ic In mNodeCol
        If mSelectCol.isIn(ic.Id) Then
            lbl(CInt(ic.Id)).BackColor = lbl(0).BackColor
        Else
            lbl(CInt(ic.Id)).BackColor = &H8000000F
        End If
    Next ic
End Sub

Private Sub Picture1_Resize()
'    trv.Move 0, 0, Me.Picture1.ScaleWidth, Me.Picture1.ScaleHeight
    On Error GoTo ErrHandler
    Me.Tab.Move 40, Me.Picture1.ScaleHeight - 420, Me.Picture1.ScaleWidth - 80
    Me.trv.Move 40, 40, Me.Picture1.ScaleWidth - 80, Me.Picture1.ScaleHeight - 420
ErrHandler:
End Sub

Private Sub Picture2_Resize()
    Dim sgltemp As Single
    pic.Move pic.Left
    If Picture2.ScaleHeight > hs.Height And Picture2.ScaleWidth > vs.Width Then
        vs.Move Picture2.ScaleWidth - vs.Width, 0, _
            vs.Width, Picture2.ScaleHeight - hs.Height
        hs.Move 0, Picture2.ScaleHeight - hs.Height, _
            Picture2.ScaleWidth - vs.Width, hs.Height
        Frame1.Move hs.Width, vs.Height, _
            vs.Width, hs.Height
        mSWidth = pic.Width - 2 * Picture2.Width
        mSHeight = pic.Height - 2 * Picture2.Height
    End If

End Sub

Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim l As Single
    If Button = 1 Then
        Picture3.Left = Picture3.Left + X
        If Picture3.Left > 0 Then
            Picture1.Width = Picture3.Left
        End If
        l = Picture1.Width + Picture3.Width
        If Me.ScaleWidth > l Then
            Picture2.Width = Me.ScaleWidth - l
        End If
    End If
End Sub

Private Sub Tab_Click(PreviousTab As Integer)
    Select Case Me.Tab.Tab
    Case 1
        frmAclManager.Display
        Me.Tab.Tab = 0
    Case Else
    End Select
End Sub

Private Sub Timer1_Timer()
    status.Panels(4) = "" & Now
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim Addtype As Integer
    Select Case Button.Index
    
    Case 1
        Addtype = AddClear
    Case 2
        Addtype = AddBegin
    Case 3
        Addtype = AddNode
    Case 4
        Addtype = AddRoute
    Case 5
        Addtype = AddEnd
    End Select
    Add Addtype
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
    Case 1
        mnuClose_Click '先关闭已打开流程
        mnuProp_Click '编辑主属性
    Case 2
        If Not (trv.SelectedItem Is Nothing) Then
            OpenWF trv.SelectedItem.Text
        End If
    Case 3
        mnuSave_Click
    Case 5
        mnuHelpItem_Click 0
    Case 6
        Unload Me
    Case 8 '上对齐
        mnuAlignMethod_Click 2
    Case 9 '下对齐
        mnuAlignMethod_Click 3
    Case 10 '左对齐
        mnuAlignMethod_Click 0
    Case 11 '右对齐
        mnuAlignMethod_Click 1
    Case Else
    End Select
End Sub

Private Sub trv_DblClick()
    If trv.SelectedItem.Image = 3 Then
        OpenWF trv.SelectedItem.Text
    End If
End Sub

Private Sub trv_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        Me.PopupMenu mnutrvItem
    End If
End Sub

Private Sub vs_Change()
    pic.Move pic.Left, 0 - vs.value * mSHeight / 10000
End Sub

Private Sub trv_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim v
    If KeyCode = 46 Then
        v = MsgBox("您选择的流程将被删除，继续吗？", _
                vbYesNo + vbCritical, "确认操作")
        If v = vbYes Then
            If DelWorkflow(trv.SelectedItem.Text) Then
                trv.Nodes.Remove trv.SelectedItem.Index
            End If
            'MNotes.ShowWorkFlows trv.Nodes
        End If
    End If
End Sub

Private Sub vs_Scroll()
    vs_Change
End Sub

Private Sub OpenWF(WFName As String)
    mnuClose_Click '先关闭已打开流程
    Dim col As Collection, ic As IDraw
    Dim Count As Integer
    On Error GoTo ErrHandler
    If Not (MNotes.LoadWorkFlow(mGlobal, ic, col, WFName)) Then Exit Sub
    Dim ia As IDraw
    For Each ia In col
        If ia.ModeName = 1 Then
            ia.Create Me.pic
            mLineCol.Add ia
        Else
            Count = Me.lbl.UBound + 1
            Load lbl(Count)
            ia.Create lbl(Count)
            ia.Id = CStr(Count)
            lbl(Count).Move ia.Properties.NodeX, ia.Properties.NodeY
            ia.MoveTo ia.Properties.NodeX, ia.Properties.NodeY
            mNodeCol.Add ia, CStr(Count)
            lbl(Count).Caption = ia.Caption
            lbl(Count).ToolTipText = ia.Caption
            lbl(Count).Visible = True
            If ia.ModeName = 3 Then
                mBegin = Count
                'lbl(Count).Picture = frmImage.Image1(5)
            ElseIf ia.ModeName = 4 Then
                    'lbl(Count).Picture = frmImage.Image1(6)
                Else
                    'lbl(Count).Picture = frmImage.Image1(0)
                End If
        End If
    Next ia
    Me.Caption = mGlobal.GName
    Me.status.Panels(2).Text = mGlobal.GName
    pic_Paint
    'mIsChange = True
    mIsOpen = True
    Exit Sub
ErrHandler:
    MsgBox "无法打开此流程！"
    mIsChange = False
    mIsOpen = False
    'mnuClose_Click
End Sub