frmmainproperties.frm

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

            SubFormatType   =   1
         EndProperty
         Height          =   285
         Left            =   2130
         TabIndex        =   31
         Top             =   0
         Width           =   2205
      End
      Begin VB.CheckBox chkTimeLimit 
         Caption         =   "启动过期通知"
         Height          =   345
         Left            =   270
         TabIndex        =   30
         Top             =   570
         Width           =   2745
      End
      Begin VB.Frame Frame4 
         Height          =   1215
         Left            =   0
         TabIndex        =   23
         Top             =   960
         Width           =   5865
         Begin VB.TextBox txtRepeat 
            BeginProperty DataFormat 
               Type            =   1
               Format          =   "0"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   1
            EndProperty
            Height          =   285
            Left            =   1560
            TabIndex        =   25
            Top             =   570
            Width           =   405
         End
         Begin VB.TextBox txtTimeLimit 
            BeginProperty DataFormat 
               Type            =   1
               Format          =   "0"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   1
            EndProperty
            Height          =   285
            Left            =   1560
            TabIndex        =   24
            Top             =   210
            Width           =   405
         End
         Begin VB.Label Label8 
            AutoSize        =   -1  'True
            Caption         =   "通知间隔时间："
            Height          =   180
            Left            =   60
            TabIndex        =   29
            Top             =   600
            Width           =   1260
         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            Caption         =   "启动时间："
            Height          =   180
            Left            =   60
            TabIndex        =   28
            Top             =   270
            Width           =   900
         End
         Begin VB.Label Label9 
            AutoSize        =   -1  'True
            Caption         =   "天"
            Height          =   180
            Left            =   2280
            TabIndex        =   27
            Top             =   690
            Width           =   180
         End
         Begin VB.Label Label7 
            AutoSize        =   -1  'True
            Caption         =   "天"
            Height          =   180
            Left            =   2250
            TabIndex        =   26
            Top             =   240
            Width           =   180
         End
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "流程时间控制："
         Height          =   180
         Left            =   180
         TabIndex        =   33
         Top             =   30
         Width           =   1260
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "天"
         Height          =   180
         Left            =   4500
         TabIndex        =   32
         Top             =   60
         Width           =   180
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "名称："
      Height          =   180
      Left            =   270
      TabIndex        =   1
      Top             =   150
      Width           =   540
   End
End
Attribute VB_Name = "frmMainProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mObj As CGlobal
Private mIsChange As Boolean
Private mIsFirst As Boolean
Private mUsers() As String
Public Sub Display(obj As Object)
    On Error GoTo ErrHandler
    Set mObj = obj
    txtName.Text = mObj.GName   '流程名称
    txtComment.Text = mObj.Comment '流程说明
    '流程数据库设置
    'Me.cmbDBName.Text = mObj.DBName
    Me.cmbDBName.Text = mObj.ApplicationDB
    Me.OptForm(mObj.FormType).value = True
    '人员设置
    Dim i As Integer
'    mUsers = MNotes.People
'    For i = LBound(mUsers) To UBound(mUsers)
'        If mUsers(i) <> "" Then
'            Me.cmbAdmin.AddItem mUsers(i) & "[个人]"
'        End If
'    Next i
    Me.cmbAdmin.Text = mObj.Administrator
    mUsers = mObj.users
    For i = LBound(mUsers) To UBound(mUsers)
        If mUsers(i) <> "" Then
            LstUser.AddItem mUsers(i)
        End If
    Next i
    mUsers = mObj.readers
    For i = LBound(mUsers) To UBound(mUsers)
        If mUsers(i) <> "" Then
            lstReaders.AddItem mUsers(i)
        End If
    Next i
    '归档属性设置
    Me.cmbArchiveActivation.ListIndex = mObj.ArchiveActivation
    Me.cmbArchiveALC.ListIndex = mObj.ArchiveACL
    Me.cmbArchiveManage.ListIndex = mObj.ArchiveManage
    Me.txtArchiveDB.Text = mObj.ArchiveDB
    'Me.txtArchiveDBName = mObj.ArchiveDBName
    Me.txtArchiveDate = mObj.ArchiveTime
    mUsers = mObj.ArchiveAdministrators
    For i = LBound(mUsers) To UBound(mUsers)
        If mUsers(i) <> "" Then
            Me.lstManage.AddItem mUsers(i)
        End If
    Next i
    
    '高级属性设置
    If mObj.AllowReCall Then
        Me.chk(0).value = 1
    End If
    If mObj.AllowChange Then
        Me.chk(1).value = 1
    End If
    If mObj.AllowAgent Then
        Me.chk(2).value = 1
    End If
    Dim S As String, d As String
    MMain.SeprateDateTime mObj.Duration, S, d
    Me.txtTimeCtrl.Text = S ' mObj.Duration
    If mObj.Notification Then
        Me.chk(3).value = 1
        Me.chkTimeLimit.value = 1
        Me.Frame4.Visible = True
    Else
        Me.chk(3).value = 0
        Me.chkTimeLimit.value = 0
        Me.Frame4.Visible = False
    End If
    MMain.SeprateDateTime mObj.TimeLimit, S, d
    Me.txtTimeLimit.Text = S 'mObj.TimeLimit
    MMain.SeprateDateTime mObj.RepeatTime, S, d
    Me.txtRepeat.Text = S 'mObj.RepeatTime
    'Me.cmbForm.Text = mObj.FormName
    Me.cmbArchiveActivation.ListIndex = mObj.ArchiveActivation
    Me.tabProp.Tab = 0
    If mObj.FormName <> "" Then
        cmbForm.AddItem mObj.FormName
        FormName = mObj.FormName
    End If
    Me.Icon = frmMain.Icon
    mIsChange = True
    Me.Show vbModal
    Exit Sub
ErrHandler:
    MsgBox Err.Number & ":" & Err.Description
    Me.Show vbModal
End Sub

Private Sub chkTimeLimit_Click()
    If Me.chkTimeLimit.value = 1 Then
        Frame4.Visible = True
    Else
        Me.Frame4.Visible = False
    End If
End Sub

Private Sub cmbAdmin_GotFocus()
    Dim i As Integer
    If cmbAdmin.ListCount <> 0 Then Exit Sub
    mUsers = MNotes.People
    For i = LBound(mUsers) To UBound(mUsers)
        If mUsers(i) <> "" Then
            Me.cmbAdmin.AddItem mUsers(i) & "[个人]"
        End If
    Next i

End Sub

Private Sub cmbDBName_Change()
    mIsChange = True
End Sub

Private Sub cmbDBName_GotFocus()
    Databases
End Sub

Private Sub cmbForm_GotFocus()
    On Error GoTo ErrHandler
    Dim strText As String
    strText = Me.cmbForm.Text
    If mIsChange Then
        Me.cmbForm.Clear
    Else
        Exit Sub
    End If
    Dim v As Variant
    v = MNotes.getForms(cmbDBName.Text)
    Dim i As Long
    For i = LBound(v) To UBound(v)
        If v(i) <> "" Then
            Me.cmbForm.AddItem v(i)
        End If
    Next i
    Me.cmbForm.Text = strText
ErrHandler:
End Sub

Private Sub cmdAdd_Click()
    Dim strName() As String
    ReDim strName(0 To Me.LstUser.ListCount)
    Dim i As Long
    For i = 1 To Me.LstUser.ListCount
        strName(i) = Me.LstUser.List(i - 1)
    Next i
    strName = frmSetPeople.Display(strName)
    Me.LstUser.Clear
    For i = 1 To UBound(strName)
        If strName(i) <> "" Then
            Me.LstUser.AddItem strName(i)
        End If
    Next i
End Sub

Private Sub cmdAddManage_Click()
    Dim strName() As String
    ReDim strName(0 To Me.lstManage.ListCount)
    Dim i As Long
    For i = 1 To Me.lstManage.ListCount
        strName(i) = Me.lstManage.List(i - 1)
    Next i
    strName = frmSetPeople.Display(strName)
    Me.lstManage.Clear
    For i = 1 To UBound(strName)
        If strName(i) <> "" Then
            Me.lstManage.AddItem strName(i)
        End If
    Next i
End Sub

Private Sub cmdAddReader_Click()
    Dim strName() As String
    ReDim strName(0 To Me.lstReaders.ListCount)
    Dim i As Long
    For i = 1 To Me.lstReaders.ListCount
        strName(i) = Me.lstReaders.List(i - 1)
    Next i
    strName = frmSetPeople.Display(strName)
    Me.lstReaders.Clear
    For i = 1 To UBound(strName)
        If strName(i) <> "" Then
            Me.lstReaders.AddItem strName(i)
        End If
    Next i
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdDel_Click()
    Dim i As Integer
    With Me.LstUser
        i = 0
        Do While i < .ListCount
            If .Selected(i) Then
                .RemoveItem (i)
            Else
                i = i + 1
            End If
        Loop
    End With
End Sub

Private Sub cmdDelManage_Click()
    Dim i As Integer
    With Me.lstManage
        i = 0
        Do While i < .ListCount
            If .Selected(i) Then
                .RemoveItem (i)
            Else
                i = i + 1
            End If
        Loop
    End With
End Sub

Private Sub cmdDelReader_Click()
    Dim i As Integer
    With Me.lstReaders
        i = 0
        Do While i < .ListCount
            If .Selected(i) Then
                .RemoveItem (i)
            Else
                i = i + 1
            End If
        Loop
    End With
End Sub

Private Sub cmdOK_Click()
    Dim k As Long, j As Long
    mObj.GName = txtName.Text   '流程名称
    'mObj.Agent =
    
    mObj.Comment = txtComment.Text '流程说明
    '数据库设置
    'mObj.DBName = cmbDBName.Text
    mObj.DBName = cmbDBName.Text
    mObj.FormName = FormName
    Dim i As Integer
    For i = 0 To 2
        If Me.OptForm(i) Then
            mObj.FormType = i
        End If
    Next i
    '人员设置
    mObj.Administrator = Me.cmbAdmin.Text
    ReDim mUsers(0 To LstUser.ListCount)
    For i = 1 To LstUser.ListCount
        mUsers(i) = LstUser.List(i - 1)
    Next i
    mObj.users = mUsers
    ReDim mUsers(0 To Me.lstReaders.ListCount)
    For i = 1 To Me.lstReaders.ListCount
        mUsers(i) = Me.lstReaders.List(i - 1)
    Next i
    mObj.readers = mUsers
    '归档设置
    mObj.ArchiveActivation = Me.cmbArchiveActivation.ListIndex
    mObj.ArchiveACL = Me.cmbArchiveALC.ListIndex
    mObj.ArchiveManage = Me.cmbArchiveManage.ListIndex
    mObj.ArchiveDB = Me.txtArchiveDB.Text
    mObj.ArchiveTime = Me.txtArchiveDate.Text
    ReDim mUsers(0 To Me.lstManage.ListCount)
    For i = 1 To Me.lstManage.ListCount
        mUsers(i) = Me.lstManage.List(i - 1)
    Next i
    mObj.ArchiveAdministrators = mUsers
    '权限设置
    mObj.AllowReCall = (Me.chk(0).value = 1)
    mObj.AllowChange = (Me.chk(1).value = 1)
    mObj.AllowAgent = (Me.chk(2).value = 1)
    '时间控制
    If txtRepeat.Text <> "" Then
        mObj.RepeatTime = Me.txtRepeat.Text & "[日]"
    Else
        mObj.RepeatTime = ""
    End If
    If txtTimeCtrl.Text <> "" Then
        mObj.Duration = Me.txtTimeCtrl.Text & "[日]"
    Else
        mObj.Duration = ""
    End If
    If txtTimeLimit.Text <> "" Then
        mObj.TimeLimit = Me.txtTimeLimit & "[日]"
    Else
        mObj.TimeLimit = ""
    End If
    mObj.Notification = (Me.chk(3).value = 1)
    mObj.ArchiveActivation = Me.cmbArchiveActivation.ListIndex
    Unload Me
End Sub

Private Sub OptForm_Click(Index As Integer)
    cmbForm.Visible = OptForm(2).value
End Sub

Private Sub txtArchiveDB_GotFocus()
    Databases
End Sub

Private Sub Databases()
    If cmbDBName.ListCount <> 0 Then Exit Sub
    Dim i As Long
    Dim v As Variant
    v = MNotes.getDBNames
    For i = 0 To UBound(v)
        If v(i) <> "" Then
            Me.cmbDBName.AddItem v(i)
            Me.txtArchiveDB.AddItem v(i)
        End If
    Next i
End Sub

Private Property Let FormName(value As String)
    Dim i As Long
    For i = 0 To cmbForm.ListCount - 1
        If value = cmbForm.List(i) Then
            cmbForm.ListIndex = i
            Exit Property
        End If
    Next i
    cmbForm.ListIndex = -1
End Property

Private Property Get FormName() As String
    FormName = cmbForm.List(cmbForm.ListIndex)
End Property