frmmainwatermeterinsteadinput.frm

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

Option Explicit

Dim adoMWmInsteadRS As ADODB.Recordset

Dim bytCommandFlag As Byte  '用于记录第一组按钮的状态,这样,在第二组的保存,放弃按钮中
                            '就可知道是原来是按的新增还是编辑,从而采取不同的处理方法
Dim strCurJFYm As String    '当前所处的计费年月（由计费记录表来判断）

'---------------------------------------------------
'按钮事件
'---------------------------------------------------
Private Sub cmdCommandArray1_Click(Index As Integer)
    Dim strFixID As String
    
    bytCommandFlag = Index
    Select Case Index
        Case 0  '输入
            strFixID = Trim(GetMaxFixID())
            If strFixID = "" Then
                Warning "得到维修单编号出错!!!"
                Exit Sub
            End If
            
            Call DisableCMD1
            Call EnableCMD2
            Call DisableCMD3
            
            Call InitInterface
            Call EnableInterface
            Me.txtFixID.Text = strFixID
            Me.dtpReportDate.SetFocus
        
        Case 1  '编辑
            If Trim(Me.txtFixID.Text) = "" Then Exit Sub
            
            Call DisableCMD1
            Call EnableCMD2
            Call DisableCMD3
            
            Call EnableInterface
            Me.txtFixID.Enabled = False '注意：编辑时只能对该编号用户的维修内容进行编辑
            Me.txtOldMWmID.Enabled = False   '注意：编辑时不允许编辑原水表编号(原因和不能删除一样)
            Me.txtNewMWmID.Enabled = False   '注意：编辑时不允许编辑新水表编号(原因和不能删除一样)
            Me.dtpReportDate.SetFocus
        
'对于更换操作由于牵扯到用户档案的修改，因此不能删除（如果删除将带来一系列的问题），如果确实要“删除”，只能再次更换
'        Case 2  '删除
'            Dim bytReturnFlag As Byte '用于接收msgbox
'
'            If Trim(Me.txtFixID.Text) = "" Then Exit Sub
'            If adoMWmInsteadRS.EOF Or adoMWmInsteadRS.BOF Then Exit Sub
'
'            bytReturnFlag = MsgBox("确定要删除该用户的水表更换记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
'            If bytReturnFlag = vbNo Then Exit Sub
'
'            '删除该记录,清屏
'            adoMWmInsteadRS.Delete
'            On Error Resume Next
'            adoMWmInsteadRS.MoveNext
'            If adoMWmInsteadRS.EOF Then adoMWmInsteadRS.MovePrevious
'            On Error GoTo 0
'            Call DisplayCurrentData
'            Call InitCommandBox
'
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select

End Sub

Private Sub cmdCommandArray2_Click(Index As Integer)
    Dim bytReturnFlag As Byte '用于接收msgbox
    
    Select Case Index
        Case 0  '保存
            '检测关键数据是否填写
            If Trim(Me.txtOldMWmID.Text) = "" Then
                Warning "原总表编号没有输入!!!"
                Me.txtOldMWmID.SetFocus
                Exit Sub
            End If
            If Trim(Me.txtNewMWmID.Text) = "" Then
                Warning "新总表编号没有输入!!!"
                Me.txtNewMWmID.SetFocus
                Exit Sub
            End If
            
            '保存提示
            bytReturnFlag = MsgBox("请仔细核对更换前、更换后水表的读数和编号以及所属计费时段" & Chr(13) & Chr(13) & "这些数据将直接影响总用水量计算操作!!!", vbYesNoCancel + vbInformation + vbDefaultButton1, "提示信息")
            If bytReturnFlag = vbNo Then            '不保存
                Call DisplayCurrentData
            ElseIf bytReturnFlag = vbCancel Then    '从试
                Exit Sub
            ElseIf bytReturnFlag = vbYes Then       '保存数据
                Call SaveCurrenData
            End If
            Call DisableInterface
            Call InitCommandBox
                   
        Case 1  '放弃
            Call DisplayCurrentData
            Call DisableInterface
            Call InitCommandBox
    
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select

End Sub

Private Sub cmdCommandArray3_Click(Index As Integer)
    Select Case Index
        Case 0  '<<
            If adoMWmInsteadRS.BOF Then         '记录集为空的情况
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            
            adoMWmInsteadRS.MovePrevious        '如果已经是首条的情况,Beep
            If adoMWmInsteadRS.BOF Then
                adoMWmInsteadRS.MoveNext
                Beep
                Exit Sub
            End If
            
            adoMWmInsteadRS.MoveFirst           '正常情况
            Call DisplayCurrentData
        
        Case 1  '<
            If adoMWmInsteadRS.BOF Then
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            adoMWmInsteadRS.MovePrevious
            If adoMWmInsteadRS.BOF Then
                adoMWmInsteadRS.MoveNext
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 2  '>
            If adoMWmInsteadRS.EOF Then
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            adoMWmInsteadRS.MoveNext
            If adoMWmInsteadRS.EOF Then
                adoMWmInsteadRS.MovePrevious
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 3  '>>
            If adoMWmInsteadRS.EOF Then         '记录集为空的情况
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            
            adoMWmInsteadRS.MoveNext            '如果已经是尾条的情况,Beep
            If adoMWmInsteadRS.EOF Then
                adoMWmInsteadRS.MovePrevious
                Beep
                Exit Sub
            End If
            
            adoMWmInsteadRS.MoveLast            '正常情况
            Call DisplayCurrentData
        
        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.txtOldMWmID.MaxLength = gMWmIDLen
    Me.txtOldMWmID.Mask = String(gMWmIDLen, "9")
    Me.txtNewMWmID.MaxLength = gMWmIDLen
    Me.txtNewMWmID.Mask = String(gMWmIDLen, "9")
    Me.txtYear.MaxLength = 4
    Me.txtYear.Mask = "9999"
    
    Me.debOldMWmRead.MaxLen = 12
    Me.debNewMWmRead.MaxLen = 12
    
    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 MWaterMeterInstead order by FixID"
    On Error GoTo errHandleInit
    Set adoMWmInsteadRS = New ADODB.Recordset
    Set adoMWmInsteadRS.ActiveConnection = gConnect
    adoMWmInsteadRS.CursorLocation = adUseClient
    adoMWmInsteadRS.CursorType = adOpenKeyset
    adoMWmInsteadRS.LockType = adLockOptimistic
    adoMWmInsteadRS.Open strSQL
    On Error GoTo 0
    
    If Not (adoMWmInsteadRS.EOF And adoMWmInsteadRS.BOF) Then
        adoMWmInsteadRS.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.txtOldMWmID.Text = String(gMWmIDLen, " ")
    Me.txtNewMWmID.Text = String(gMWmIDLen, " ")
    
    Me.debOldMWmRead.Text = 0
    Me.debNewMWmRead.Text = 0
    
    Me.txtYear.Text = Mid(strCurJFYm, 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(strCurJFYm, 5, 2)) - 1
    
    Me.txtOldMWmStatus.Text = ""
    Me.txtNewMWmStatus.Text = ""
    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.txtOldMWmID.Enabled = True
    'Me.txtNewMWmID.Enabled = True
    Me.debOldMWmRead.Enabled = True
    Me.debNewMWmRead.Enabled = True
    Me.txtYear.Enabled = True
    Me.cboMonth.Enabled = True
    
    Me.txtOldMWmStatus.Enabled = True
    Me.txtNewMWmStatus.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.txtOldMWmID.Enabled = False
    Me.txtNewMWmID.Enabled = False
    Me.debOldMWmRead.Enabled = False
    Me.debNewMWmRead.Enabled = False
    Me.txtYear.Enabled = False
    Me.cboMonth.Enabled = False
    
    Me.txtOldMWmStatus.Enabled = False
    Me.txtNewMWmStatus.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 adoMWmInsteadRS.EOF And adoMWmInsteadRS.BOF Then
        GetMaxFixID = String(gFixIDLen - 1, "0") & "1"
        Exit Function
    End If
    
    strSQL = "select max(FixID) from MWaterMeterInstead"
    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
'保存当前的数据
'注意:保存过程牵扯到三个表,在事务中分三步走
' 1:更新用户档案, 2: 更新总表表 ,3:更新总表更换表
    Dim strYm As String
    Dim strSQL As String
    
    strYm = Trim(Me.txtYear.Text) & Me.cboMonth.Text