frmmain2.frm

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

ErrHandler:
    MsgBox "无法打开帮助文件！"
End Sub

Private Sub mnuNew_Click()
    mnuClose_Click '先关闭已打开流程
    mnuProp_Click '编辑属性
End Sub

Private Sub mnutrv_Click(Index As Integer)
    Select Case Index
    Case 0
        OpenWF trv.SelectedItem.Text
    Case 1
        trv_KeyUp 46, 0
    End Select
End Sub



Private Sub pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        mIndex = 0
        'Toolbar1.Index = 1
        Toolbar1.Buttons(1).value = tbrPressed
    End If
    Dim ic As IDraw, Count As Integer
    Set mActiveLine = Nothing
    For Each ic In mLineCol
        If ic.InMe(X, Y) And (Not ic.IsDelete) Then
            Set mActiveLine = ic
            Exit For
        End If
    Next ic
    Select Case mIndex
    Case AddNode
        Set ic = New CMidle
        Count = Me.lbl.UBound + 1
        Load lbl(Count)
        With Me.lbl(Count)
            ic.Create lbl(Count)
            .Move X - .Width / 2, Y - .Height / 2
            ic.MoveTo X - .Width / 2, Y - .Height / 2
            ic.Id = CStr(Count)
            .Caption = ic.Caption
            .ToolTipText = ic.Caption
            .Visible = True
            ic.AutoAgents = mGlobal.AutoAgents
            ic.Properties.Notification = mGlobal.Notification
            ic.Properties.NotAllowChangeUser = mGlobal.AllowChange
            ic.Properties.NotAllowAgent = mGlobal.AllowAgent
            mNodeCol.Add ic, CStr(Count)
            '.Picture = frmImage.Image1(0) '普通
        End With
    Case AddBegin
        If mBegin = 0 Then
            Set ic = New CBegin
            Count = Me.lbl.UBound + 1
            Load lbl(Count)
            With Me.lbl(Count)
                ic.Create lbl(Count)
                .Move X - .Width / 2, Y - .Height / 2
                ic.MoveTo X - .Width / 2, Y - .Height / 2
                ic.Id = CStr(Count)
                .Caption = ic.Caption
                .Visible = True
                mNodeCol.Add ic, CStr(Count)
                mBegin = Count
                '.Picture = frmImage.Image1(5) '开始
            End With
        Else
            If lbl(mBegin).Visible = True Then
                MsgBox "只能有一个开始端!"
            Else
                lbl(mBegin).Visible = True
                Set ic = mNodeCol.Item(CStr(mBegin))
                ic.UnDel
                ic.MoveTo X - ic.Width / 2, Y - ic.Height / 2
            End If
        End If
    Case AddEnd
        If mEnd = 0 Then
            Set ic = New CEnd
            Count = Me.lbl.UBound + 1
            Load lbl(Count)
            With Me.lbl(Count)
            ic.Create lbl(Count)
            .Move X - .Width / 2, Y - .Height / 2
            ic.MoveTo X - .Width / 2, Y - .Height / 2
            ic.Id = CStr(Count)
            .Caption = ic.Caption
            .Visible = True
            mNodeCol.Add ic, CStr(Count)
            mEnd = Count
            '.Picture = frmImage.Image1(6) '结束
            End With
        Else
            If lbl(mEnd).Visible = True Then
                MsgBox "只能有一个结束端!"
            Else
                Set ic = mNodeCol.Item(CStr(mEnd))
                ic.UnDel
                ic.MoveTo X - ic.Width / 2, Y - ic.Height / 2
            End If
            
        End If
       
    End Select
    mSelectX = X
    mSelectY = Y
    If Shift <> 1 Then
        mSelectCol.Clear
    End If
    mAction = 0
End Sub

Private Sub pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mIndex > 0 Then
        pic_Paint
    End If
    If Button = 1 Then
        pic_Paint
        Me.pic.DrawStyle = 2
        Me.pic.Line (mSelectX, mSelectY)-(X, Y), , B
        Me.pic.DrawStyle = 0
    End If
    mMouse.MoveTo X, Y
    status.Panels(3).Text = Right$("00000" & IIf(X < 0, 0, X), 6) & " X " & Right$("00000" & IIf(Y < 0, 0, Y), 6)
End Sub

Private Sub pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ic As IDraw
    pic_Paint
    Dim x1 As Single, x2 As Single, y1 As Single, y2 As Single
    Dim l As Single, t As Single
    If mSelectX > X Then
        x1 = X
        x2 = mSelectX
    Else
        x1 = mSelectX
        x2 = X
    End If
    If mSelectY > Y Then
        y1 = Y
        y2 = mSelectY
    Else
        y1 = mSelectY
        y2 = Y
    End If
    If Shift <> 1 Then mSelectCol.Clear
    For Each ic In mNodeCol
        l = ic.Left
        t = ic.Top
        If l >= x1 And l <= x2 And t >= y1 And t <= y2 Then
            mSelectCol.Add ic, ic.Id
        End If
        l = l + ic.Width
        If l >= x1 And l <= x2 And t >= y1 And t <= y2 Then
            mSelectCol.Add ic, ic.Id
        End If
        t = t + ic.Height
        If l >= x1 And l <= x2 And t >= y1 And t <= y2 Then
            mSelectCol.Add ic, ic.Id
        End If
        l = ic.Left
        If l >= x1 And l <= x2 And t >= y1 And t <= y2 Then
            mSelectCol.Add ic, ic.Id
        End If
    Next ic
    If Button = 2 Then
        Set mLine = Nothing
        Me.PopupMenu mnuPop
    End If
End Sub

Private Sub pic_Paint()
    Me.pic.cls
    Dim ic As IDraw
    For Each ic In mLineCol
        If Not (ic.IsDelete Or ic.isHide) Then
            ic.Paint
        End If
    Next ic
    If Not (mLine Is Nothing) Then
        If Not (mLine.IsDelete Or mLine.isHide) Then
            mLine.Paint
        End If
    End If
    Dim i As Long
    For i = 1 To mNodeCol.Count
        Set ic = mNodeCol.Item(i)
        If Not (ic Is Nothing) Then
            If ic.NextNodes.Count > 1 Then
                'lbl(i).Picture = frmImage.Image1(2)
            End If
        End If
    Next i
    For Each ic In mNodeCol
        If ic.NextNodes.Count > 1 Then
            
        End If
    Next ic
End Sub

Private Sub lbl_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    Dim ic As IDraw
    If KeyCode = 46 Then
        For Each ic In mSelectCol
            lbl(CInt(ic.Id)).Visible = False
            If mBegin = CInt(ic.Id) Then mBegin = 0
            mNodeCol.Remove CStr(ic.Id)
            ic.Delete
        Next ic
        mSelectCol.Clear
        mIsChange = True
    End If
End Sub

Private Sub lbl_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    mAction = Index
    Set mActiveLine = Nothing
    Dim il As IDraw, ic As IDraw
    Set ic = mNodeCol.Item(CStr(Index))
    If Button = 2 Then mIndex = 0
    If mIndex = -1 Then
        If ic.ModeName <> 4 Then    '结束:4
            If ic.ModeName = 3 And ic.NextNodes.Count <> 0 Then
            Else
                mIndex = Index
                Set mLine = New CLine
                mLine.Create Me.pic
                mLine.AddR ic, 1
                mLine.AddR mMouse, 2
            End If
        End If
   End If
    If mIndex > 0 Then
        If mIndex <> Index Then
            If ic.ModeName <> 3 Then
                mLine.AddR ic, 2
                mLineCol.Add mLine
                Set mLine = Nothing
                pic_Paint
                mIndex = -1
            End If
        End If
    End If
    If Shift <> 1 Then
        If Not mSelectCol.isIn(CStr(Index)) Then
            mSelectCol.Clear
        End If
    End If
    If Shift = 1 And mSelectCol.isIn(CStr(Index)) Then
        mSelectCol.Remove (CStr(Index))
    Else
        mSelectCol.Add mNodeCol.Item(CStr(Index)), CStr(Index)
        dX = X: dY = Y
    End If
End Sub

Public Sub Add(Addtype As Integer)
    mIsChange = True
    mIndex = Addtype
End Sub

Private Sub lbl_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ic As IDraw
    With Me.lbl(Index)
        If Button = 1 And mSelectCol.isIn(CStr(Index)) Then
            MoveTo X, Y
            mIsChange = True
        End If
    End With
End Sub

Private Sub lbl_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        mIndex = 0
        Set mLine = Nothing
        Me.PopupMenu mnuPop
    End If
End Sub

Private Sub MoveTo(X As Single, Y As Single)
    Dim ic As IDraw
    For Each ic In mSelectCol
        With lbl.Item(CStr(ic.Id))
            If .Left + X - dX < 0 Then Exit Sub
            If .Top + Y - dY < 0 Then Exit Sub
            If .Left + X - dX > Me.pic.ScaleWidth - Me.hs.Width Then Exit Sub
            If .Top + Y - dY > Me.pic.ScaleHeight - Me.vs.Height Then Exit Sub
        End With
    Next ic
    For Each ic In mSelectCol
        With lbl.Item(CStr(ic.Id))
            'If .Left + X - dX > 0 And .Top + Y - dY Then
            .Move .Left + X - dX, .Top + Y - dY
            ic.MoveTo .Left + X - dX, .Top + Y - dY
            'End If
        End With
    Next ic
End Sub

Private Function TestErrors() As String
    Dim S As String
    Dim HasEnd As Boolean
    TestErrors = ""
    MErrors.Clear
    S = "没有开始节点！"
    If lbl(mBegin).Visible = False Then
        MErrors.Add Me, "工作流", S
    End If
    mGlobal.TestErrors
    Dim ic As IDraw
    For Each ic In mNodeCol
        ic.TestRun
        If (Not (HasEnd)) And (ic.ModeName = 4) Then
            HasEnd = True
        End If
    Next ic
    If Not HasEnd Then
        MErrors.Add Me, "工作流", "没有结束节点！"
    End If
    Dim i As Long, j As Long
    Dim itmp As IDraw
    For i = 1 To mNodeCol.Count - 1
        Set ic = mNodeCol.Item(i)
        For j = i + 1 To mNodeCol.Count
            Set itmp = mNodeCol.Item(j)
            If ic.Properties.NodeName = itmp.Properties.NodeName Then
                MErrors.Add Me, "工作流", "存在重名的节点！"
            End If
        Next j
    Next i
    If MErrors.Count <> 0 Then
        TestErrors = MErrors.ErrorString
    End If
End Function

Private Sub mnuAlignMethod_Click(Index As Integer)
    Dim sglx As Single
    Dim ia As IDraw
    sglx = 0
    If Index = 0 Or Index = 2 Then sglx = 1000000
    For Each ia In mSelectCol
        Select Case Index
        Case 0
            If ia.Left < sglx Then sglx = ia.Left
        Case 1
            If ia.Left > sglx Then sglx = ia.Left
        Case 2
            If ia.Top < sglx Then sglx = ia.Top
        Case 3
            If ia.Top > sglx Then sglx = ia.Top
        End Select
    Next ia
    Dim l As Single
    For Each ia In mSelectCol