frmuserturnon.frm

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

    Set Me.cboUType.RowSource = adoUTypeRS
    Me.cboUType.ListField = "UTypeName"
    Me.cboUType.BoundColumn = "UTypeID"
    
    Set Me.cboChargetType.RowSource = adoChargetTypeRS
    Me.cboChargetType.ListField = "ChargeTypeName"
    Me.cboChargetType.BoundColumn = "ChargeTypeID"
    
    Set Me.cboMwm.RowSource = adoMwmRS
    Me.cboMwm.ListField = "MWmName"
    Me.cboMwm.BoundColumn = "MWmID"
    
    '初始化界面
    Call InitInterFace
    Call DisplayCurrentData
    Call DisableInterFace
    Call InitCommandBox
    blnEditFlag = False '编辑标志
    Exit Sub

    '-------错误处理---------
errHandleOpen:
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0

End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoPRS.Close
    adoQRS.Close
    adoUTypeRS.Close
    adoChargetTypeRS.Close
    adoBankRS.Close
    adoBankSubOrganRS.Close
    adoMwmRS.Close
    adoUserRecordRS.Close
    
    Set adoPRS = Nothing
    Set adoQRS = Nothing
    Set adoUTypeRS = Nothing
    Set adoChargetTypeRS = Nothing
    Set adoBankRS = Nothing
    Set adoBankSubOrganRS = Nothing
    Set adoMwmRS = Nothing
    Set adoUserRecordRS = Nothing
    On Error GoTo 0
End Sub

'---------------------------------------------------------
'自定义过程/函数
'---------------------------------------------------------
Private Sub InitInterFace()
    cboP.Text = ""
    Call ClearQ
    txtUID.Text = ""
    txtUName.Text = ""
    txtAddr.Text = ""
    txtLinkMan.Text = ""
    txtLinkPhone.Text = ""
    txtLinkAddr.Text = ""
    cboUType.Text = ""
    cboChargetType.Text = ""
    Call ClearBank
    Call ClearBankSubOrgan
    txtBankUserName.Text = ""
    txtAccount.Text = ""
    cboMwm.Text = ""
    txtWmID.Text = ""
    txtWmCaliber.Text = ""
    txtWmMakeAddr.Text = ""
    txtWMStartReadNumber.Text = 0
    txtAddCharge.Text = 0
    txtAuditCharge.Text = 0
    txtLeaderIdea.Text = ""
    txtNote.Text = ""
End Sub

Private Sub InitCommandBox()
    Call EnableCMD1
    Call DisableCMD2
    Call EnableCMD3
    
    '对于“施工信息”按纽的状态，因为只在“保存”、“放弃”两个按扭过程中才可能变化，因此，只要根据“用户名称”是否为空
    '来进行设置，为空，（根据DisplayCurrentData过程）说明当前数据表为空，否则说明有记录且当前记录已经显示在表单中，此时
    '“施工信息”按纽才可打开
    If Me.txtUName.Text = "" Then
        Call DisableCMD4
    Else
        Call EnableCMD4
    End If
End Sub

Private Sub EnableInterFace()
    '必须打开的控件
    cboP.Enabled = True
    cboQ.Enabled = True
    txtUID.Enabled = False
    txtUName.Enabled = True
    txtAddr.Enabled = True
    txtLinkMan.Enabled = True
    txtLinkPhone.Enabled = True
    txtLinkAddr.Enabled = True
    cboUType.Enabled = True
    cboChargetType.Enabled = True
    cboMwm.Enabled = True
    txtWmID.Enabled = True
    txtWmCaliber.Enabled = True
    txtWmMakeAddr.Enabled = True
    txtWMStartReadNumber.Enabled = True
    txtAddCharge.Enabled = True
    txtAuditCharge.Enabled = True
    txtLeaderIdea.Enabled = True
    txtNote.Enabled = True
    
    '条件打开的控件
    If bytCommandFlag = 0 Then          '新增状态
        cboBank.Enabled = False
        cboBankSubOrgan.Enabled = False
        txtBankUserName.Enabled = False
        txtAccount.Enabled = False
    ElseIf bytCommandFlag = 1 Then      '编辑状态
        If adoUserRecordRS.Fields("ChargetTypeID") = "1" Then   '公家银行交费用户
            cboBank.Enabled = True
            cboBankSubOrgan.Enabled = True
            txtBankUserName.Enabled = True
            txtAccount.Enabled = True
        Else
            cboBank.Enabled = False
            cboBankSubOrgan.Enabled = False
            txtBankUserName.Enabled = False
            txtAccount.Enabled = False
        End If
    End If
End Sub

Private Sub DisableInterFace()
    cboP.Enabled = False
    cboQ.Enabled = False
    txtUID.Enabled = False
    txtUName.Enabled = False
    txtAddr.Enabled = False
    txtLinkMan.Enabled = False
    txtLinkPhone.Enabled = False
    txtLinkAddr.Enabled = False
    cboUType.Enabled = False
    cboChargetType.Enabled = False
    cboBank.Enabled = False
    cboBankSubOrgan.Enabled = False
    txtBankUserName.Enabled = False
    txtAccount.Enabled = False
    cboMwm.Enabled = False
    txtWmID.Enabled = False
    txtWmCaliber.Enabled = False
    txtWmMakeAddr.Enabled = False
    txtWMStartReadNumber.Enabled = False
    txtAddCharge.Enabled = False
    txtAuditCharge.Enabled = False
    txtLeaderIdea.Enabled = False
    txtNote.Enabled = False
End Sub

Private Sub EnableCMD1()
   Dim i As Integer
   For i = 0 To cmdCommandArray1.Count - 1
        cmdCommandArray1(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD1()
   Dim i As Integer
   For i = 0 To cmdCommandArray1.Count - 1
        cmdCommandArray1(i).Enabled = False
   Next i
End Sub

Private Sub EnableCMD2()
   Dim i As Integer
   For i = 0 To cmdCommandArray2.Count - 1
        cmdCommandArray2(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD2()
   Dim i As Integer
   For i = 0 To cmdCommandArray2.Count - 1
        cmdCommandArray2(i).Enabled = False
   Next i
End Sub

Private Sub EnableCMD3()
   Dim i As Integer
   For i = 0 To cmdCommandArray3.Count - 1
        cmdCommandArray3(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD3()
   Dim i As Integer
   For i = 0 To cmdCommandArray3.Count - 1
        cmdCommandArray3(i).Enabled = False
   Next i
End Sub

Private Sub EnableCMD4()
    cmdEngineering.Enabled = True
End Sub
Private Sub DisableCMD4()
    cmdEngineering.Enabled = False
End Sub

Private Sub DisplayCurrentData()
    '将表中的当前数据记录显示在屏幕上
    '要考虑数据表为空的情况
    If adoUserRecordRS.EOF Or adoUserRecordRS.BOF Then
        Call InitInterFace
    Else
        With adoUserRecordRS
        Me.cboP.BoundText = !PID
        Call FillQ(Trim(Me.cboP.BoundText))
        Me.cboQ.BoundText = !QID
        Me.txtUID.Text = !UID
        Me.txtUName.Text = Trim(!UName)
        Me.txtAddr.Text = Trim(!Addr)
        Me.txtLinkMan.Text = Trim(!LinkMan)
        Me.txtLinkPhone.Text = Trim(!LinkPhone)
        Me.txtLinkAddr.Text = Trim(!LinkAddr)
        Me.cboUType.BoundText = !UTypeID
        Me.cboChargetType.BoundText = !ChargetTypeID
        If Me.cboChargetType.BoundText = "1" Then '公家银行交费用户
            Call FillBank
            Me.cboBank.BoundText = !BankID
            Call FillBankSubOrgan(Me.cboBank.BoundText)
            Me.cboBankSubOrgan.BoundText = !SubOrganID
        Else
            Call ClearBank
            Call ClearBankSubOrgan
        End If
        Me.txtBankUserName.Text = Trim(!BankUserName)
        Me.txtAccount.Text = Trim(!Account)
        Me.cboMwm.BoundText = !MWmID
        Me.txtWmID.Text = !WmID
        Me.txtAddCharge.Text = !AddCharge
        Me.txtAuditCharge.Text = !AuditCharge
        Me.txtLeaderIdea.Text = Trim(!LeaderIdea)
        Me.txtNote.Text = Trim(!Note)
'        !CreateTime
'        !OgID = gstrCurOperatorID
'        !OgName = gstrCurOperatorName
'        !Status = "1"
        End With
                    
        '填写用户水表信息
        Dim adoWmRS As ADODB.Recordset
            
        On Error GoTo errHandleOpen
        Set adoWmRS = New ADODB.Recordset
        Set adoWmRS.ActiveConnection = gConnect
        adoWmRS.CursorLocation = adUseClient
        adoWmRS.CursorType = adOpenForwardOnly
        adoWmRS.LockType = adLockOptimistic
        adoWmRS.Open "select *  from WaterMeter where UID='" & Trim(Me.txtUID.Text) & "'"
        On Error GoTo 0
        If adoWmRS.RecordCount < 1 Then
            Warning "用户水表信息读错!!!"
            Me.txtWmID.Text = ""
            Me.txtWmCaliber.Text = 0
            Me.txtWmMakeAddr.Text = ""
            Me.txtWMStartReadNumber.Text = 0
        Else
            Me.txtWmID.Text = adoWmRS!WmID
            Me.txtWmCaliber.Text = adoWmRS!WmCaliber
            Me.txtWmMakeAddr.Text = adoWmRS!WmMakeAddr
            Me.txtWMStartReadNumber.Text = adoWmRS!WmStartReadNumber
        End If
        On Error Resume Next
        adoWmRS.Close
        Set adoWmRS = Nothing
        On Error GoTo 0
        Exit Sub
        
errHandleOpen:
    Me.txtWmID.Text = ""
    Me.txtWmCaliber.Text = 0
    Me.txtWmMakeAddr.Text = ""
    Me.txtWMStartReadNumber.Text = 0
    Warning "用户水表信息表打开出错!!!" & Chr(13) & Err.Description
    On Error GoTo 0
    End If
End Sub

Private Function SaveCurrentData() As Boolean
    Dim strUID As String
    Dim btyWmRecordSaveFlag As Byte '调用保存用户水表记录函数的返回值
    
    '保存数据
    If bytCommandFlag = 0 Then  '新增---保存
        '对于新增-保存来说，先得到可用的用户顺序号
        strUID = GetMaxUID()
        If strUID = "" Then
            SaveCurrentData = False
            Warning "得到可用的用户编号出错,无法保存!!!"
            Exit Function
        End If
        
        On Error GoTo errHandleSave
        gConnect.BeginTrans
        '先保存用户水表信息
        btyWmRecordSaveFlag = SaveWmRecord(Trim(Me.txtWmID.Text), Me.cboP.BoundText, Me.cboQ.BoundText, strUID, Me.txtWmCaliber.Text, Trim(Me.txtWmMakeAddr.Text), Me.txtWMStartReadNumber.Text, bytCommandFlag)
        Select Case btyWmRecordSaveFlag
        Case 0      '保存成功
        
        Case 1      '水表编号有重复数值
            gConnect.RollbackTrans
            SaveCurrentData = False
            Warning "所输入的用户水表编号有重复值,请仔细核对水表编号!!!"
            On Error GoTo 0
            Exit Function
        
        Case 2      '保存出错
            gConnect.RollbackTrans
            SaveCurrentData = False
            Warning "用户水表记录保存出错!!!"
            On Error GoTo 0
            Exit Function
        
        End Select
        adoUserRecordRS.AddNew  '增加一条新记录
        adoUserRecordRS!UID = strUID
        adoUserRecordRS!CreateTime = Date
        adoUserRecordRS!Status = "1"
    Else                        '编辑---保存
        '对于编辑-保存来说，直接从档案记录集中得到用户编号
        strUID = adoUserRecordRS!UID

        On Error GoTo errHandleSave
        gConnect.BeginTrans
        '先保存用户水表信息
        btyWmRecordSaveFlag = SaveWmRecord(Trim(Me.txtWmID.Text), Me.cboP.BoundText, Me.cboQ.BoundText, strUID, Me.txtWmCaliber.Text, Trim(Me.txtWmMakeAddr.Text), Me.txtWMStartReadNumber.Text, bytCommandFlag)
        Select Case btyWmRecordSaveFlag
        Case 0      '保存成功
        
        Case 1      '水表编号有重复数值
            '对于编辑-保存来说,该状态无意义
            
        Case 2      '保存出错
            gConnect.RollbackTrans
            SaveCurrentData = False
            Warning "用户水表记录保存出错!!!"
            On Error GoTo 0
            Exit Function
        
        End Select
    End If
    
    With adoUserRecordRS
        !PID = Me.cboP.BoundText
        !QID = Me.cboQ.BoundText
        !UName = Trim(Me.txtUName.Text)
        !Addr = Trim(Me.txtAddr.Text)
        !LinkMan = Trim(Me.txtLinkMan.Text)
        !LinkPhone = Trim(Me.txtLinkPhone.Text)
        !LinkAddr = Trim(Me.txtLinkAddr.Text)
        !UTypeID = Me.cboUType.BoundText
        !ChargetTypeID = Me.cboChargetType.BoundText
        !BankID = Me.cboBank.BoundText
        !SubOrganID = Me.cboBankSubOrgan.BoundText
        !BankUserName = Trim(Me.txtBankUserName.Text)
        !Account = Trim(Me.txtAccount.Text)
        !MWmID = Me.cboMwm.BoundText
        !WmID = Trim(Me.txtWmID.Text)
        !AddCharge = Me.txtAddCharge.Text
        !AuditCharge = Me.txtAuditCharge.Text
        !LeaderIdea = Trim(Me.txtLeaderIdea.Text)
        !Note = Trim(Me.txtNote.Text)
        !OgID = gstrCurOperatorID
        !OgName = gstrCurOperatorName
        .Update
    End With
    gConnect.CommitTrans
    On Error GoTo 0
    If bytCommandFlag = 0 Then  '新增
        On Error Resume Next
        adoUserRecordRS.MoveLast
        On Error GoTo 0
    End If
    SaveCurrentData = True
    Exit Function
    
errHandleSave:
    gConnect.RollbackTrans
    SaveCurrentData = False
    Warning "保存数据时出错!!!" & Chr(13) & Err.Description
    On Error GoTo 0
End Function

Private Function SaveWmRecord(ByVal strWmID As String, ByVal strPID As String, ByVal strQID As String, ByVal strUID As String, ByVal strWmCaliber As String, ByVal strWmMakeAddr As String, ByVal strWmStartReadNumber As String, ByVal bytFlag As Byte) As Byte
   '-------------------------
   '功能：  根据提供的参数,新增/保存用户水表信息表
   '参数：  strWmID                 水表编号
   '        strPID                  片区
   '        strQID                  小区
   '        strUID                  用户编号
   '        strWmCaliber            水表口径
   '        strWmMakeAddr           水表产地
   '        strWmStartReadNumber    水表初始读数
   '        bytFlag                 保存类型标志:0 新增--保存,1 编辑--保存(其值等于模块变量bytCommandFlag)
   '返回值: 0                       保存成功
   '        1                       水表编号有重复值
   '        2                       保存出错
   '用法:
   '建立:   2001/5/11  by pc
   '修改:
   '修改内容:
   '-------------------------
    Dim adoWmRS As ADODB.Recordset
    
    Set adoWmRS = New ADODB.Recordset
    Set adoWmRS.ActiveConnection = gConnect
    adoWmRS.CursorLocation = adUseClient
    adoWmRS.CursorType = adOpenKeyset
    adoWmRS.LockType = adLockOptimistic
    adoWmRS.Open "select *  from WaterMeter where UID='" & strUID & "'"
    
    If bytFlag = 0 Then '新增--保存
        If adoWmRS.RecordCount > 0 Then
            SaveWmRecord = 1 '有重复值
            Exit Function
        End If
        On Error GoTo errHandleSave
        adoWmRS.AddNew
        adoWmRS!UID = Trim(strUID)
    Else                '编辑--保存
        '无实际内容
        On Error GoTo errHandleSave
    End If
    
    adoWmRS!PID = Trim(strPID)
    adoWmRS!QID = Trim(strQID)
    adoWmRS!WmID = Trim(strWmID)
    adoWmRS!WmCaliber = strWmCaliber
    adoWmRS!WmMakeAddr = strWmMakeAddr
    adoWmRS!WmStartReadNumber = strWmStartReadNumber
    adoWmRS.Update
    On Error GoTo 0
    adoWmRS.Close
    Set adoWmRS = Nothing
    
    SaveWmRecord = 0    '保存成功
    Exit Function

errHandleSave:
    SaveWmRecord = 2 '保存出错
    On Error GoTo 0
End Function

Private Function Detect(ByVal strUID As String) As Boolean
    '将抄表记录表中检测是否存在指定用户的记录
    '
    '
    '
    '
    Detect = False
End Function

Private Function CheckEmptyControl() As Control
    '检查值为空的关键控件
    If Trim(Me.cboP.Text) = "" Then
        Set CheckEmptyControl = Me.cboP
        Exit Function
    End If
    If Trim(Me.cboQ.Text) = "" Then
        Set CheckEmptyControl = Me.cboQ
        Exit Function
    End If
    If Trim(Me.txtUName.Text) = "" Then
        Set CheckEmptyControl = Me.txtUName
        Exit Function
    End If
    If Trim(Me.txtAddr.Text) = "" Then
        Set CheckEmptyControl = Me.txtAddr