frmwatermeterinsteadinput.frm

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

        
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select
End Sub



'---------------------------------------------------
'窗体事件
'---------------------------------------------------
Private Sub Form_Load()
    Dim strSQL As String
    
    MoveToCenter gMainFormRefer, Me
    
    '设置关键控件的属性
    Me.txtFixID.MaxLength = gFixIDLen
    Me.txtFixID.Mask = String(gFixIDLen, "9")
    Me.txtUID.MaxLength = gUIDLen
    Me.txtUID.Mask = String(gUIDLen, "9")
    Me.txtYear.MaxLength = 4
    Me.txtYear.Mask = "9999"
    Me.txtNewWmID.MaxLength = gWmIDLen
    Me.txtNewWmID.Mask = String(gWmIDLen, "9")
    
    Me.debOldWmRead.MaxLen = 12
    Me.debNewWmRead.MaxLen = 12
    Me.debNewWmCaliber.MaxLen = 6
    Me.debFixFee.MaxLen = 8
    
    Call FillMonth
    
    '设置当前的水费计费月份
    strCurJFYm = Trim(GetCurJFYm())
    If strCurJFYm = "" Then
        Warning "得到当前计费月份出错!!!"
        Call DisableCMD1
        Call DisableCMD2
        Call DisableCMD3
        Exit Sub
    End If
    
    '初始化界面
    Call InitInterface
    Call DisableInterface
    
    '初始化记录集
    strSQL = "select * from UWaterMeterInstead order by FixID"
    On Error GoTo errHandleInit
    Set adoUWmInsteadRS = New ADODB.Recordset
    Set adoUWmInsteadRS.ActiveConnection = gConnect
    adoUWmInsteadRS.CursorLocation = adUseClient
    adoUWmInsteadRS.CursorType = adOpenKeyset
    adoUWmInsteadRS.LockType = adLockOptimistic
    adoUWmInsteadRS.Open strSQL
    On Error GoTo 0
    
    If Not (adoUWmInsteadRS.EOF And adoUWmInsteadRS.BOF) Then
        adoUWmInsteadRS.MoveLast
    End If
    
    Call DisplayCurrentData
    Call InitCommandBox
    Exit Sub
    
    '-------错误处理---------
errHandleInit:
    Warning "记录集初始化失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    Call DisableCMD1
    Call DisableCMD2
    Call DisableCMD3
    
End Sub


'---------------------------------------------------
'自定义函数/过程
'---------------------------------------------------
Private Sub InitInterface()
    Me.txtFixID.Text = String(gFixIDLen, " ")
    
    Me.dtpReportDate.value = Date
    Me.txtReportMan.Text = ""
    Me.txtUID.Text = String(gUIDLen, " ")
    
    Call ClearUserInfo
    
    Me.txtOldWmStatus.Text = ""
    Me.debOldWmRead.Text = 0
    Me.debNewWmRead.Text = 0
    
    Me.txtYear.Text = Mid(strCurJFYm, 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(strCurJFYm, 5, 2)) - 1
    Me.txtNewWmID.Text = String(gWmIDLen, " ")
    Me.debNewWmCaliber.Text = 0
    Me.txtNewWmMakeAddr.Text = ""
    
    Me.txtNewWmStatus.Text = ""
    Me.debFixFee.Text = 0
    Me.txtFixMan.Text = ""
    Me.dtpFixDate.value = Date
End Sub

Private Sub InitCommandBox()
    Call EnableCMD1
    
    '根据"维修单编号"是否为空来决定是否打开"编辑"和"删除"按扭
    If Trim(Me.txtFixID.Text) = "" Then
        cmdCommandArray1(1).Enabled = False '编辑
        'cmdCommandArray1(2).Enabled = False '删除
    End If
    Call DisableCMD2
    Call EnableCMD3
End Sub

Private Sub EnableInterface()
    Me.txtFixID.Enabled = True
    
    Me.dtpReportDate.Enabled = True
    Me.txtReportMan.Enabled = True
    Me.txtUID.Enabled = True
    
    Me.txtOldWmStatus.Enabled = True
    Me.debOldWmRead.Enabled = True
    Me.debNewWmRead.Enabled = True
    
    Me.txtYear.Enabled = True
    Me.cboMonth.Enabled = True
    Me.txtNewWmID.Enabled = True
    Me.debNewWmCaliber.Enabled = True
    Me.txtNewWmMakeAddr.Enabled = True
    
    Me.txtNewWmStatus.Enabled = True
    Me.debFixFee.Enabled = True
    Me.txtFixMan.Enabled = True
    Me.dtpFixDate.Enabled = True
End Sub

Private Sub DisableInterface()
    Me.txtFixID.Enabled = False
    
    Me.dtpReportDate.Enabled = False
    Me.txtReportMan.Enabled = False
    Me.txtUID.Enabled = False
    
    Me.txtOldWmStatus.Enabled = False
    Me.debOldWmRead.Enabled = False
    Me.debNewWmRead.Enabled = False
    
    Me.txtYear.Enabled = False
    Me.cboMonth.Enabled = False
    Me.txtNewWmID.Enabled = False
    Me.debNewWmCaliber.Enabled = False
    Me.txtNewWmMakeAddr.Enabled = False
    
    Me.txtNewWmStatus.Enabled = False
    Me.debFixFee.Enabled = False
    Me.txtFixMan.Enabled = False
    Me.dtpFixDate.Enabled = False
End Sub

Private Sub FillMonth()
    Me.cboMonth.Clear
    Me.cboMonth.AddItem "01"
    Me.cboMonth.AddItem "02"
    Me.cboMonth.AddItem "03"
    Me.cboMonth.AddItem "04"
    Me.cboMonth.AddItem "05"
    Me.cboMonth.AddItem "06"
    Me.cboMonth.AddItem "07"
    Me.cboMonth.AddItem "08"
    Me.cboMonth.AddItem "09"
    Me.cboMonth.AddItem "10"
    Me.cboMonth.AddItem "11"
    Me.cboMonth.AddItem "12"
End Sub

Private Function GetMaxFixID() As String
'得到可用的维修单号
    Dim strFixID As String
    Dim strSQL As String
    
    If adoUWmInsteadRS.EOF And adoUWmInsteadRS.BOF Then
        GetMaxFixID = String(gFixIDLen - 1, "0") & "1"
        Exit Function
    End If
    
    strSQL = "select max(FixID) from UWaterMeterInstead"
    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.txtOldWmID.Text = Trim(adoTmpRS!WmID)
        Me.txtOldWmCaliber.Text = adoTmpRS!WmCaliber
        Me.txtOldWmMakeAddr.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 = ""
    Me.txtOldWmID.Text = ""
    Me.txtOldWmCaliber.Text = ""
    Me.txtOldWmMakeAddr.Text = ""
End Sub

Private Sub ClearUWmInfo()
    Me.txtOldWmID.Text = ""
    Me.txtOldWmCaliber.Text = ""
    Me.txtOldWmMakeAddr.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
'保存当前的数据
'注意:保存过程牵扯到三个表,在事务中分三步走
'1:更新用户水表档案,2:更新水表更换表,3:更新用户档案
    Dim strYm As String
    Dim strSQL As String
    
    strYm = Trim(Me.txtYear.Text) & Me.cboMonth.Text
    
    gConnect.BeginTrans     '--------开始事务
    On Error GoTo errHandleAdd
    
    '1 更新用户水表档案            (下面两个strSQL的差别在于 Where 从句)
    If bytCommandFlag = 0 Then  '输入--保存
        strSQL = "update WaterMeter " & _
                 "set WmID='" & Trim(Me.txtNewWmID.Text) & "',WmCaliber='" & Me.debNewWmCaliber.Text & "'," & _
                     "WmMakeAddr='" & Trim(Me.txtNewWmMakeAddr.Text) & "',WmStartReadNumber='" & Me.debNewWmRead.Text & "' " & _
                 " where WmID='" & Trim(Me.txtOldWmID.Text) & "'"
    Else                        '编辑--保存
        strSQL = "update WaterMeter " & _
                 "set WmID='" & Trim(Me.txtNewWmID.Text) & "',WmCaliber='" & Me.debNewWmCaliber.Text & "'," & _
                     "WmMakeAddr='" & Trim(Me.txtNewWmMakeAddr.Text) & "',WmStartReadNumber='" & Me.debNewWmRead.Text & "' " & _
                 " where WmID='" & Trim(adoUWmInsteadRS!NewWmID) & "'"
    End If
    gConnect.Execute strSQL
    
    '2 更新水表更换表
    If bytCommandFlag = 0 Then  '输入--保存
        adoUWmInsteadRS.AddNew
        adoUWmInsteadRS!FixID = Trim(Me.txtFixID.Text)
    Else                        '编辑--保存
        '空操作
    End If
    With adoUWmInsteadRS
    !ReportDate = Me.dtpReportDate.value
    !ReportMan = Trim(Me.txtReportMan.Text)
    !UID = Trim(Me.txtUID.Text)
    !OldWmID = Trim(Me.txtOldWmID.Text)
    !OldWmCaliber = Me.txtOldWmCaliber.Text
    !OldWmMakeAddr = Trim(Me.txtOldWmMakeAddr.Text)
    !OldWmStatus = Trim(Me.txtOldWmStatus.Text)
    
    !OldWmRead = Me.debOldWmRead.Text
    !NewWmRead = Me.debNewWmRead.Text
    !NewWmID = Trim(Me.txtNewWmID.Text)