frmsetpeople.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSetPeople 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4680
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7125
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4680
   ScaleWidth      =   7125
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ImageList imglst 
      Left            =   5760
      Top             =   3600
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   13
      ImageHeight     =   11
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSetPeople.frx":0000
            Key             =   "person"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSetPeople.frx":00A0
            Key             =   "group"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView trv 
      Height          =   3060
      Left            =   120
      TabIndex        =   6
      Top             =   360
      Width           =   2445
      _ExtentX        =   4313
      _ExtentY        =   5398
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   530
      LineStyle       =   1
      Style           =   7
      Checkboxes      =   -1  'True
      HotTracking     =   -1  'True
      ImageList       =   "imglst"
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   435
      Index           =   4
      Left            =   3990
      TabIndex        =   5
      Top             =   4080
      Width           =   1305
   End
   Begin VB.CommandButton cmd 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   435
      Index           =   3
      Left            =   1800
      TabIndex        =   4
      Top             =   4080
      Width           =   1305
   End
   Begin VB.CommandButton cmd 
      Caption         =   "清空"
      Height          =   435
      Index           =   2
      Left            =   2910
      TabIndex        =   3
      Top             =   2640
      Width           =   1305
   End
   Begin VB.CommandButton cmd 
      Caption         =   "删除"
      Height          =   435
      Index           =   1
      Left            =   2910
      TabIndex        =   2
      Top             =   1710
      Width           =   1305
   End
   Begin VB.ListBox lst 
      Height          =   2940
      ItemData        =   "frmSetPeople.frx":0150
      Left            =   4560
      List            =   "frmSetPeople.frx":0152
      MultiSelect     =   2  'Extended
      TabIndex        =   1
      Top             =   360
      Width           =   2445
   End
   Begin VB.CommandButton cmd 
      Caption         =   "添加"
      Height          =   435
      Index           =   0
      Left            =   2910
      TabIndex        =   0
      Top             =   900
      Width           =   1305
   End
End
Attribute VB_Name = "frmSetPeople"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mIsNotFirst As Boolean
Private mSelects() As String
Private mDept As CDepartment
Public Function Display(Selects() As String, _
            Optional b As Boolean = False) As String()
    mSelects = Selects
    Dim i As Long
'    按个人
'    按群组
'    按部门
'    按角色
'    按关系
'    按权限
'    Me.cmb.AddItem "按个人", 0
'    Me.cmb.AddItem "按群组", 1
'    If Not b Then
'        Me.cmb.AddItem "按部门", 2
'        Me.cmb.AddItem "按角色", 3
'        Me.cmb.AddItem "按关系", 4
'        Me.cmb.AddItem "按权限", 5
'    End If
    Me.lst.Clear
    For i = 1 To trv.Nodes.Count
        trv.Nodes.Item(i).Checked = False
    Next i
    If Not mIsNotFirst Then
        createTree b
        mIsNotFirst = True
    End If
    For i = 1 To UBound(mSelects)
        If mSelects(i) <> "" Then
            Me.lst.AddItem mSelects(i)
        End If
    Next i
    Dim a() As String
    Me.Icon = frmMain.Icon
    'Me.cmb.ListIndex = 0
    Me.Show vbModal
    Display = mSelects
End Function

'Private Sub cmb_Change()
'    Dim a() As String
'    ReDim a(0)
'    Select Case cmb.ListIndex
'    Case 0
'        a = MNotes.People
'    Case 1 '群组
'        a = MNotes.getGroups
'    Case 2 '部门
'        a = MNotes.getDepartments
'    Case 4
'        ReDim a(0 To 5)
'        a(1) = "流程启动者"
'        a(2) = "前一办理人"
'        a(3) = "上级办理者"
'        a(4) = "所有参与者"
'        a(5) = "下级办理者"
'    Case Else
'    End Select
'    Dim i As Long
'    Me.lst(0).Clear
'    For i = LBound(a) To UBound(a)
'        If a(i) <> "" Then
'            Me.lst(0).AddItem a(i)
'        End If
'    Next i
'End Sub

'Private Sub cmb_Click()
'    cmb_Change
'End Sub

Private Sub cmd_Click(Index As Integer)
    Dim i As Long
    Dim ns As Nodes
    Set ns = trv.Nodes
    Dim n As Node
    Select Case Index
    Case 0 '添加
        Set n = ns.Item(1)
        Do While Not (n Is Nothing)
            AddPeople n
            Set n = n.Next
        Loop
    Case 1 '删除
        With Me.lst
            i = 0
            Do While i < .ListCount
                If .Selected(i) Then
                    .RemoveItem (i)
                Else
                    i = i + 1
                End If
            Loop
        End With
    Case 2 '清空
        Me.lst.Clear
    Case 3 '确定
        ReDim mSelects(0 To lst.ListCount)
        For i = 1 To lst.ListCount
            mSelects(i) = lst.List(i - 1)
        Next i
        Me.Hide
    Case 4 '取消
        Me.Hide
    End Select
End Sub

Private Sub AddSelect(AName As String)
    Dim i As Integer
    For i = 0 To Me.lst.ListCount - 1
        If AName = Me.lst.List(i) Then Exit Sub
    Next i
    Me.lst.AddItem AName
End Sub

Private Sub createTree(b As Boolean)
    Dim a() As String, v
    Dim i As Long
    Dim ns As Nodes
    Set ns = trv.Nodes
    Dim n As Node
    Set n = ns.Add(, , , "个人")
    ns.Add n, tvwChild, , "__"
'    a = MNotes.People
'    For i = LBound(a) To UBound(a)
'        If a(i) <> "" Then
'            ns.Add n, tvwChild, , a(i)
'        End If
'    Next i
'    ShowGroups
    If b Then Exit Sub
   'xx Set n = ns.Add(, , , "部门")
   'xx ns.Add n, tvwChild, , "__"
   'xx Set n = ns.Add(, , , "群组")
   'xx ns.Add n, tvwChild, , "__"
    'xx Set n = ns.Add(, , , "角色")
    'xx ns.Add n, tvwChild, , "__"
'    Set n = ns.Add(, , , "关系")
'    ns.Add n, tvwChild, , "流程启动者"
'    ns.Add n, tvwChild, , "前一办理人"
'    ns.Add n, tvwChild, , "上级办理者"
'    ns.Add n, tvwChild, , "所有参与者"
'    ns.Add n, tvwChild, , "下级办理者"
End Sub

Private Sub AddPeople(n As Node)
    Dim tmp As Node, i As Integer
    If n.Children <> 0 Then
        Set tmp = n.Child
        Do While Not (tmp Is Nothing)
            AddPeople tmp
            Set tmp = tmp.Next
        Loop
    Else
        If n.Checked = True Then
            If Right$(n.Text, 4) <> "[群组]" Then
                AddSelect n.Text '& "[" & Right$(cmb.Text, 2) & "]"
            End If
        End If
    End If
End Sub

Private Sub ShowDepartments(ANode As Node)
    Dim ns As Nodes
    Dim n As Node
    Dim subn As Node
    Set ns = trv.Nodes
    Dim clsDept As CDepartment, v, i As Long, j As Long
    Dim col As Collection
    Set mDept = MNotes.getDepartment
    Set col = mDept.SubDepartments
    Dim dept As CDepartment
    For Each dept In col
        Set n = ns.Add(ANode, tvwChild, , dept.DepartmentName & "[部门]", "group")
        ShowSubDept n, dept
    Next
    
End Sub
Private Sub ShowSubDept(n As Node, dept As CDepartment)
'    Dim ns As Nodes
'    Dim subn As Node
'    Dim clsDept As CDepartment
'    Dim i As Long, v
'    Set ns = trv.Nodes
'    For Each clsDept In dept.SubDepartments
'        Set subn = ns.Add(n, tvwChild, , clsDept.DepartmentName & "[部门]", "group")
'        ShowSubDept subn, clsDept
'    Next clsDept
'    v = dept.People
'    For i = LBound(v) To UBound(v)
'        If v(i) <> "" Then
'            ns.Add n, tvwChild, , MNotes.getNotesName(v(i)) & "[个人]", "person"
'        End If
'    Next i

End Sub
Private Sub ShowGroups()
    Dim ns As Nodes
    Dim n As Node
    Dim subn As Node
    Set ns = trv.Nodes
    Dim a() As String, v, i As Long, j As Long
    Set n = ns.Add(, , , "群组")
    a = MNotes.getGroups
    For i = LBound(a) To UBound(a)
        If a(i) <> "" Then
            Set subn = ns.Add(n, tvwChild, , a(i))
            v = MNotes.getGroupPeople(a(i))
            For j = LBound(v) To UBound(v)
                If v(j) <> "" Then
                    If Right$(v(j), 4) <> "[群组]" Then
                        ns.Add subn, tvwChild, , v(j) & "[个人]"
                    Else
                        ns.Add subn, tvwChild, , v(j)
                    End If
                End If
            Next j
        End If
    Next i

End Sub

Private Sub Form_Unload(Cancel As Integer)
    mIsNotFirst = False
End Sub

'将信息的读取延迟到节点展开时
Private Sub trv_Expand(ByVal Node As MSComctlLib.Node)
    Dim n As Node, ns As Nodes
    Dim i As Long, a() As String
    Dim cnt As Long
    Dim v
    Set ns = trv.Nodes
    Set n = Node.Child
    Select Case Node.Text
    Case "个人"
        If n.Text = "__" Then
            ns.Remove n.Index
            a = MNotes.People
            For i = LBound(a) To UBound(a)
                If a(i) <> "" Then
                    ns.Add Node, tvwChild, , a(i) & "[个人]", "person"
                End If
            Next i
        End If
    Case "群组"
        If n.Text = "__" Then
            ns.Remove n.Index
            a = MNotes.getGroups
            For i = LBound(a) To UBound(a)
                If a(i) <> "" Then
                    Set n = ns.Add(Node, tvwChild, , a(i), "group")
                    ns.Add n, tvwChild, , "__"
                End If
            Next i
        End If
    Case "部门"
        If n.Text = "__" Then
            ns.Remove n.Index
            ShowDepartments Node
        End If
    Case "角色"
        If n.Text = "__" Then
            ns.Remove n.Index
            a = MNotes.getRoles
            For i = LBound(a) To UBound(a)
                If a(i) <> "" Then
                    Set n = ns.Add(Node, tvwChild, , a(i) & "[角色]", "person")
                End If
            Next i
        End If
    
    Case Else
        If n.Text = "__" Then
            ns.Remove n.Index
            Set n = Node
            cnt = 1
            Do Until n.Parent Is Nothing
                Set n = n.Parent
                cnt = cnt + 1
            Loop
            If n.Text = "群组" Then
                v = MNotes.getGroupPeople(Node.Text)
            End If
            If IsEmpty(v) Then Exit Sub
            For i = LBound(v) To UBound(v)
                If v(i) <> "" Then
                    If cnt > 20 Then Exit Sub
                    Set n = ns.Add(Node, tvwChild, , v(i))
                    If (Right$(v(i), 4) = "[群组]") And cnt <= 20 Then
                        n.Image = "group"
                        ns.Add n, tvwChild, , "__"
                    Else
                        n.Image = "person"
                    End If
                End If
            Next i
        End If
    End Select
End Sub

Private Sub trv_NodeCheck(ByVal Node As MSComctlLib.Node)
    If Node.Children = 0 Then Exit Sub
    trv_Expand Node
    Dim n As Node
    Set n = Node.Child
    Do Until n Is Nothing
        n.Checked = Node.Checked
        If n.Children <> 0 Then trv_NodeCheck n
        Set n = n.Next
    Loop
End Sub