frmmainwatermeterfixinput.frm

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

    
    strSQL = "select max(FixID) from MWaterMeterFix"
    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 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  '输入--保存
        adoMWmFixRS.AddNew
        adoMWmFixRS!FixID = Trim(Me.txtFixID.Text)
    Else                        '编辑--保存
        '空操作
    End If
    With adoMWmFixRS
    !ReportDate = Me.dtpReportDate.value
    !ReportMan = Trim(Me.txtReportMan.Text)
    !MWmID = Trim(Me.txtMWmID.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)
    !PMWmRead = Me.debPMWmRead.Text
    !LMWmRead = Me.debLMWmRead.Text
    !Ym = strYm
    .Update
    End With
    On Error GoTo 0

    If bytCommandFlag = 0 Then  '输入--保存
        adoMWmFixRS.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 MWaterMeterFix 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 Function DetectMWmID(ByVal strMWmID As String) As Boolean
   '返回值: TRUE   检测到
   '        FALSE  没有检测到
    
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select MWmID from MWatermeter where MWmID='" & strMWmID & "'"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        DetectMWmID = False
    Else
        DetectMWmID = True
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    DetectMWmID = False
    
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 adoMWmFixRS.EOF Or adoMWmFixRS.BOF Then
        Call InitInterface
        Exit Sub
    End If

    Me.txtFixID.Text = adoMWmFixRS!FixID
    
    Me.dtpReportDate.value = adoMWmFixRS!ReportDate
    Me.txtReportMan.Text = Trim(adoMWmFixRS!ReportMan)
    Me.txtMWmID.Text = Trim(adoMWmFixRS!MWmID)
    
    Me.txtReportStatus.Text = Trim(adoMWmFixRS!ReportStatus)
    Me.debPMWmRead.Text = adoMWmFixRS!PMWmRead
    Me.debLMWmRead.Text = adoMWmFixRS!LMWmRead
    
    Me.txtYear.Text = Mid(Trim(adoMWmFixRS!Ym), 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(Trim(adoMWmFixRS!Ym), 5, 2)) - 1
    
    Me.txtFixStatus.Text = Trim(adoMWmFixRS!FixStatus)
    Me.txtVerifyStatus.Text = Trim(adoMWmFixRS!VerifyStatus)
    Me.txtFixMan.Text = Trim(adoMWmFixRS!FixMan)
    Me.dtpFixDate.value = adoMWmFixRS!FixDate
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoMWmFixRS.Close
    Set adoMWmFixRS = 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_GotFocus()
    Call AutoSelectText(txtFixStatus)
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 txtMWmID_GotFocus()
    Call AutoSelectText(txtMWmID)
End Sub

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

Private Sub txtMWmID_LostFocus()
    If Trim(Me.txtMWmID.Text) = "" Then Exit Sub
    
    Me.txtMWmID.Text = String(gMWmIDLen - Len(Trim(Me.txtMWmID.Text)), "0") & Trim(Me.txtMWmID.Text)
    '检测
    If Not DetectMWmID(Trim(Me.txtMWmID.Text)) Then
        Warning "输入的总表号不存在！！！"
        Me.txtMWmID.SetFocus
        Exit Sub
    End If
End Sub

Private Sub txtVerifyStatus_GotFocus()
    Call AutoSelectText(txtVerifyStatus)
End Sub

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

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

Private Sub debPMWmRead_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