frmwaterraterequisition_select.frm

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

        Me.cboMonth.SetFocus
        Exit Sub
    End If
End Sub

Private Sub chkChargeType_Click()
    If Me.chkChargeType.value = 0 Then
        Call ClearChargeType
        Me.cboChargeType.Enabled = False
    Else
        Call FillChargeType
        Me.cboChargeType.Enabled = True
        Me.cboChargeType.SetFocus
        
        Me.chkUser.value = 0
    End If
End Sub

Private Sub Form_Load()
    '设置关键控件属性
    Me.txtUID.MaxLength = gUIDLen
    
    txtYear.Text = Year(Date)
    cboMonth.AddItem ("01")
    cboMonth.AddItem ("02")
    cboMonth.AddItem ("03")
    cboMonth.AddItem ("04")
    cboMonth.AddItem ("05")
    cboMonth.AddItem ("06")
    cboMonth.AddItem ("07")
    cboMonth.AddItem ("08")
    cboMonth.AddItem ("09")
    cboMonth.AddItem ("10")
    cboMonth.AddItem ("11")
    cboMonth.AddItem ("12")
    cboMonth.ListIndex = Month(Date) - 1
    

    '初始化其它返回值
    strReturnYear = ""
    strReturnMonth = ""
    strReturnChargeTypeID = ""
    strReturnChargeTypeName = ""
    strReturnPID = ""
    strReturnQID = ""
    strReturnPName = ""
    strReturnQName = ""
    strReturnUID = ""
    
    '初始化记录集
    On Error GoTo errHandleOpen
    Set adoPRS = New ADODB.Recordset
    Set adoPRS.ActiveConnection = gConnect
    adoPRS.CursorLocation = adUseClient
    adoPRS.CursorType = adOpenForwardOnly
    adoPRS.LockType = adLockOptimistic
    adoPRS.Open "select PID,PName from Pian"
    
    Set adoQRS = New ADODB.Recordset
    Set adoQRS.ActiveConnection = gConnect
    adoQRS.CursorLocation = adUseClient
    adoQRS.CursorType = adOpenForwardOnly
    adoQRS.LockType = adLockOptimistic
    
    Set adoChargeTypeRS = New ADODB.Recordset
    Set adoChargeTypeRS.ActiveConnection = gConnect
    adoChargeTypeRS.CursorLocation = adUseClient
    adoChargeTypeRS.CursorType = adOpenForwardOnly
    adoChargeTypeRS.LockType = adLockOptimistic
    adoChargeTypeRS.Open "select ChargeTypeID,ChargeTypeName from ChargeType order by ChargeTypeID"
    On Error GoTo 0
    
    Me.cboP.ListField = "PName"
    Me.cboP.BoundColumn = "PID"
    Me.cboChargeType.ListField = "ChargeTypeName"
    Me.cboChargeType.BoundColumn = "ChargeTypeID"
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集创建失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    Exit Sub

End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoChargeTypeRS.Close
    adoPRS.Close
    adoQRS.Close
    Set adoChargeTypeRS = Nothing
    Set adoPRS = Nothing
    Set adoQRS = Nothing
    On Error GoTo 0
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 txtYear_LostFocus()
    If Me.txtYear.Text < 1000 Or Me.txtYear.Text > 9999 Then
        Warning "日期格式输入错误!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
    If Me.txtYear.Text > Year(Date) Then
        Warning "年份不能大于当前年份!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
End Sub

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

Private Sub FillChargeType()
    Set Me.cboChargeType.RowSource = adoChargeTypeRS
    Me.cboChargeType.Text = ""
End Sub

Private Sub ClearChargeType()
    Set Me.cboChargeType.RowSource = Nothing
    Me.cboChargeType.Text = ""
End Sub

Private Sub FillP()
    Set Me.cboP.RowSource = adoPRS
    Me.cboP.Text = ""
End Sub

Private Sub ClearP()
    Set Me.cboP.RowSource = Nothing
    Me.cboP.Text = ""
End Sub

Private Sub FillQ(ByVal strPID As String)
    On Error Resume Next
    adoQRS.Close
    On Error GoTo 0
    On Error GoTo errHandleOpen
    adoQRS.Open "select QID,QName from Qu where PID='" & Trim(strPID) & "'"
    On Error GoTo 0
    
    Set Me.cboQ.RowSource = adoQRS
    Me.cboQ.ListField = "QName"
    Me.cboQ.BoundColumn = "QID"
    Me.cboQ.Text = ""
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    Exit Sub
    
End Sub

Private Sub ClearQ()
    Set Me.cboQ.RowSource = Nothing
    Me.cboQ.Text = ""
End Sub

Private Sub chkPQ_Click(Index As Integer)
    Select Case Index
    Case 0      '片
        If Me.chkPQ(0).value = 0 Then
            Call ClearP
            Me.cboP.Enabled = False
            Me.chkPQ(1).value = 0
            Me.chkPQ(1).Enabled = False
        Else
            Call FillP
            Me.cboP.Enabled = True
            Me.chkPQ(1).Enabled = True
            Me.chkUser.value = 0
            Me.cboP.SetFocus
        End If
        
    Case 1      '区
        If Me.chkPQ(1).value = 0 Then
            Call ClearQ
            Me.cboQ.Enabled = False
        Else
            Call FillQ(Me.cboP.BoundText)
            Me.cboQ.Enabled = True
        End If
    End Select
End Sub

Private Sub chkUser_Click()
    If Me.chkUser.value = 0 Then
        Me.txtUID.Text = ""
        Me.txtUName.Text = ""
        Me.txtUID.Enabled = False
    Else
        Me.chkChargeType.value = 0
        chkPQ(0).value = 0
        Me.txtUID.Enabled = True
        Me.txtUID.SetFocus
    End If
End Sub


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

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

Private Sub cboP_LostFocus()
    If Trim(Me.cboP.Text) = "" Then
        Exit Sub
    End If
    If Me.chkPQ(1).value = 1 Then
        Call FillQ(Me.cboP.BoundText)
    End If
End Sub

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

Private Sub cboSQ_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)
    If KeyAscii = 13 Then
        KeyAscii = 0
        SendKeys "{tab}"
    End If
End Sub

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

Private Sub cboP_Change()
    Me.cboQ.Text = ""
End Sub

Private Sub txtUID_LostFocus()
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If Trim(Me.txtUID.Text) = "" Then
        Me.txtUName.Text = ""
        Exit Sub
    End If
        
    Me.txtUID.Text = String(gUIDLen - Len(Trim(Me.txtUID.Text)), "0") & Trim(Me.txtUID.Text)
    
    strSQL = "select UID,UName from UserRecord where UID='" & Trim(Me.txtUID.Text) & "' and Status='1'"     '从正常用户中查找
    On Error GoTo ErrHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        Me.txtUName.Text = ""
        Warning "用户号无效！！！"
        Me.txtUID.SetFocus
    Else
        Me.txtUName.Text = Trim(adoTmpRS.Fields("UName"))
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    Exit Sub
    
    '-------错误处理---------
ErrHandleExe:
    On Error GoTo 0
    Me.txtUID.Text = ""
    Me.txtUName.Text = ""
    Warning "用户查找失败！" & Chr(13) & Err.Description
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
End Sub