frmchildinput.frm

水电费收费管理系统

    If txtFields(2).Text = "" Then
    MsgBox "请输入正确楼号", vbOKOnly + vbInformation
    Exit Sub
    End If
    
     strsql = "select * from user1 where huhao='" & Trim(txtFields(2).Text) & "'"
      myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
      If myset.EOF Then
      MsgBox "该用户不存在", vbOKOnly + vbInformation
      Exit Sub
      End If
      txtFields(0).Text = myset("USERID1")
      myset.Close
    If MsgBox("是否真的删除", vbYesNo + vbQuestion) = vbYes Then
      
      strsql = "select * from user1 where userid1=" & Trim(txtFields(0))
      myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
       If myset.EOF Then
        MsgBox "没有记录可删除", vbOKOnly + vbInformation
          
        
        Else
        strsql = "delete from user1 where userid1=" & txtFields(0)
       config.cnZdx.Execute strsql
        
        strsql = "delete from fee where userid1=" & txtFields(0)
       config.cnZdx.Execute strsql
       
            MDIForm1.tvList.Nodes.Remove "P_" & Trim(txtFields(0))
           txtFields(0) = txtFields(0) - 1
          DISINFORM Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼", Trim(txtFields(0))
         
        End If
        myset.Close
    End If
    Exit Sub
DelRecErr:
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdModify_Click()
     Dim I As Integer
     Dim myset As New ADODB.Recordset
    
    For I = 1 To 4
        txtFields(I).Enabled = True
    Next
    
   cmbBank.Enabled = True
    
    If txtFields(0) = "" Then
      MsgBox "请输入用户楼号！"
       End If
 strsql = "select * from user1 where huhao='" & Trim(txtFields(2).Text) & "'"
      myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If myset.EOF Then
GoTo e:
Else

cmdModify.Enabled = False
    cmdAdd.Enabled = False
    cmdDelete.Enabled = False
    cmdCancel.Enabled = True
    cmdSave.Enabled = True
End If
e:
       
End Sub

Private Sub cmdOK_Click()
   
    
End Sub








Private Sub cmdSave_Click()
 Dim myset As New ADODB.Recordset
Dim myset1 As New ADODB.Recordset
Dim MySet2 As New ADODB.Recordset
 If txtFields(1) = "" Then
        MsgBox "用户名不能为空。", vbOKOnly + vbInformation
        Exit Sub
        End If
        If txtFields(2) = "" Then
        MsgBox "用户号不能为空。", vbOKOnly + vbInformation
        Exit Sub
        End If
        If CHECSTR(txtFields(2).Text) = False Then
        MsgBox "用户号添入格式不对", vbOKOnly + vbInformation
        Exit Sub
        End If
  
   
   strsql = "select * from user1 where userid1=" & Trim(txtFields(0).Text)
    myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    
    If myset.EOF Then
     strsql = "select * from user1 where huhao='" & Trim(txtFields(2).Text) & "'"
    MySet2.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If Not MySet2.EOF Then
    MsgBox "楼号重复，请按规定格式重新输入楼号", vbOKOnly + vbInformation
    Exit Sub
    End If
    MySet2.Close
     If MsgBox("确实增加该记录?", vbOKCancel + vbExclamation) = vbCancel Then

    Exit Sub
   End If
   
    
strsql = "insert into user1(LOUHAOID,userid1,huhao,bankid,name,zhanghaoid,elcmeterfee,watermeterfee,callno) values('"
    strsql = strsql & Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼'," & Trim(txtFields(0).Text) & ",'" & Trim(txtFields(2).Text) & "','" & cmbBank
    strsql = strsql & "','" & Trim(txtFields(1).Text) & "','" & Trim(txtFields(4).Text)
    strsql = strsql & "','" & cmbPrice & "','" & cmbPrice1 & "','" & Trim(txtFields(3).Text) & "')"
    On Error Resume Next
    config.cnZdx.Execute strsql
    
    strsql = "select * from louhao where bmname='" & Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼'"
    myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
      If myset1.EOF Then
    strsql = "insert into louhao(bmname) values('" & Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼')"
    
    config.cnZdx.Execute strsql
    
    End If
   myset1.Close
   Set myset1 = Nothing
   

    MsgBox "新用户档案增加成功", vbOKOnly + vbInformation
     strsql = "select * from louhao where bmname='" & Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼'"
    myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    
     MDIForm1.tvList.Nodes.Add "R_" & myset1("bmid"), _
                           tvwChild, "P_" & _
                           Trim(txtFields(0).Text), " " & _
                            Mid(Trim(txtFields(2).Text), InStr(1, Trim(txtFields(2).Text), "-") + 1) & " " & Trim(txtFields(1).Text), 5
            MDIForm1.tvList.Nodes("P_" & _
                           Trim(txtFields(0).Text)).Tag = txtFields(0).Text
    Text1.Text = Mid(Trim(txtFields(2).Text), InStr(1, Trim(txtFields(2).Text), "-") + 1)
    myset1.Close
      DISINFORM Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼", Trim(txtFields(0))
      'DISINFORM1 DTPicker1.Year, DTPicker1.Month, Val(Trim(txtFields(0).Text))
    
    Else
     If MsgBox("确实修改该记录?", vbOKCancel + vbExclamation) = vbCancel Then

    Exit Sub
    End If
    
    
     strsql = "UPDATE USER1 set huhao='" & _
                    Trim(txtFields(2).Text) & _
                    "',bankid='" & cmbBank & "',name='" & _
                    Trim(txtFields(1).Text) & _
                    "',zhanghaoid='" & Trim(txtFields(4).Text) & _
                    "',elcmeterfee=" & cmbPrice.Text & ",watermeterfee=" & _
                    cmbPrice1.Text & ",callno='" & Trim(txtFields(3).Text) & "'" & _
                    " where userid1=" & Trim(txtFields(0).Text)
          config.cnZdx.Execute strsql
           MsgBox "该用户档案修改成功", vbOKOnly + vbInformation
           
            DISINFORM Mid(Trim(txtFields(2).Text), 1, InStr(1, Trim(txtFields(2).Text), "-") - 1) & "号楼", Trim(txtFields(0))
          'DISINFORM1 DTPicker1.Year, DTPicker1.Month, Val(Trim(txtFields(0).Text))
      End If
      
         
           ' If iOldNod = "P_" & Trim(txtFields(0).Text) Then
'            If iOldNod = UCase("U_") & cmbRTU.ItemData(cmbRTU.ListIndex) & "_" & _
                           Trim(txtFields(0).Text) Then
                MDIForm1.tvList.Nodes("P_" & Trim(txtFields(0).Text)).Text = " " & _
                Mid(Trim(txtFields(2).Text), InStr(1, Trim(txtFields(2).Text), "-") + 1) & " " & Trim(txtFields(1).Text)
            
            
              
    myset.Close
    Set myset = Nothing
    
    cmdAdd.Enabled = True
    cmdModify.Enabled = True
    cmdDelete.Enabled = True
    cmdCancel.Enabled = False
    cmdSave.Enabled = False
      

    
       
       
End Sub

Private Sub DataGrid1_RowColChange(TR As Variant, ByVal LastCol As Integer)


'DisplayContent
'DisplayContent1


End Sub


Private Sub Comdata_Click()
insertdata
End Sub



Private Sub DTPicker1_Change()
DISINFORM1 DTPicker1.Year, DTPicker1.Month, VAL(Trim(txtFields(0).Text))
End Sub

Private Sub Command1_Click()
Text1.Text = Mid(txtFields(2).Text, 1, 3)
End Sub



Private Sub Form_Load()
 
    Fillcomb cmbBank, "select * from bmbank order by bmid", "bmname"
    
    Fillcomb cmbPrice, "select * from bmprice order by bmid", "bmname"
    Fillcomb cmbPrice1, "select * from bmprice1 order by bmid", "bmname"
  
  DTPicker1 = DateSerial(Year(Date), Month(Date), 1)
   
   '
    ' cmbElement.Enabled = False
     cmbBank.Enabled = False

      
      
    cmdSave.Enabled = False
    
   ' cmdDelete.Enabled = OprtRight
   ' cmdModify.Enabled = OprtRight
    cmdCancel.Enabled = OprtRight
    Me.WindowState = 2
End Sub


Private Sub Image2_Click()

End Sub

Private Sub insertdata()
Dim myset As New ADODB.Recordset
Dim myset1 As New ADODB.Recordset

If txtFields(0) = 0 Then
MsgBox "请从用户列表中选择用户", vbOKOnly + vbInformation
Exit Sub
Else


strsql = "select * from datawork where userid1=" & _
         Trim(txtFields(0)) & _
       " and clloyear=" & DTPicker1.Year & " and cllomonth=" & _
                           DTPicker1.Month
    myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    
    If myset.EOF Then
    strsql = "insert into datawork(userid1,louhaoid,huhao,danyuanid,name,clloyear,cllomonth,elcmeterfee,elcmeter,watermeterfee,watermeter) values("
    strsql = strsql & Trim(txtFields(0).Text) & ",'" & cmbElement & "','" & Trim(txtFields(2).Text) & "','" & cmbPrecinct & "','" & Trim(txtFields(1).Text)
    strsql = strsql & "','" & DTPicker1.Year & "','" & DTPicker1.Month & "','" & cmbPrice & "','" & Text2 & "','" & cmbPrice1 & "','" & Text1 & "')"
    On Error Resume Next
    config.cnZdx.Execute strsql
     MsgBox " 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据输入成功！", vbOKOnly + vbInformation
    
   
    Else
    If MsgBox(" 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据已经存在，是否修改？", vbYesNo + vbQuestion) = vbYes Then
    strsql = "update datawork set elcmeter=" & Trim(Text2.Text) & "," & _
    "watermeter = " & Trim(Text1.Text) & " where userid1 = " & Trim(txtFields(0))
    On Error Resume Next
    config.cnZdx.Execute strsql
    MsgBox " 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据修改成功！", vbOKOnly + vbInformation
    End If
    
    End If
 
    
   End If
    
End Sub
Sub DISINFORM(str1 As String, STR2 As Integer)
Dim rst As New ADODB.Recordset
Dim I As Integer
For I = 0 To 4
txtFields(I) = ""
Next
strsql = "select * from USER1 where louhaoid='" & str1 & "' and userid1=" & STR2
 'On Error Resume Next
rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
Exit Sub
GoTo e:
Else

txtFields(0).Text = "" & rst("userid1")
txtFields(1).Text = "" & rst("NAME")
txtFields(2).Text = "" & rst("HUHAO")

txtFields(3).Text = "" & rst("callno")
txtFields(4).Text = "" & rst("zhanghaoid")

'frmChildInput.Text2 = "" & rst("watermeter")
End If

e: rst.Close
Set rst = Nothing





End Sub
Sub DISINFORM1(str1 As Integer, STR2 As Integer, str3 As Integer)
Dim rst As New ADODB.Recordset
Text2 = ""
Text1 = ""
strsql = "select * from datawork where clloyear=" & str1 & " and cllomonth=" & STR2 & " and userid1=" & str3
' On Error Resume Next
rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
Exit Sub
GoTo e:
Else

Text2 = "" & rst("elcmeter")
Text1 = "" & rst("watermeter")
End If
e: rst.Close
Set rst = Nothing
End Sub
Function fiFindFreeID(sTableName As String) As Integer
    Dim I As Long
    Dim myset1 As New ADODB.Recordset
    Dim MySet2 As New ADODB.Recordset
    Dim myset As New ADODB.Recordset
    
    
    strsql = "select max(userid1) from " & sTableName
   myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly

    strsql = "select userid1 from " & sTableName
    myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    
    strsql = "select count(userid1) from " & sTableName
    MySet2.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    
    If myset.EOF Then
        '如果数据库为空 ID 为1
        fiFindFreeID = 1
    ElseIf myset1(0) = MySet2(0) Then
        '如果数据库记录条数和 Max(userid) 相等，则 ID=ID+1
        fiFindFreeID = MySet2(0) + 1
    Else
        I = 1
        myset.MoveFirst
        Do Until myset.EOF
            If I < myset(0) Then
                fiFindFreeID = I
                Exit Function
            Else
                I = I + 1
                myset.MoveNext
            End If
        Loop
    End If
    myset.Close
    myset1.Close
    MySet2.Close
End Function