frmgivestopwater.frm

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

            Call DisableCMD1
            Call EnableCMD2
            Call DisableCMD3
            
            Call EnableInterface
            Me.dtpStartDate.SetFocus
        
        Case 2  '删除
            If adoStopWaterRS.EOF Or adoStopWaterRS.BOF Then Exit Sub
            
            bytReturnFlag = MsgBox("确定要删除该条停水记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
            If bytReturnFlag = vbNo Then Exit Sub
            
            '删除该记录,显示最近的(下)一条记录
            adoStopWaterRS.Delete
            On Error Resume Next
            adoStopWaterRS.MoveNext
            If adoStopWaterRS.EOF Then adoStopWaterRS.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)
    Select Case Index
        Case 0  '保存
            Dim bytReturnFlag As Byte '用于接收msgbox
            bytReturnFlag = MsgBox("确定要保存吗？", vbYesNo + vbInformation + vbDefaultButton1, "提示信息")
            If bytReturnFlag = vbNo Then
                Call Cancel
            Else
                '保存数据
                Call Save
            End If
                   
        Case 1  '放弃
            Call Cancel
    
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select

End Sub

Private Sub cmdCommandArray3_Click(Index As Integer)
    Select Case Index
        Case 0  '<<
            If adoStopWaterRS.BOF Then         '记录集为空的情况
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            
            adoStopWaterRS.MovePrevious        '如果已经是首条的情况,Beep
            If adoStopWaterRS.BOF Then
                adoStopWaterRS.MoveNext
                Beep
                Exit Sub
            End If
            
            adoStopWaterRS.MoveFirst           '正常情况
            Call DisplayCurrentData
        
        Case 1  '<
            If adoStopWaterRS.BOF Then
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            adoStopWaterRS.MovePrevious
            If adoStopWaterRS.BOF Then
                adoStopWaterRS.MoveNext
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 2  '>
            If adoStopWaterRS.EOF Then
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            adoStopWaterRS.MoveNext
            If adoStopWaterRS.EOF Then
                adoStopWaterRS.MovePrevious
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 3  '>>
            If adoStopWaterRS.EOF Then         '记录集为空的情况
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            
            adoStopWaterRS.MoveNext            '如果已经是尾条的情况,Beep
            If adoStopWaterRS.EOF Then
                adoStopWaterRS.MovePrevious
                Beep
                Exit Sub
            End If
            
            adoStopWaterRS.MoveLast            '正常情况
            Call DisplayCurrentData
        
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select

End Sub




'------------------------------------------------------
'窗体事件
'------------------------------------------------------
Private Sub Form_Load()
    MoveToCenter gMainFormRefer, Me
    
    '初始化记录集
    On Error GoTo errHandleOpen
    Set adoStopWaterRS = New ADODB.Recordset
    Set adoStopWaterRS.ActiveConnection = gConnect
    adoStopWaterRS.CursorLocation = adUseClient
    adoStopWaterRS.CursorType = adOpenKeyset
    adoStopWaterRS.LockType = adLockOptimistic
    adoStopWaterRS.Open "select * from StopWater"
    On Error GoTo 0
    
    On Error Resume Next
    adoStopWaterRS.MoveLast
    On Error GoTo 0
    Call DisplayCurrentData
    Call DisableInterface
    Call InitCommandBox
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0

End Sub

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


'------------------------------------------------------
'自定义函数/过程
'------------------------------------------------------
Private Sub InitInterface()
    Dim i As Byte '循环变量
    
    Me.txtSwID.Text = ""
    
    Me.dtpStartDate.value = Date
    Me.txtStartTime.Text = "00:00"
    Me.dtpEndDate.value = Date
    Me.txtEndTime.Text = "00:00"
    
    Me.rtbArea.Text = ""
    Me.rtbCause.Text = ""
    
    For i = 0 To 4
        Me.chkNotify(i).value = 0
    Next i
    Me.txtWorkMan.Text = ""
End Sub

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

Private Sub EnableInterface()
    Dim i As Byte '循环变量
    Me.dtpStartDate.Enabled = True
    Me.txtStartTime.Enabled = True
    Me.dtpEndDate.Enabled = True
    Me.txtEndTime.Enabled = True
    
    Me.rtbArea.Enabled = True
    Me.rtbCause.Enabled = True
    
    For i = 0 To 4
        Me.chkNotify(i).Enabled = True
    Next i
    Me.txtWorkMan.Enabled = True
End Sub

Private Sub DisableInterface()
    Dim i As Byte '循环变量
    Me.dtpStartDate.Enabled = False
    Me.txtStartTime.Enabled = False
    Me.dtpEndDate.Enabled = False
    Me.txtEndTime.Enabled = False
    
    Me.rtbArea.Enabled = False
    Me.rtbCause.Enabled = False
    
    For i = 0 To 4
        Me.chkNotify(i).Enabled = False
    Next i
    Me.txtWorkMan.Enabled = False
End Sub

Private Sub DisplayCurrentData()
    '将表中的当前数据记录显示在屏幕上
    If adoStopWaterRS.EOF Or adoStopWaterRS.BOF Then
        Call InitInterface
        Exit Sub
    End If
    With adoStopWaterRS
    Me.txtSwID.Text = Trim(!SwID)
    Me.dtpStartDate.value = !StartDate
    Me.txtStartTime.Text = !StartTime
    Me.dtpEndDate.value = !EndDate
    Me.txtEndTime.Text = !EndTime
    Me.rtbArea.Text = Trim(!Area)
    Me.rtbCause.Text = Trim(!Cause)
    Me.chkNotify(0).value = !Notify1
    Me.chkNotify(1).value = !Notify2
    Me.chkNotify(2).value = !Notify3
    Me.chkNotify(3).value = !Notify4
    Me.chkNotify(4).value = !Notify5
    Me.txtWorkMan.Text = Trim(!WorkMan)
    End With
End Sub

Private Function GetMaxSwID() As String
'得到表中当前尚未使用的编号
    Dim strMaxID As String
    Dim strSQL As String
    
    If adoStopWaterRS.RecordCount < 1 Then
        strMaxID = ""
    Else
        strSQL = "select max(SwID) from StopWater"
        On Error GoTo errHandleExe
        strMaxID = gConnect.Execute(strSQL).Fields(0).value
        On Error GoTo 0
    End If
    If strMaxID = "" Then
        strMaxID = String(gSwIDLen - 1, "0") & "1"
    Else
        strMaxID = Trim(Str(Val(strMaxID) + 1))
        strMaxID = String(gSwIDLen - Len(strMaxID), "0") & strMaxID
    End If
    
    GetMaxSwID = strMaxID
    Exit Function
    
    '-------错误处理---------
errHandleExe:
    GetMaxSwID = ""     '执行SQL 语句出错
    On Error GoTo 0
    
End Function

Private Sub Save()
    Dim strSwID As String
    
    If bytCommandFlag = 0 Then  '新增---保存
        strSwID = GetMaxSwID
        If strSwID = "" Then
            Warning "得到编号失败,无法保存!!!"
            Exit Sub
        End If
        
        On Error GoTo errHandleSave
        adoStopWaterRS.AddNew
        adoStopWaterRS!SwID = strSwID
    Else                        '编辑---保存
        On Error GoTo errHandleSave
    End If
    With adoStopWaterRS
    !StartDate = Me.dtpStartDate.value
    !StartTime = Me.txtStartTime.Text
    !EndDate = Me.dtpEndDate.value
    !EndTime = Me.txtEndTime.Text
    !Area = Trim(Me.rtbArea.Text)
    !Cause = Trim(Me.rtbCause.Text)
    !Notify1 = Me.chkNotify(0).value
    !Notify2 = Me.chkNotify(1).value
    !Notify3 = Me.chkNotify(2).value
    !Notify4 = Me.chkNotify(3).value
    !Notify5 = Me.chkNotify(4).value
    !WorkMan = Trim(Me.txtWorkMan.Text)
    .Update
    End With
    On Error GoTo 0
    If bytCommandFlag = 0 Then  '新增---保存
        Me.txtSwID.Text = strSwID
        On Error Resume Next
        adoStopWaterRS.MoveLast
        On Error GoTo 0
    End If

    Call DisableInterface
    Call InitCommandBox
    Exit Sub
    
    '-------错误处理---------
errHandleSave:
    Warning "记录保存失败！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub

Private Sub Cancel()
    Call DisplayCurrentData
    Call DisableInterface
    Call InitCommandBox
End Sub

Private Function FormatTime(ByVal strTime As String) As String
    '判断时间格式是否正确----00:00
    '如果指定字符串不能转换为时间格式则返回空串
    Dim strHour As String
    Dim strMinute As String
    
    If Len(strTime) <> 5 Then
        FormatTime = ""
        Exit Function
    End If
    If InStr(strTime, ":") <> 3 Then
        FormatTime = ""
        Exit Function
    End If
    
    strHour = Trim(Mid(strTime, 1, 2))
    strMinute = Trim(Mid(strTime, 4, 2))
    
    strHour = String(2 - Len(strHour), "0") & strHour
    strMinute = String(2 - Len(strMinute), "0") & strMinute
    
    If Val(strHour) > 23 Or Val(strMinute) > 59 Then
        FormatTime = ""
    Else
        FormatTime = strHour & ":" & strMinute
    End If
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 txtStartTime_GotFocus()
    Call AutoSelectText(txtStartTime)
End Sub

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

Private Sub txtStartTime_LostFocus()
    Dim strTime As String
    strTime = FormatTime(Me.txtStartTime.FormattedText)
    If strTime = "" Then
        Warning "时间格式不正确!!!"
        Me.txtStartTime.SetFocus
        Exit Sub
    Else
        Me.txtStartTime.Text = strTime
    End If
End Sub

Private Sub txtEndTime_LostFocus()
    Dim strTime As String
    strTime = FormatTime(Me.txtEndTime.FormattedText)
    If strTime = "" Then
        Warning "时间格式不正确!!!"
        Me.txtEndTime.SetFocus
        Exit Sub
    Else
        Me.txtEndTime.Text = strTime
    End If
End Sub

Private Sub txtWorkMan_GotFocus()
    Call AutoSelectText(txtWorkMan)
End Sub

Private Sub txtEndTime_GotFocus()
    Call AutoSelectText(txtEndTime)
End Sub

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

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