frmwatermeterfixinput.frm

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

    End If
    
    strSQL = "select max(FixID) from UWaterMeterFix"
    On Error GoTo ErrHandleExe
    strFixID = Trim(gConnect.Execute(strSQL).Fields(0).value)
    On Error GoTo 0
    
    strFixID = Trim(Str(Val(strFixID) + 1))
    strFixID = String(gFixIDLen - Len(strFixID), "0") & strFixID
    GetMaxFixID = strFixID
    Exit Function
    
    '-------错误处理---------
ErrHandleExe:
    GetMaxFixID = ""
    On Error GoTo 0
End Function

Private Function GetUserInfo(ByVal strUID As String) As Boolean
'根据用户编号得到用户的基本信息，从而更新界面显示
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If strUID = "" Then
        Call ClearUserInfo
        GetUserInfo = False
        Exit Function
    End If
    
    strSQL = "select UID,UName,PName,QName,Addr from vUserRecord where UID='" & strUID & "'"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        On Error Resume Next
        adoTmpRS.Close
        Set adoTmpRS = Nothing
        On Error GoTo 0

        Call ClearUserInfo
        GetUserInfo = False
        Exit Function
    Else
        Me.txtUName.Text = Trim(adoTmpRS!UName)
        Me.txtPName.Text = Trim(adoTmpRS!PName)
        Me.txtQName.Text = Trim(adoTmpRS!QName)
        Me.txtAddr.Text = Trim(adoTmpRS!Addr)
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    GetUserInfo = True
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    Call ClearUserInfo
    GetUserInfo = False
End Function

Private Function GetUWmInfo(ByVal strUID As String) As Boolean
'根据用户编号得到用户水表的基本信息，从而更新界面显示
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If strUID = "" Then
        Call ClearUWmInfo
        GetUWmInfo = False
        Exit Function
    End If
    
    strSQL = "select UID,WmID,WmCaliber,WmMakeAddr from vUserRecord where UID='" & strUID & "'"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        On Error Resume Next
        adoTmpRS.Close
        Set adoTmpRS = Nothing
        On Error GoTo 0

        Call ClearUWmInfo
        GetUWmInfo = False
        Exit Function
    Else
        Me.txtWMID.Text = Trim(adoTmpRS!WmID)
        Me.txtWMCaliber.Text = adoTmpRS!WmCaliber
        Me.txtWmMakeAddr.Text = Trim(adoTmpRS!WmMakeAddr)
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    GetUWmInfo = True
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    Call ClearUWmInfo
    GetUWmInfo = False
End Function

Private Sub ClearUserInfo()
    Me.txtUName.Text = ""
    Me.txtPName.Text = ""
    Me.txtQName.Text = ""
    Me.txtAddr.Text = ""
End Sub

Private Sub ClearUWmInfo()
    Me.txtWMID.Text = ""
    Me.txtWMCaliber.Text = ""
    Me.txtWmMakeAddr.Text = ""
End Sub

Private Function GetCurJFYm() As String
'得到当前所处的水费计费年月
    Dim strSQL As String
    Dim strTmpString As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select max(Ym) from WaterRate"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If IsNull(adoTmpRS.Fields(0)) Then
        '如果计费表为空，则当前年月就是当前的计费年月
        strTmpString = Trim(Str(Month(Date)))
        strTmpString = String(2 - Len(strTmpString), "0") & strTmpString
        strTmpString = Trim(Str(Year(Date))) & strTmpString
    Else
        '如果计费表不为空,则表中最大的计费年月的下个月就是当前的计费年月
        strTmpString = adoTmpRS.Fields(0).value
        strTmpString = NextYm(strTmpString)
    End If
    GetCurJFYm = strTmpString
    
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    GetCurJFYm = ""
    
End Function

Private Function SaveCurrenData() As Boolean
    Dim strYm As String
    
    strYm = Trim(Me.txtYear.Text) & Me.cboMonth.Text
    On Error GoTo errHandleAdd
    If bytCommandFlag = 0 Then  '输入--保存
        adoUWmFixRS.AddNew
        adoUWmFixRS!FixID = Trim(Me.txtFixID.Text)
    Else                        '编辑--保存
        '空操作
    End If
    With adoUWmFixRS
    !ReportDate = Me.dtpReportDate.value
    !ReportMan = Trim(Me.txtReportMan.Text)
    !UID = Trim(Me.txtUID.Text)
    !WmID = Trim(Me.txtWMID.Text)
    !WmCaliber = Me.txtWMCaliber.Text
    !WmMakeAddr = Trim(Me.txtWmMakeAddr.Text)
    !ReportStatus = Trim(Me.txtReportStatus.Text)
    !FixStatus = Trim(Me.txtFixStatus.Text)
    !VerifyStatus = Trim(Me.txtVerifyStatus.Text)
    !FixDate = Me.dtpFixDate.value
    !FixMan = Trim(Me.txtFixMan.Text)
    !FixFee = Me.debFixFee.Text
    !PWmRead = Me.debPWmRead.Text
    !LWmRead = Me.debLWmRead.Text
    !Ym = strYm
    .Update
    End With
    On Error GoTo 0

    If bytCommandFlag = 0 Then  '输入--保存
        adoUWmFixRS.MoveLast
    End If
    SaveCurrenData = True

    Exit Function
    '-------错误处理---------
errHandleAdd:
    Warning "记录保存失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    SaveCurrenData = False

End Function

Private Function DetectFixID(ByVal strFixID As String) As Byte
   '返回值: 0   无重复值
   '        1   有重复值
   '        2   检测过程失败
    
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select FixID from UWaterMeterFix where FixID='" & strFixID & "'"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        DetectFixID = 0
    Else
        DetectFixID = 1
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    DetectFixID = 2
    
End Function

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 DisplayCurrentData()
    '将表中的当前数据记录显示在屏幕上
    If adoUWmFixRS.EOF Or adoUWmFixRS.BOF Then
        Call InitInterface
        Exit Sub
    End If

    Me.txtFixID.Text = adoUWmFixRS!FixID
    
    Me.dtpReportDate.value = adoUWmFixRS!ReportDate
    Me.txtReportMan.Text = Trim(adoUWmFixRS!ReportMan)
    Me.txtUID.Text = Trim(adoUWmFixRS!UID)
    
    Call GetUserInfo(Trim(Me.txtUID.Text))
    
    Me.txtWMID.Text = Trim(adoUWmFixRS!WmID)
    Me.txtWMCaliber.Text = adoUWmFixRS!WmCaliber
    Me.txtWmMakeAddr.Text = Trim(adoUWmFixRS!WmMakeAddr)
    
    Me.txtReportStatus.Text = Trim(adoUWmFixRS!ReportStatus)
    Me.debPWmRead.Text = adoUWmFixRS!PWmRead
    Me.debLWmRead.Text = adoUWmFixRS!LWmRead
    
    Me.txtYear.Text = Mid(Trim(adoUWmFixRS!Ym), 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(Trim(adoUWmFixRS!Ym), 5, 2)) - 1
    
    Me.txtFixStatus.Text = Trim(adoUWmFixRS!FixStatus)
    Me.txtVerifyStatus.Text = Trim(adoUWmFixRS!VerifyStatus)
    Me.debFixFee.Text = adoUWmFixRS!FixFee
    Me.txtFixMan.Text = Trim(adoUWmFixRS!FixMan)
    Me.dtpFixDate.value = adoUWmFixRS!FixDate

End Sub

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

'---------------------------------------------------
'控件常规事件
'---------------------------------------------------

Private Sub txtFixID_GotFocus()
    Call AutoSelectText(txtFixID)
End Sub

Private Sub txtFixID_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtFixID_LostFocus()
    Dim bytFlag As Byte
    
    If Trim(Me.txtFixID.Text) = "" Then
        Warning "请输入维修单编号"
        Me.txtFixID.SetFocus
        Exit Sub
    End If
    
    Me.txtFixID.Text = String(gFixIDLen - Len(Trim(Me.txtFixID.Text)), "0") & Trim(Me.txtFixID.Text)
    
    bytFlag = DetectFixID(Trim(Me.txtFixID.Text))
    If bytFlag = 0 Then '无重复值
        '合法的编号,空操作
    ElseIf bytFlag = 1 Then     '有重复值
        Warning "编号输入重复,请仔细核对!!!"
        Me.txtFixID.SetFocus
    ElseIf bytFlag = 2 Then     '执行失败
        Warning "检测维修单编号过程失败!!!"
        Me.txtFixID.SetFocus
    End If
End Sub

Private Sub txtFixMan_GotFocus()
    Call AutoSelectText(Me.txtFixMan)
End Sub

Private Sub txtFixMan_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtFixStatus_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtReportMan_GotFocus()
    Call AutoSelectText(txtReportMan)
End Sub

Private Sub txtReportMan_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtReportStatus_GotFocus()
    Call AutoSelectText(txtReportStatus)
End Sub

Private Sub txtReportStatus_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtUID_GotFocus()
    Call AutoSelectText(txtUID)
End Sub

Private Sub txtUID_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtUID_LostFocus()
    If Trim(Me.txtUID.Text) = "" Then
        Call ClearUserInfo
        Call ClearUWmInfo
        Exit Sub
    End If
    Me.txtUID.Text = String(gUIDLen - Len(Trim(Me.txtUID.Text)), "0") & Trim(Me.txtUID.Text)
    If Not GetUserInfo(Trim(Me.txtUID.Text)) Then
        Warning "用户编号输入错误!!!"
        Me.txtUID.SetFocus
        Exit Sub
    End If
    Call GetUWmInfo(Trim(Me.txtUID.Text))
End Sub

Private Sub txtVerifyStatus_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub debFixFee_KeyPress(ByVal KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub debLWmRead_KeyPress(ByVal KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub debPWmRead_KeyPress(ByVal KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtYear_GotFocus()
    Call AutoSelectText(txtYear)
End Sub

Private Sub txtYear_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboMonth_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboMonth_LostFocus()
    Dim strNextJFYm As String
    Dim strTheYm As String
    
    If Val(Me.txtYear.Text) < 1900 Or Val(Me.txtYear.Text) > 9999 Then
        Warning "年份格式错误！！！"
        Me.txtYear.SetFocus
        Exit Sub
    End If
    
    strNextJFYm = NextYm(strCurJFYm)
    strTheYm = Me.txtYear.Text & Me.cboMonth.Text
    If bytCommandFlag = 0 Then  '输入----只允许输入当前的计费月份或当前计费月份的下个计费月份
        If strTheYm < strCurJFYm Or strTheYm > strNextJFYm Then
            Warning "所属计费年月输入错误"
            Me.txtYear.SetFocus
        End If
    Else                        '编辑----只要输入的不大于当前计费月份的下个计费月份就合法
        If strTheYm > strNextJFYm Then
            Warning "所属计费年月输入错误"
            Me.txtYear.SetFocus
        End If
    End If
End Sub

Private Sub txtYear_LostFocus()
    Me.cboMonth.SetFocus
End Sub