frmmain.frm

此为水费收费管理系统

                ProgressBar1.Visible = True
                Label1(0).Visible = False
                Label1(1).Visible = False
                DoEvents
                For i = 1 To ListView1.ListItems.Count
                    ProgressBar1.Value = i
                    If ListView1.ListItems(i).Selected Then
                        Rec.Bookmark = Val(Right(ListView1.ListItems(i).Key, _
                            Len(ListView1.ListItems(i).Key) - 1))
                        Cn_Rsh.Execute "update lqwater set havemoney=' '" & _
                            " where id=" & Rec.Fields("id").Value & " and [year]=" & _
                            EdType.Year & " and [month]=" & EdType.Month
                        ListView1.ListItems(i).SubItems(7) = " "
                    End If
                Next i
                ProgressBar1.Visible = False
                Label1(0).Visible = True
                Label1(1).Visible = True
            ElseIf Option1(1).Value Then    '卫生费
                ProgressBar1.Max = ListView1.ListItems.Count
                ProgressBar1.Min = 0
                ProgressBar1.Value = 0
                ProgressBar1.Visible = True
                Label1(0).Visible = False
                Label1(1).Visible = False
                DoEvents
                For i = 1 To ListView1.ListItems.Count
                    ProgressBar1.Value = i
                    If ListView1.ListItems(i).Selected Then
                        Rec.Bookmark = Val(Right(ListView1.ListItems(i).Key, _
                            Len(ListView1.ListItems(i).Key) - 1))
                        Cn_Rsh.Execute "update lqsanitation set havemoney=' '" & _
                            " where id=" & Rec.Fields("id").Value & " and [year]=" & _
                             EdType.Year
                        ListView1.ListItems(i).SubItems(4) = " "
                    End If
                Next i
                ProgressBar1.Visible = False
                Label1(0).Visible = True
                Label1(1).Visible = True
            End If
        Case "TbrPnt"       '打印数据
            Call PntSelectData
    End Select
End Sub

''''FieldStr：数据表中对应字段的值
''''InYear：要进行操作的时间：年份
''''InMonth：要进行操作的时间：月份
''''InOrOut：操作方向：0 表示删除      1 表示添加
''''TmpStr：返回的字符串，利用《ByRef》类型进行处理
''''================================================================================================================
'''Private Function HaveOrNot(ByVal FieldStr As String, _
'''                           ByVal InYear As String, _
'''                           ByVal InMonth As String, _
'''                           ByVal InOrOut As Integer, _
'''                           ByRef TmpStr As String) As Boolean
'''    HaveOrNot = False
'''    FieldStr = Trim(FieldStr)
'''    If Val(InMonth) = 0 Then
'''        InYear = Trim(InYear)
'''    Else
'''        InYear = Trim(InYear) & "年" & Trim(InMonth) & "月"
'''    End If
'''    TmpStr = ""
'''    Dim j As Integer
'''    j = InStr(FieldStr, InYear)
'''
'''    If InOrOut = 0 Then     '0：表示删除时间
'''        If j = 0 Then Exit Function
'''        TmpStr = Left(FieldStr, j - 1) & _
'''            Mid(FieldStr, j + Len(InYear) + 1, Len(FieldStr) - j - Len(InYear) + 1)
'''    Else                    '其它：表示添加时间
'''        If j <> 0 Then Exit Function
'''        TmpStr = FieldStr & "," & InYear
'''    End If
'''
'''    '删除返回字符串首尾的多余“,”
'''    '删除串首
'''    For j = 1 To Len(TmpStr)
'''        If Left(TmpStr, 1) = "," Then
'''            TmpStr = Right(TmpStr, Len(TmpStr) - 1)
'''        Else
'''            Exit For
'''        End If
'''    Next j
'''    '删除串尾
'''    For j = 1 To Len(TmpStr)
'''        If Right(TmpStr, 1) = "," Then
'''            TmpStr = Left(TmpStr, Len(TmpStr) - 1)
'''        Else
'''            Exit For
'''        End If
'''    Next j
'''
'''    HaveOrNot = True
'''End Function
''''================================================================================================================
'''
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    On Error Resume Next
    If ListView1.ListItems.Count = 0 Then Exit Sub
    ListView1.ListItems(ListView1.Tag).SmallIcon = 5
    ListView1.SelectedItem.SmallIcon = 2
    ListView1.Tag = ListView1.SelectedItem.Key
    
    Rec.Bookmark = Val(Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1))
End Sub

Private Sub Init_ListView1(Optional ByVal FindData As Boolean = False)
    ListView1.ListItems.Clear
    ListView1.ColumnHeaders.Clear
    If Rec.State = 1 Then Set Rec = Nothing
    Rec.CursorLocation = adUseClient
    
    If Option1(0).Value Then        '查询自来水费资料
        ListView1.ColumnHeaders.Add , , "号数", 700
        ListView1.ColumnHeaders.Add , , "户名", 1200
        ListView1.ColumnHeaders.Add , , "上期度数", 1000
        ListView1.ColumnHeaders.Add , , "本期度数", 1000
        ListView1.ColumnHeaders.Add , , "实用度数", 1000
        ListView1.ColumnHeaders.Add , , "单价元", 800
        ListView1.ColumnHeaders.Add , , "金额", 900
        ListView1.ColumnHeaders.Add , , "已收费否", 1200
        If FindData Then    '查找数据
            Rec.Open "select lqryk.*,nam1.ycount,nam1.ncount,nam1.dj,nam1.money,nam1.havemoney from " & _
                "lqryk left join (select * from " & "lqwater where lqwater.year=" & _
                EdType.Year & " and lqwater.month=" & EdType.Month & ") as nam1 " & _
                "on lqryk.id=nam1.id where lqryk.name like '%" & Trim(Text1.Text) & _
                "%' order by lqryk.hsh", Cn_Rsh, adOpenDynamic, adLockOptimistic
        Else    '一般浏览
            Rec.Open "select lqryk.*,nam1.ycount,nam1.ncount,nam1.dj,nam1.money ,nam1.havemoney from " & _
                "lqryk left join (select * from " & "lqwater where lqwater.year=" & _
                EdType.Year & " and lqwater.month=" & EdType.Month & ") as nam1 " & _
                "on lqryk.id=nam1.id order by lqryk.hsh", Cn_Rsh, adOpenDynamic, _
                adLockOptimistic
        End If
    ElseIf Option1(1).Value Then    '查询卫生费资料
        ListView1.ColumnHeaders.Add , , "号数", 700
        ListView1.ColumnHeaders.Add , , "户名", 1400
        ListView1.ColumnHeaders.Add , , "长度", 1100
        ListView1.ColumnHeaders.Add , , "金额", 1200
        ListView1.ColumnHeaders.Add , , "已收费否", 1200
        If FindData Then    '查找数据
            Rec.Open "select lqryk.*,nam1.money ,nam1.havemoney from lqryk left join (select * from " & _
                "lqsanitation where lqsanitation.year=" & EdType.Year & ") as nam1 " & _
                "on lqryk.id=nam1.id where lqryk.name like '%" & Trim(Text1.Text) & _
                "%' order by lqryk.hsh", Cn_Rsh, adOpenDynamic, adLockOptimistic
        Else    '一般浏览
            Rec.Open "select lqryk.*,nam1.money,nam1.havemoney from lqryk left join (select * from " & _
                "lqsanitation where lqsanitation.year=" & EdType.Year & ") as nam1 " & _
                "on lqryk.id=nam1.id order by lqryk.hsh", Cn_Rsh, adOpenDynamic, _
                adLockOptimistic
        End If
    ElseIf Option1(2).Value Then    '显示户主资料
        ListView1.ColumnHeaders.Add , , "号数", 700
        ListView1.ColumnHeaders.Add , , "业户名", 1200
        ListView1.ColumnHeaders.Add , , "户名", 2000
        ListView1.ColumnHeaders.Add , , "账号", 2200
        ListView1.ColumnHeaders.Add , , "电话", 1800
        If FindData Then    '查找数据
            Rec.Open "select * from lqryk  where lqryk.name like '%" & Trim(Text1.Text) & _
                "%' order by hsh", Cn_Rsh, adOpenDynamic, adLockOptimistic
        Else    '一般浏览
            Rec.Open "select * from lqryk order by hsh", Cn_Rsh, adOpenDynamic, _
                adLockOptimistic
        End If
    End If
    DoEvents
    
    
    ProgressBar1.Max = IIf(Rec.RecordCount = 0, 1, Rec.RecordCount)
    ProgressBar1.Min = 0
    ProgressBar1.Value = 0
    ProgressBar1.Visible = True
    Label1(0).Visible = False
    Label1(1).Visible = False
    DoEvents
    
    If Not Rec.EOF And Not Rec.BOF Then
        If Option1(0).Value Then        '查询自来水费资料
            Do While Not Rec.EOF
                ProgressBar1.Value = Rec.AbsolutePosition
                ListView1.ListItems.Add , "r" & Rec.Bookmark, Rec.Fields("hsh").Value, 5, 5
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(1) = Rec.Fields("name").Value
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(2) = _
                    IIf(IsNull(Rec.Fields("ycount").Value) Or Rec.Fields("ycount").Value = 0, " ", Rec.Fields("ycount").Value)
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(3) = _
                    IIf(IsNull(Rec.Fields("ncount").Value) Or Rec.Fields("ncount").Value = 0, " ", Rec.Fields("ncount").Value)
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(4) = _
                    IIf(IsNull(Rec.Fields("ycount").Value), _
                        IIf(IsNull(Rec.Fields("ncount").Value), " ", _
                            Rec.Fields("ncount").Value), _
                        IIf(IsNull(Rec.Fields("ncount").Value), " ", _
                            IIf(Rec.Fields("ncount").Value = 0, " ", Rec.Fields("ncount").Value - Rec.Fields("ycount").Value)))
                            
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(5) = _
                    IIf(IsNull(Rec.Fields("dj").Value) Or Rec.Fields("dj").Value = 0, " ", Rec.Fields("dj").Value)
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(6) = _
                    IIf(IsNull(Rec.Fields("money").Value) Or Rec.Fields("money").Value = 0, " ", Rec.Fields("money").Value)
                
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(7) = _
                    IIf(IsNull(Rec.Fields("havemoney").Value), " ", Rec.Fields("havemoney").Value)
                Rec.MoveNext
            Loop
        ElseIf Option1(1).Value Then    '查询卫生费资料
            Do While Not Rec.EOF
                ProgressBar1.Value = Rec.AbsolutePosition
                ListView1.ListItems.Add , "r" & Rec.Bookmark, Rec.Fields("hsh").Value, 5, 5
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(1) = Rec.Fields("name").Value
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(2) = IIf(Rec.Fields("length").Value = 0, " ", Rec.Fields("length").Value)
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(3) = IIf(IsNull(Rec.Fields("money").Value), " ", Rec.Fields("money").Value)
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(4) = _
                    IIf(IsNull(Rec.Fields("havemoney").Value), " ", Rec.Fields("havemoney").Value)

                Rec.MoveNext
            Loop
        ElseIf Option1(2).Value Then    '显示户主资料
            Do While Not Rec.EOF
                ProgressBar1.Value = Rec.AbsolutePosition
                ListView1.ListItems.Add , "r" & Rec.Bookmark, Rec.Fields("hsh").Value, 5, 5
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(1) = Rec.Fields("yname").Value
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(2) = Rec.Fields("name").Value
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(3) = Rec.Fields("pid").Value
                ListView1.ListItems("r" & Rec.Bookmark).SubItems(4) = Rec.Fields("phone").Value
'                ListView1.ListItems("r" & Rec.Bookmark).SubItems(5) = Rec.Fields("water").Value
'                ListView1.ListItems("r" & Rec.Bookmark).SubItems(6) = Rec.Fields("sanitation").Value
                Rec.MoveNext
            Loop
        End If
    End If
    ProgressBar1.Visible = False
    Label1(0).Visible = True
    Label1(1).Visible = True
    DoEvents
    
    If ListView1.ListItems.Count <> 0 Then
        ListView1.ListItems(1).Selected = True
        ListView1.Tag = ListView1.SelectedItem.Key
        Call ListView1_ItemClick(ListView1.SelectedItem)
    End If
    StatusBar1.Panels("panel3").Text = "共有记录：" & ListView1.ListItems.Count & "条"
End Sub

Private Sub PntSelectData()
    MdlMain.PntType.PntOrNot = False
    MdlMain.PntType.XlsOrNot = False
    MdlMain.PntType.OneOrMore = False
    MdlMain.PntType.TypeOfPnt = -1
    
    If Option1(0).Value Or Option1(1).Value Then    '水费、卫生费
        FrmPntGl.Option1(0).Enabled = True
        FrmPntGl.Option1(1).Enabled = True
        FrmPntGl.Command1(3).Enabled = True
    ElseIf Option1(2).Value Then    '户主资料
        FrmPntGl.Option1(0).Enabled = False
        FrmPntGl.Option1(1).Enabled = False
        FrmPntGl.Command1(3).Enabled = False
        FrmPntGl.Command1(4).Enabled = False
    End If
    FrmPntGl.Show vbModal
    DoEvents
    
    'mdlmain.PntType.PntOrNot = False 表示不打印，直接退出子程序
    If MdlMain.PntType.PntOrNot = False Or MdlMain.PntType.TypeOfPnt = -1 Then Exit Sub
    
    '********************************进行打印********************************
    
    '根据条件选择打印结果，并将结果存放在结构体数组变量：DataList() 中
    '========================================================================================================================
        Dim Rec1 As New ADODB.Recordset
        Dim DataList() As DataList_Struct
        Dim SumData As Double
        
        ReDim DataList(0)
        SumData = 0
        
        If MdlMain.PntType.OneOrMore = False Then   '多用户打印
            Select Case MdlMain.PntType.TypeOfPnt
                Case 2  '按列表打印
                    If Option1(0).Value Then    '水费打印
                        For i = 1 To ListView1.ListItems.Count
                            Rec.Bookmark = Val(Right(ListView1.ListItems(i).Key, Len(ListView1.ListItems(i).Key) - 1))
                            
                            DataList(UBound(DataList)).Hsh = IdLengthSet(ListView1.ListItems(i).Text, 3)
                            DataList(UBound(DataList)).Name1 = ListView1.ListItems(i).SubItems(1)
                            DataList(UBound(DataList)).Pid = Rec.Fields("pid").Value
                            DataList(UBound(DataList)).Money1 = Val(ListView1.ListItems(i).SubItems(6))
                            
                            SumData = SumData + DataList(UBound(DataList)).Money1
                            ReDim Preserve DataList(UBound(DataList) + 1)
                        Next i
                    ElseIf Option1(1).Value Then    '卫生费打印
                        For i = 1 To ListView1.ListItems.Count
                            Rec.Bookmark = Val(Right(ListView1.ListItems(i).Key, Len(ListView1.ListItems(i).Key) - 1))
                            
                            DataList(UBound(DataList)).Hsh = IdLengthSet(ListView1.ListItems(i).Text, 3)
                            DataList(UBound(DataList)).Name1 = ListView1.ListItems(i).SubItems(1)
                            DataList(UBound(DataList)).Pid = Rec.Fields("pid").Value
                            DataList(UBound(DataList)).Money1 = Val(ListView1.ListItems(i).SubItems(3))