frm_shoufei_cj.frm

前些年帮人写的毕业设计

         SubItemIndex    =   9
         Text            =   "水泵公摊"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   10
         Text            =   "水损公摊"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(12) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   11
         Text            =   "其他公摊"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(13) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   12
         Text            =   "应交费用"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(14) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   13
         Text            =   "实交费用"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(15) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   14
         Text            =   "滞纳金"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(16) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   15
         Text            =   "抄表员"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(17) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   16
         Text            =   "抄表日期"
         Object.Width           =   1940
      EndProperty
      BeginProperty ColumnHeader(18) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   17
         Text            =   "收费日期"
         Object.Width           =   1940
      EndProperty
      BeginProperty ColumnHeader(19) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   18
         Text            =   "收款员"
         Object.Width           =   1940
      EndProperty
      BeginProperty ColumnHeader(20) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   19
         Text            =   "id"
         Object.Width           =   0
      EndProperty
   End
End
Attribute VB_Name = "Frm_shoufei_cj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Form_Resize()
    If Me.Height > 1000 Then ListView1.Height = Me.Height - 1000
    If Me.Width > 120 Then ListView1.Width = Me.Width - 120
End Sub

Private Sub ListView1_DblClick()
    If ListView1.ListItems.Count = 0 Then Exit Sub
    If Val(ListView1.SelectedItem.SubItems(12)) + Val(ListView1.SelectedItem.SubItems(14)) <= Val(ListView1.SelectedItem.SubItems(13)) Then
        MsgBox "已收费！", vbExclamation, "提示"
        Exit Sub
    End If
    PrintReport
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "renovate"
            renovate
        Case "query"
            ListView1.ListItems.Clear
            If Text1 = "" Then Exit Sub
            Query
            
        Case "add"
            If ListView1.ListItems.Count = 0 Then Exit Sub
            If Val(ListView1.SelectedItem.SubItems(12)) + Val(ListView1.SelectedItem.SubItems(14)) <= Val(ListView1.SelectedItem.SubItems(13)) Then
                MsgBox "已完成收费！", vbExclamation, "提示"
                Exit Sub
            End If
            Frm_shoufei_ae.Show 1
        Case "print"
            If ListView1.ListItems.Count = 0 Then Exit Sub
            PrintReport

        Case "exit"
            Unload Me
    End Select
    
End Sub

Private Sub Query()
    On Error GoTo myerr
    
    Dim cn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim lt As ListItem
    ListView1.ListItems.Clear
    Set cn = GetCn
     rst.Open "select c.fh,b.xm,a.zgf,a.sbsy,a.sbby,a.sf,a.dbsy,a.dbby,a.df,a.sb,a.ss,a.qt,a.yj,a.sj,a.zn,a.cby,a.cbrq,a.sfrq,a.sky,a.id from (jiaofei a inner join yezhu b  on a.fid=b.fid) inner join fangchan c on b.fid=c.id where c.fh ='" & Trim(Text1) & "' and a.sj=0 order by 1", cn, 0, 1
    If rst.BOF And rst.EOF Then Exit Sub
    Do While Not rst.EOF
        Set lt = ListView1.ListItems.Add(, , rst(0), 8, 8)
        For i = 1 To rst.Fields.Count - 1
            lt.SubItems(i) = Trim(rst(i) & "")
        Next i
        rst.MoveNext
    Loop
    rst.Close
    cn.Close
    Text1 = ""
    Exit Sub
myerr:
    Select Case Err
        Case -2147217904
            If rst.State = 1 Then rst.Close
            rst.Open "select count(*) from jiaofei", cn, 0, 1
            If rst(0) = 0 Then
                Exit Sub
            Else
                MsgBox Error, vbExclamation, "提示"
            End If
        Case Else
            MsgBox Error, vbExclamation, "提示"
    End Select
End Sub

Private Sub PrintReport()
    If Printers.Count = 0 Then
        MsgBox "没有打印机，不能打印！", vbExclamation, "提示"
        Exit Sub
    End If
    Dim cn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim dbfile As String
    Set cn = New ADODB.Connection
    cn.ConnectionTimeout = 180
    cn.CommandTimeout = 180
    
    dbfile = App.Path & "\report\report.mdb"
    cn.CursorLocation = adUseClient
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbfile & "; Persist Security Info=False"
    cn.Open
    
    cn.Execute "delete from jftz"
    rst.Open "select * from jftz", cn, 3, 3
    rst.AddNew
    rst!fh = Trim(ListView1.SelectedItem.Text)
    rst!xm = Trim(ListView1.SelectedItem.SubItems(1))
    rst!zgf = Trim(ListView1.SelectedItem.SubItems(2))
    rst!sbsy = Trim(ListView1.SelectedItem.SubItems(3))
    rst!sbby = Trim(ListView1.SelectedItem.SubItems(4))
    rst!sf = Trim(ListView1.SelectedItem.SubItems(5))
    rst!dbsy = Trim(ListView1.SelectedItem.SubItems(6))
    rst!dbby = Trim(ListView1.SelectedItem.SubItems(7))
    rst!df = Trim(ListView1.SelectedItem.SubItems(8))
    rst!sb = Trim(ListView1.SelectedItem.SubItems(9))
    rst!ss = Trim(ListView1.SelectedItem.SubItems(10))
    rst!qt = Trim(ListView1.SelectedItem.SubItems(11))
    rst!yj = Val(Trim(ListView1.SelectedItem.SubItems(12))) + Val(Trim(ListView1.SelectedItem.SubItems(14)))
    rst!zn = Trim(ListView1.SelectedItem.SubItems(14))
    rst!cby = Trim(ListView1.SelectedItem.SubItems(15))
    rst!cbrq = Trim(ListView1.SelectedItem.SubItems(16))
    rst.Update
    rst.Close
    cn.Close
    CrystalReport1.DataFiles(0) = App.Path & "\Report\report.mdb"
    CrystalReport1.ReportFileName = App.Path & "\Report\cuijiao.rpt"
    CrystalReport1.Destination = crptToWindow
    CrystalReport1.Action = 1
End Sub

Private Sub renovate()
    On Error GoTo myerr
    Text1 = ""
    Dim cn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim lt As ListItem
    ListView1.ListItems.Clear
    Set cn = GetCn
     rst.Open "select c.fh,b.xm,a.zgf,a.sbsy,a.sbby,a.sf,a.dbsy,a.dbby,a.df,a.sb,a.ss,a.qt,a.yj,a.sj,a.zn,a.cby,a.cbrq,a.sfrq,a.sky,a.id from (jiaofei a inner join yezhu b  on a.fid=b.fid) inner join fangchan c on b.fid=c.id where a.sj=0 order by 1", cn, 0, 1
    If rst.BOF And rst.EOF Then Exit Sub
    Do While Not rst.EOF
        Set lt = ListView1.ListItems.Add(, , rst(0), 8, 8)
        For i = 1 To rst.Fields.Count - 1
            lt.SubItems(i) = Trim(rst(i) & "")
        Next i
        rst.MoveNext
    Loop
    rst.Close
    cn.Close
    Exit Sub
myerr:
    Select Case Err
        Case -2147217904
            If rst.State = 1 Then rst.Close
            rst.Open "select count(*) from jiaofei", cn, 0, 1
            If rst(0) = 0 Then
                Exit Sub
            Else
                MsgBox Error, vbExclamation, "提示"
            End If
        Case Else
            MsgBox Error, vbExclamation, "提示"
    End Select
End Sub