frmnogeneralusermanagequery_select.frm

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

            strReturnSQL = strReturnSQL & "and PID='" & Me.cboP.BoundText & "' "
            strReturnUser = strReturnUser & IIf(Trim(strReturnUser) = "", Trim(Me.cboP.Text), "," & Trim(Me.cboP.Text))
            If Trim(Me.cboQ.Text) <> "" Then
                strReturnSQL = strReturnSQL & "and QID='" & Me.cboQ.BoundText & "' "
                strReturnUser = strReturnUser & "," & Trim(Me.cboQ.Text)
            End If
        End If
    End If

    strReturnSQL = strReturnSQL & "order by UID"
    Unload Me
End Sub

Private Sub Form_Load()
    '初始化返回值
    strReturnSQL = ""
    strReturnSQ = ""
    strReturnUser = ""
    
    
    '设置关键控件属性
    Me.txtUID.MaxLength = gUIDLen
    
    Me.cboSQ.AddItem "当前"
    Me.cboSQ.AddItem "历史"
    Me.cboSQ.ListIndex = 0
    
    '初始化记录集
    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
    On Error GoTo 0
    
'    Set Me.cboP.RowSource = adoPRS
    Me.cboP.ListField = "PName"
    Me.cboP.BoundColumn = "PID"
    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
    adoPRS.Close
    adoQRS.Close
    Set adoPRS = Nothing
    Set adoQRS = Nothing
    On Error GoTo 0
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
            Call ClearQ
            Me.cboQ.Enabled = False
            Me.chkPQ(1).value = 0
            Me.chkPQ(1).Enabled = False
            
        Else
            chkChargetType(0).Enabled = True
            chkChargetType(1).Enabled = True
            
            Call FillP
            Me.cboP.Enabled = True
            Me.chkPQ(1).value = 0
            Me.chkPQ(1).Enabled = True
            
            Call ClearQ
            Me.cboQ.Enabled = False
            
            Me.chkUser.value = 0
            Me.txtUID.Text = ""
            Me.txtUName.Text = ""
            Me.txtUID.Enabled = False
            
            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.Text = ""
            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
    
        chkChargetType(0).Enabled = True
        chkChargetType(1).Enabled = True
    Else
        chkChargetType(0).value = 0
        chkChargetType(1).value = 0
        chkChargetType(0).Enabled = False
        chkChargetType(1).Enabled = False
        
        chkPQ(0).value = 0
'        chkPQ(1).value = 0
'        chkPQ(1).Enabled = False
        
'        Call ClearP
'        Me.cboP.Enabled = False
'        Call ClearQ
'        Me.cboQ.Enabled = False
        
        
        Me.txtUID.Enabled = True
        Me.txtUID.SetFocus
    End If
    
End Sub

Private Sub cboP_LostFocus()
    If Trim(Me.cboP.Text) = "" Then
        Beep
        Me.cboP.SetFocus
        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_Change()
        Me.cboQ.Text = ""
End Sub

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

Private Sub txtUID_LostFocus()
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If Trim(Me.txtUID.Text) = "" Then
'        Me.cmdCB(0).Enabled = True
        Me.txtUName.Text = ""
        Me.cmdCB(0).SetFocus
        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.cmdCB(0).Enabled = False
        Me.txtUName.Text = ""
        Warning "用户号无效！！！"
        Me.txtUID.SetFocus
    Else
'        Me.cmdCB(0).Enabled = True
        Me.txtUName.Text = Trim(adoTmpRS.Fields("UName"))
        Me.cmdCB(0).SetFocus
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    Exit Sub
    
    '-------错误处理---------
errHandleExe:
    On Error GoTo 0
    Me.txtUName.Text = ""
'    Me.cmdCB(0).Enabled = False
    Warning "用户查找失败！" & Chr(13) & Err.Description
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
End Sub