frm_用户信息.frm

农村水电费记帐录入

    
    If .Row > 0 Then
        If Not UpControl(Trim(.TextMatrix(.Row, 1)), True) Then
            MsgBox "用户信息更新失败!", , "系统提示"
            Exit Sub
        End If
    End If
End With
  
End Sub

Private Sub cmdsave_Click()
Dim rsDianrec As New ADODB.Recordset
Dim rsUserrec As New ADODB.Recordset
Dim rssel As New ADODB.Recordset
Dim i As Integer
Dim rowi As String
Dim strsel As String
 rowi = Chkgrd(i)
If rowi <> "ok" Then
    MsgBox "请检查" & Trim(rowi) & "是否正确?", , "系统提示"
    Exit Sub
End If
With rssel
    If .State = adStateOpen Then .Close
    If Me.tag = "add" Then
        .Open "select   dbo.f_getpy('" & Trim(txtName.Text) & "') as sel", strcnn, adOpenKeyset, adLockBatchOptimistic
        If .RecordCount > 0 Then
            strsel = Trim(.Fields("sel"))
        End If
    End If
    If .State = adStateOpen Then .Close
End With

With rsUserrec
    If .State = adStateOpen Then .Close
    If Me.tag = "add" Then
        .Open "select top 0 * from 用户信息", strcnn, adOpenKeyset, adLockBatchOptimistic
        .AddNew
        .Fields("selcol") = strsel
        .Fields("欠费月份") = Format("20" & left(Trim(txtYf.Text), 2) & "-" & Right(Trim(txtYf.Text), 2) & "-01", "yymm")
        .Fields("欠费金额") = Trim(txtsum.Text)
        .Fields("欠费登记") = True

    Else
        .Open "select *  from 用户信息  where 用户编号='" & Trim(txtid.Text) & "'", strcnn, adOpenKeyset, adLockBatchOptimistic
        If .RecordCount <= 0 Then
            MsgBox "当前用户在数据库中未找到", , "系统提示"
            Exit Sub
        End If
    End If
    .Fields("用户编号") = Trim(txtid.Text)
    .Fields("姓名") = Trim(txtName.Text)
    .Fields("人口") = Trim(txtOp.Text)
    .Fields("水费类型") = Trim(cmbShui.tag)
    .Fields("电费类型") = Trim(cmbDian.tag)
    .Fields("有效用户") = isEn.Value
    If Trim(txtAddr.Text) <> "" Then .Fields("住址") = Trim(txtAddr.Text)
    If Trim(txtTel.Text) <> "" Then .Fields("电话") = Trim(txtTel.Text)
    If Trim(txtMemo.Text) <> "" Then .Fields("备注") = Trim(txtTel.Text)
End With
If Me.tag = "add" Then
    With rsDianrec
        If .State = adStateOpen Then .Close
        .Open "select top 0 * from 交费记录 ", strcnn, adOpenKeyset, adLockBatchOptimistic
        .AddNew
        .Fields("用户编号") = Trim(txtid.Text)
        .Fields("月份") = Format(Now(), "yymm")
        .Fields("交费金额") = Trim(txtsum.Text)
        .Fields("录入人") = Trim(frmlogin.InOp)
        .Fields("记录类型") = 1
    End With
End If
strcnn.BeginTrans
    rsUserrec.UpdateBatch
   If Me.tag = "add" Then
        rsDianrec.UpdateBatch
        rsDianrec.Close
    End If
    rsUserrec.Close
strcnn.CommitTrans
MsgBox "保存成功!", , "系统提示"
AdoUser.Refresh
Me.tag = "find"
Start False
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
    frm_test_startwidth = Me.width
    frm_test_startheight = Me.height

With strcnn
    If .State = adStateOpen Then .Close
    .Open cnn
End With
With AdoShui
    .ConnectionString = strcnn
    .RecordSource = "SELECT 单价, 收费类型 FROM 收费类型 where 收费类型 like'S%'"
    .Refresh
End With
With Adodian
    .ConnectionString = strcnn
    .RecordSource = "SELECT 单价, 收费类型 FROM 收费类型 where 收费类型 like'd%'"
    .Refresh
End With
With cmbShui
   Set .DataSource = AdoShui
    .SelectCol = 1
    .ShowHeader = True
    .ColResize = True
    .ListColWidth(0) = 1000 '说明
    .ListColWidth(1) = 1000 '单价
    .ListColAlignment(0) = flexAlignLeftCenter
    .ListColAlignment(1) = flexAlignLeftCenter
    .ListRows = 5
    .SearchMode = LinearSearch
    .AutoFind = True
End With
With cmbDian
   Set .DataSource = Adodian
    .SelectCol = 1
    .ShowHeader = True
    .ColResize = True
    .ListColWidth(0) = 1000 '说明
    .ListColWidth(1) = 1000 '单价
    .ListColAlignment(0) = flexAlignLeftCenter
    .ListColAlignment(1) = flexAlignLeftCenter
    .ListRows = 5
    .SearchMode = LinearSearch
    .AutoFind = True
End With
With AdoUser
    .ConnectionString = strcnn
    .RecordSource = "select * from v_用户视图"
    .Refresh
End With
With grdMain
    
Set .DataSource = AdoUser
    .SelectionMode = flexSelectionByRow
        .ColWidth(3) = 2000

End With
Start False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyRight Then keybd_event 9, 0, 0, 0
    If KeyCode = vbKeyLeft Then
        keybd_event 9, 1, 1, 0
            End If
End Sub

Private Function Start(isCanUse As Boolean) 'iscanuse 是真时是初始状态,添加按钮可用
Dim i As Integer
Dim txtcon As Control
For Each txtcon In Me.Controls
    If TypeOf txtcon Is TextBox Then
       If txtcon.Name <> "txtid" Then txtcon.Enabled = isCanUse
        txtcon.Text = ""
    End If
Next
cmbDian.Text = ""
cmbDian.tag = ""
cmbShui.Text = ""
cmbShui.tag = ""
If isCanUse Then
    txtName.SetFocus
    isEn.Value = 1
Else
    isEn.Value = 0
End If
isEn.Enabled = isCanUse
If Trim(Me.tag) = "add" Then
    txtsum.Enabled = True
    txtYf.Enabled = True
Else
    txtsum.Enabled = False
    txtYf.Enabled = False
End If
'Me.left = (MDIme.width - Me.width) / 2
Me.KeyPreview = isCanUse
cmbDian.Enabled = isCanUse
cmbShui.Enabled = isCanUse
cmdAdd.Enabled = Not isCanUse
CmdFind.Enabled = Not isCanUse
CmdModi.Enabled = Not isCanUse
CmdSave.Enabled = isCanUse
CmdExit.Enabled = True
CmdEsc.Enabled = isCanUse
End Function

Private Function Chkgrd(rowi As Integer) As String
Dim sum As Integer
Dim i As Integer
With grdMain
'产品名称
If Trim(txtid.Text) = "" Then '用户编号
    Chkgrd = "用户编号"
    Exit Function
End If
If Trim(txtName.Text) = "" Or Len(Trim(txtName.Text)) > 5 Then '用户姓名
    Chkgrd = "用户姓名"
    Exit Function
End If
If Trim(Me.tag) = "add" Then
    If Not IsNumeric(Trim(txtsum.Text)) Or Val(Trim(txtsum.Text)) < 0 Then '欠费
            Chkgrd = "欠费"
            Exit Function
    End If
    
    If Not IsDate("20" & left(Trim(txtYf.Text), 2) & "-" & Right(Trim(txtYf.Text), 2) & "-01") Or Len(Trim(txtYf.Text)) <> 4 Or Val(left(Trim(txtYf.Text), 2)) < 6 Then  '欠费月份
            Chkgrd = "欠费月份"
            Exit Function
    
    End If
End If
If Not IsNumeric(Trim(txtOp.Text)) Or Trim(txtOp.Text) = "" Then '人口
    Chkgrd = "家庭人口"
    Exit Function
End If

With AdoShui.Recordset
    If Not .BOF Then .MoveFirst
    .Find "收费类型='" & Trim(cmbShui.tag) & "'"
    If Not .BOF And Not .EOF Then
        If Trim(.Fields("单价")) = Trim(cmbShui.Text) Then
            Chkgrd = "ok"
            Exit Function
        Else
            Chkgrd = "ok"
            Exit Function
        End If
    Else
        Chkgrd = "水费单价"
        Exit Function
    End If
End With
With Adodian.Recordset
    If Not .BOF Then .MoveFirst
    .Find "收费类型='" & Trim(cmbDian.tag) & "'"
    If Not .BOF And Not .EOF Then
        If Trim(.Fields("单价")) = Trim(cmbDian.Text) Then
            Chkgrd = "ok"
            Exit Function
        Else
            Chkgrd = "ok"
            Exit Function
        End If
    Else
        Chkgrd = "电费单价"
        Exit Function
    End If
End With
End With
Chkgrd = "ok"
End Function
Private Sub Cmbshui_KeyDown(KeyCode As Integer, Shift As Integer)
    With cmbShui
        If KeyCode <> vbKeyEscape And KeyCode <> vbKeyReturn And KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight Then
                    If Not .IsDropDown Then .BeginDropDown
        End If
    End With
End Sub
Private Sub Cmbdian_KeyDown(KeyCode As Integer, Shift As Integer)
    With cmbDian
        If KeyCode <> vbKeyEscape And KeyCode <> vbKeyReturn And KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight Then
                    If Not .IsDropDown Then .BeginDropDown
        End If
    End With
End Sub
Private Sub Cmbshui_Selected(Value As String)
    With cmbShui
       Dim a()     As String
       a = Split(Value, Chr(9))
        
           If Trim(a(1)) <> "" Then .tag = Trim(a(1))   '编码
           If Trim(a(0)) <> "" Then .Text = Trim(a(0))    '名称
End With

End Sub
Private Sub Cmbdian_Selected(Value As String)
    With cmbDian
       Dim a()     As String
       a = Split(Value, Chr(9))
        
           If Trim(a(1)) <> "" Then .tag = Trim(a(1))   '编码
           If Trim(a(0)) <> "" Then .Text = Trim(a(0))   '名称
End With

End Sub

Private Function UpControl(userid As String, isEnabled As Boolean) As Boolean
Dim rsOp As New ADODB.Recordset
Dim i As Integer
Dim txtcon As Control

UpControl = False

With rsOp
    On Error GoTo err
    If .State = adStateOpen Then .Close
    .Open "select *  from 用户信息  where 用户编号='" & Trim(userid) & "'  ", strcnn, adOpenStatic, adLockReadOnly
    If .RecordCount > 0 Then
        txtid.Text = .Fields("用户编号")
        txtName.Text = .Fields("姓名")
        txtOp.Text = .Fields("人口")
        cmbShui.tag = .Fields("水费类型")
        cmbDian.tag = .Fields("电费类型")
        If Trim(Me.tag) = "add" Then
            txtsum.Text = .Fields("欠费金额")
            txtYf.Text = .Fields("欠费月份")
        End If
        With AdoShui.Recordset
            If Not .BOF Then .MoveFirst
            .Find "收费类型='" & Trim(cmbShui.tag) & "'"
            If Not .BOF And Not .EOF Then
                 cmbShui.Text = Trim(.Fields("单价"))
            End If
        End With
        With Adodian.Recordset
            If Not .BOF Then .MoveFirst
            .Find "收费类型='" & Trim(cmbDian.tag) & "'"
            If Not .BOF And Not .EOF Then
               cmbDian.Text = Trim(.Fields("单价"))
            End If
        End With

        
        
       If .Fields("有效用户") Then
            isEn.Value = 1
        Else
            isEn.Value = 0
        End If
        If Trim(.Fields("住址")) <> "" Then txtAddr.Text = .Fields("住址")
        If Trim(.Fields("电话")) <> "" Then txtTel.Text = .Fields("电话")
        If Trim(.Fields("备注")) <> "" Then txtMemo.Text = .Fields("备注")
    Else
        MsgBox "用户编号录入不正确", , "系统提示"
        If .State = adStateOpen Then .Close
        Exit Function
    End If
    If .State = adStateOpen Then .Close
    
End With
'设置控件可用
For Each txtcon In Me.Controls
    If TypeOf txtcon Is TextBox Then
       If txtcon.Name <> "txtid" Then txtcon.Enabled = isEnabled
       
    End If
Next
If Trim(Me.tag) = "add" Then
    txtsum.Enabled = True
    txtYf.Enabled = True
Else
    txtsum.Enabled = False
    txtYf.Enabled = False
End If
txtid.Enabled = False
cmbDian.Enabled = isEnabled
cmbShui.Enabled = isEnabled

UpControl = True
Exit Function
err:
UpControl = False
End Function

Private Sub grdMain_DblClick()
If Trim(Me.tag) = "add" Or Trim(Me.tag) = "modi" Then Exit Sub
With grdMain
    If .Row > 0 Then
        If Not UpControl(Trim(.TextMatrix(.Row, 1)), False) Then
            MsgBox "用户信息更新失败!", , "系统提示"
            Exit Sub
        End If
    End If
End With
End Sub