frmwatermeterinsteadinput.frm

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

    !NewWmCaliber = Me.debNewWmCaliber.Text
    !NewWmMakeAddr = Trim(Me.txtNewWmMakeAddr.Text)
    !NewWmStatus = Trim(Me.txtNewWmStatus.Text)
    !FixDate = Me.dtpFixDate.value
    !FixMan = Trim(Me.txtFixMan.Text)
    !FixFee = Me.debFixFee.Text
    !Ym = strYm
    .Update
    End With
    
    '3 更新用户档案            (下面两个strSQL的差别在于 Where 从句)
    If bytCommandFlag = 0 Then  '输入--保存
        strSQL = "update UserRecord set WmID='" & Trim(Me.txtNewWmID.Text) & _
                "' where WmID='" & Trim(Me.txtOldWmID.Text) & "'"
    Else                        '编辑--保存
        strSQL = "update UserRecord set WmID='" & Trim(Me.txtNewWmID.Text) & _
                "' where WmID='" & Trim(Me.txtNewWmID.Text) & "'"
    End If
    gConnect.Execute (strSQL)
    
    On Error GoTo 0
    gConnect.CommitTrans     '--------结束事务
    
    If bytCommandFlag = 0 Then  '输入--保存
        adoUWmInsteadRS.MoveLast
    End If
    SaveCurrenData = True

    Exit Function
    '-------错误处理---------
errHandleAdd:
    gConnect.RollbackTrans
    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 UWaterMeterInstead 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 DetectWmID(ByVal strWmID As String) As Byte
   '返回值: 0   无重复值
   '        1   有重复值
   '        2   检测过程失败
    
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select WmID from WaterMeter where WmID='" & strWmID & "'"
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        DetectWmID = 0
    Else
        DetectWmID = 1
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    DetectWmID = 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 adoUWmInsteadRS.EOF Or adoUWmInsteadRS.BOF Then
        Call InitInterface
        Exit Sub
    End If

    Me.txtFixID.Text = adoUWmInsteadRS!FixID
    
    Me.dtpReportDate.value = adoUWmInsteadRS!ReportDate
    Me.txtReportMan.Text = Trim(adoUWmInsteadRS!ReportMan)
    Me.txtUID.Text = Trim(adoUWmInsteadRS!UID)
    
    Call GetUserInfo(Trim(Me.txtUID.Text))
    
    Me.txtOldWmID.Text = Trim(adoUWmInsteadRS!OldWmID)
    Me.txtOldWmCaliber.Text = adoUWmInsteadRS!OldWmCaliber
    Me.txtOldWmMakeAddr.Text = Trim(adoUWmInsteadRS!OldWmMakeAddr)
    Me.txtOldWmStatus.Text = Trim(adoUWmInsteadRS!OldWmStatus)
    Me.debOldWmRead.Text = adoUWmInsteadRS!OldWmRead
    Me.debNewWmRead.Text = adoUWmInsteadRS!NewWmRead
    
    Me.txtYear.Text = Mid(Trim(adoUWmInsteadRS!Ym), 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(Trim(adoUWmInsteadRS!Ym), 5, 2)) - 1
    
    Me.txtNewWmID.Text = Trim(adoUWmInsteadRS!NewWmID)
    Me.debNewWmCaliber.Text = adoUWmInsteadRS!NewWmCaliber
    Me.txtNewWmMakeAddr.Text = Trim(adoUWmInsteadRS!NewWmMakeAddr)
    
    Me.txtNewWmStatus.Text = Trim(adoUWmInsteadRS!NewWmStatus)
    Me.debFixFee.Text = adoUWmInsteadRS!FixFee
    Me.txtFixMan.Text = Trim(adoUWmInsteadRS!FixMan)
    Me.dtpFixDate.value = adoUWmInsteadRS!FixDate
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoUWmInsteadRS.Close
    Set adoUWmInsteadRS = 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 txtNewWmID_GotFocus()
    Call AutoSelectText(txtNewWmID)
End Sub

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

Private Sub txtNewWmID_LostFocus()
    Dim strWmID As String
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If Trim(Me.txtNewWmID.Text) = "" Then Exit Sub
    Me.txtNewWmID.Text = String(gWmIDLen - Len(Trim(Me.txtNewWmID.Text)), "0") & Trim(Me.txtNewWmID.Text)
        
    '检查输入的新水表编号是否有重复值
    If bytCommandFlag = 0 Then  '输入状态
        Select Case DetectWmID(Trim(Me.txtNewWmID.Text))
        Case 0      '没有重复
            '正常情况----空操作(程序继续)
        
        Case 1      '有重复
            Warning "输入新水表的编号已经存在!!!"
            Me.txtNewWmID.SetFocus
        
        Case 2      '检查失败
            Warning "检查输入新水表的编号出错!!!"
            Me.txtNewWmID.SetFocus
        
        End Select
    Else                        '编辑状态
        '对于编辑状态,水表记录中已经有该水表记录,因此要加以判断
        If Trim(Me.txtNewWmID.Text) <> Trim(adoUWmInsteadRS!NewWmID) Then
            Select Case DetectWmID(Trim(Me.txtNewWmID.Text))
            Case 0      '没有重复
                '正常情况----空操作(程序继续)
        
            Case 1      '有重复
                Warning "输入新水表的编号已经存在!!!"
                Me.txtNewWmID.SetFocus
                
            Case 2      '检查失败
                Warning "检查输入新水表的编号出错!!!"
                Me.txtNewWmID.SetFocus
            
            End Select
        End If
    End If
End Sub

Private Sub txtNewWmMakeAddr_GotFocus()
    Call AutoSelectText(txtNewWmMakeAddr)
End Sub

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

Private Sub txtNewWmStatus_GotFocus()
    Call AutoSelectText(txtNewWmStatus)
End Sub

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

Private Sub txtOldWmStatus_GotFocus()
    Call AutoSelectText(txtOldWmStatus)
End Sub

Private Sub txtOldWmStatus_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 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 debFixFee_KeyPress(ByVal KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

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

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

Private Sub debNewWmCaliber_KeyPress(ByVal KeyAscii As Integer)
    IfEnterKeyMoveNext (KeyAscii)
End Sub