frmqxgl.frm

自来水公司的一个管理系统

         TabIndex        =   47
         Top             =   1380
         Width           =   1620
      End
      Begin VB.CheckBox Check1 
         Caption         =   "上门交费用户收费输入"
         Height          =   210
         Index           =   3
         Left            =   105
         TabIndex        =   15
         Top             =   1095
         Width           =   2190
      End
      Begin VB.CheckBox Check1 
         Caption         =   "计费"
         Height          =   210
         Index           =   2
         Left            =   105
         TabIndex        =   14
         Top             =   825
         Width           =   1620
      End
      Begin VB.CheckBox Check1 
         Caption         =   "抄表数据输入"
         Height          =   210
         Index           =   1
         Left            =   105
         TabIndex        =   13
         Top             =   555
         Width           =   1620
      End
      Begin VB.CheckBox Check1 
         Caption         =   "水费催缴通知单"
         Height          =   210
         Index           =   0
         Left            =   105
         TabIndex        =   12
         Top             =   285
         Width           =   1620
      End
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   600
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   10575
      Begin VB.CommandButton cmdArray 
         Caption         =   "放弃"
         Height          =   360
         Index           =   1
         Left            =   4695
         TabIndex        =   1
         Top             =   150
         Width           =   975
      End
      Begin VB.CommandButton cmdArray 
         Caption         =   "保存"
         Height          =   360
         Index           =   0
         Left            =   3735
         TabIndex        =   2
         Top             =   150
         Width           =   975
      End
      Begin MSDataListLib.DataCombo cboPost 
         Height          =   330
         Left            =   855
         TabIndex        =   4
         Top             =   165
         Width           =   1920
         _ExtentX        =   3387
         _ExtentY        =   582
         _Version        =   393216
         Style           =   2
         Text            =   ""
      End
      Begin VB.Label Label1 
         BackColor       =   &H00FFFFFF&
         Caption         =   "岗位："
         Height          =   195
         Left            =   195
         TabIndex        =   3
         Top             =   210
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmQXGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoPostRS As ADODB.Recordset
Dim blnEditFlag As Boolean   '编辑标志，对内容的任何改变，该变量都将设置为TRUE

Private Sub cboPost_Change()
    If cboPost.BoundText = "01" Then    '系统管理员
        Call DisableCheck
    Else
        Call EnableCheck
    End If
    Call ShowCheck
    blnEditFlag = False
    cmdArray(0).Enabled = False
    cmdArray(1).Enabled = False
End Sub

Private Sub Check1_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check2_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check3_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check4_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check5_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check6_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub Check7_Click(Index As Integer)
    blnEditFlag = True
    cmdArray(0).Enabled = True
    cmdArray(1).Enabled = True
End Sub

Private Sub cmdArray_Click(Index As Integer)
    Select Case Index
        Case 0  '保存
            If Not blnEditFlag Then Exit Sub
            Call SaveCheck
            blnEditFlag = False
            cmdArray(0).Enabled = False
            cmdArray(1).Enabled = False
        Case 1  '放弃
            If Not blnEditFlag Then Exit Sub
            Call ShowCheck
            blnEditFlag = False
            cmdArray(0).Enabled = False
            cmdArray(1).Enabled = False
    End Select
    
End Sub

Private Sub Form_Load()
    Set adoPostRS = New ADODB.Recordset
    Set adoPostRS.ActiveConnection = gConnect
    adoPostRS.CursorLocation = adUseClient
    adoPostRS.CursorType = adOpenForwardOnly
    adoPostRS.LockType = adLockOptimistic
    On Error GoTo OpenErr
    adoPostRS.Open "select PostID,PostName from Post"
    On Error GoTo 0
    
    Set Me.cboPost.RowSource = adoPostRS
    Me.cboPost.ListField = "PostName"
    Me.cboPost.BoundColumn = "PostID"
    
    Call ClearCheck
    Call DisableCheck
    blnEditFlag = False
    cmdArray(0).Enabled = False
    cmdArray(1).Enabled = False
    Exit Sub
    
    '-------错误处理---------
OpenErr:
    Warning "操作员岗位表打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub

Private Sub DisableCheck()
    Dim i As Byte
        
    For i = 0 To Check1.Count - 1
        Check1(i).Enabled = False
    Next i
    For i = 0 To Check2.Count - 1
        Check2(i).Enabled = False
    Next i
    For i = 0 To Check3.Count - 1
        Check3(i).Enabled = False
    Next i
    For i = 0 To Check4.Count - 1
        Check4(i).Enabled = False
    Next i
    For i = 0 To Check5.Count - 1
        Check5(i).Enabled = False
    Next i
    For i = 0 To Check6.Count - 1
        Check6(i).Enabled = False
    Next i
    For i = 0 To Check7.Count - 1
        Check7(i).Enabled = False
    Next i
    
End Sub

Private Sub EnableCheck()
    Dim i As Byte
        
    For i = 0 To Check1.Count - 1
        Check1(i).Enabled = True
    Next i
    For i = 0 To Check2.Count - 1
        Check2(i).Enabled = True
    Next i
    For i = 0 To Check3.Count - 1
        Check3(i).Enabled = True
    Next i
    For i = 0 To Check4.Count - 1
        Check4(i).Enabled = True
    Next i
    For i = 0 To Check5.Count - 1
        Check5(i).Enabled = True
    Next i
    For i = 0 To Check6.Count - 1
        Check6(i).Enabled = True
    Next i
    For i = 0 To Check7.Count - 1
        Check7(i).Enabled = True
    Next i
    
End Sub

Private Sub ShowCheck()
    Dim i As Byte
    Dim ch As Byte
    Dim strMask As String
    Dim adoRS As ADODB.Recordset
    
    Set adoRS = New ADODB.Recordset
    Set adoRS.ActiveConnection = gConnect
    adoRS.CursorLocation = adUseClient
    adoRS.CursorType = adOpenForwardOnly
    adoRS.LockType = adLockOptimistic
    On Error GoTo OpenErr
    adoRS.Open "select Mask from Purview where PostID='" & Me.cboPost.BoundText & "'"
    On Error GoTo 0
    
    If adoRS.EOF And adoRS.BOF Then
        Call ClearCheck
    Else
        Call ClearCheck
        strMask = Trim(adoRS.Fields(0))
        For i = 1 To Len(strMask)
            ch = Mid(strMask, i, 1)
            If i <= Me.Check1.Count Then
                Check1(i - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count Then
                Check2(i - Me.Check1.Count - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count Then
                Check3(i - Me.Check1.Count - Check2.Count - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count Then
                Check4(i - Me.Check1.Count - Check2.Count - Check3.Count - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count Then
                Check5(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count + Check6.Count Then
                Check6(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - Check5.Count - 1).value = Val(ch)
            ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count + Check6.Count + Check7.Count Then
                Check7(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - Check5.Count - Check6.Count - 1).value = Val(ch)
            End If
        Next i
    End If
    adoRS.Close
    Set adoRS = Nothing
    Exit Sub
    
    '-------错误处理---------
OpenErr:
    Warning "权限掩码查询错误！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub

Private Sub SaveCheck()
    Dim i As Byte
    Dim ch As Byte
    Dim strMask As String
    Dim adoRS As ADODB.Recordset
    
    Set adoRS = New ADODB.Recordset
    Set adoRS.ActiveConnection = gConnect
    adoRS.CursorLocation = adUseClient
    adoRS.CursorType = adOpenForwardOnly
    adoRS.LockType = adLockOptimistic
    
    '生成操作掩码
    strMask = ""
    For i = 1 To (Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count + Check6.Count + Check7.Count)
        If i <= Me.Check1.Count Then
            ch = Str(Check1(i - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count Then
            ch = Str(Check2(i - Me.Check1.Count - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count Then
            ch = Str(Check3(i - Me.Check1.Count - Check2.Count - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count Then
            ch = Str(Check4(i - Me.Check1.Count - Check2.Count - Check3.Count - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count Then
            ch = Str(Check5(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count + Check6.Count Then
            ch = Str(Check6(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - Check5.Count - 1).value)
        ElseIf i <= Me.Check1.Count + Check2.Count + Check3.Count + Check4.Count + Check5.Count + Check6.Count + Check7.Count Then
            ch = Str(Check7(i - Me.Check1.Count - Check2.Count - Check3.Count - Check4.Count - Check5.Count - Check6.Count - 1).value)
        End If
    strMask = strMask & Trim(ch)
    Next i
    
    On Error GoTo OpenErr
    adoRS.Open "select PostID,Mask from Purview where PostID='" & Me.cboPost.BoundText & "'"
    On Error GoTo 0
    
    If adoRS.EOF And adoRS.BOF Then
        adoRS.AddNew
        adoRS!PostID = Me.cboPost.BoundText
    End If
    adoRS!Mask = strMask
    adoRS.Update
    adoRS.Close
    Set adoRS = Nothing
    Exit Sub
    
    '-------错误处理---------
OpenErr:
    Warning "权限掩记录集打开错误！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub

Private Sub ClearCheck()
    Dim i As Byte
    
    For i = 0 To Check1.Count - 1
        Check1(i).value = 0
    Next i
    For i = 0 To Check2.Count - 1
        Check2(i).value = 0
    Next i
    For i = 0 To Check3.Count - 1
        Check3(i).value = 0
    Next i
    For i = 0 To Check4.Count - 1
        Check4(i).value = 0
    Next i
    For i = 0 To Check5.Count - 1
        Check5(i).value = 0
    Next i
    For i = 0 To Check6.Count - 1
        Check6(i).value = 0
    Next i
    For i = 0 To Check7.Count - 1
        Check7(i).value = 0
    Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoPostRS.Close
    Set adoPostRS = Nothing
    On Error GoTo 0
End Sub