frmmain.frm

此为水费收费管理系统

            Flash = True
            FrmFlash.Show vbModal
        Case "与我们联系(&L)."
            ShellExecute 0&, vbNullString, "mailto:[e-mail]?subject=来自水费卫生费管理系统的电子邮件！", _
                vbNullString, vbNullString, 0
    End Select
End Sub

Private Sub Option1_Click(Index As Integer)
    ListView1.ListItems.Clear
    ListView1.ColumnHeaders.Clear
    EdType.Year = 0
    EdType.Month = 0
    Select Case Index
        Case 0  '自来水费
            Command1.Visible = True
            Frame2(0).Visible = True
            Frame2(1).Visible = False
            
            Toolbar1.Buttons("TbrAdd").Enabled = False
            Toolbar1.Buttons("TbrChange").Enabled = False
            Toolbar1.Buttons("TbrDel").Enabled = False
            Toolbar1.Buttons("TbrRefresh").Enabled = False
            Toolbar1.Buttons("TbrHave").Enabled = True
            Toolbar1.Buttons("TbrNot").Enabled = True
            Toolbar1.Buttons("TbrDj").Enabled = True
            Toolbar1.Buttons("TbrLast").Enabled = True
            Toolbar1.Buttons("TbrPnt").Enabled = False
            m_Menu(3).SubMenu(1).Enabled = False
            m_Menu(3).SubMenu(2).Enabled = False
            m_Menu(3).SubMenu(3).Enabled = False
            Command2.Enabled = False
            
            Label1(0).Caption = "" ' "当前列表显示：" & Combo1(0).Text & "年" & Combo1(1).Text & _
                "月份自来水费收费情况"
            Label1(1).Caption = "" '"当前列表显示：" & Combo1(0).Text & "年" & Combo1(1).Text & _
                "月份自来水费收费情况"
        Case 1  '卫生费
            Command1.Visible = True
            Frame2(0).Visible = False
            Frame2(1).Visible = True
            
            Toolbar1.Buttons("TbrAdd").Enabled = False
            Toolbar1.Buttons("TbrChange").Enabled = False
            Toolbar1.Buttons("TbrDel").Enabled = False
            Toolbar1.Buttons("TbrRefresh").Enabled = False
            Toolbar1.Buttons("TbrHave").Enabled = True
            Toolbar1.Buttons("TbrNot").Enabled = True
            Toolbar1.Buttons("TbrDj").Enabled = False
            Toolbar1.Buttons("TbrLast").Enabled = False
            Toolbar1.Buttons("TbrPnt").Enabled = False
            m_Menu(3).SubMenu(1).Enabled = False
            m_Menu(3).SubMenu(2).Enabled = False
            m_Menu(3).SubMenu(3).Enabled = False
            Command2.Enabled = False
            
            Label1(0).Caption = "" ' "当前列表显示：" & Combo2.Text & "年卫生费收费情况"
            Label1(1).Caption = "" ' "当前列表显示：" & Combo2.Text & "年卫生费收费情况"
        Case 2  '查询户主资料
            Command1.Visible = False
            Frame2(0).Visible = False
            Frame2(1).Visible = False
            
            Toolbar1.Buttons("TbrAdd").Enabled = True
            Toolbar1.Buttons("TbrChange").Enabled = True
            Toolbar1.Buttons("TbrDel").Enabled = True
            Toolbar1.Buttons("TbrRefresh").Enabled = True
            Toolbar1.Buttons("TbrHave").Enabled = False
            Toolbar1.Buttons("TbrNot").Enabled = False
            Toolbar1.Buttons("TbrDj").Enabled = False
            Toolbar1.Buttons("TbrLast").Enabled = False
            Toolbar1.Buttons("TbrPnt").Enabled = True
            m_Menu(3).SubMenu(1).Enabled = True
            m_Menu(3).SubMenu(2).Enabled = True
            m_Menu(3).SubMenu(3).Enabled = True
            Command2.Enabled = True
            
            Label1(0).Caption = "当前列表显示：所有户主资料"
            Label1(1).Caption = "当前列表显示：所有户主资料"
            Call Init_ListView1
    End Select
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "TbrExit"
            Unload Me
        
        Case "TbrBeiFen"
            FrmBackUp.Show vbModal
        Case "TbrHuanYuan"
            FrmRestore.Show vbModal
            
        Case "TbrPassword"
            FrmPwdGl.Show vbModal
            
        Case "TbrRefresh"   '刷新数据
            Call Init_ListView1
        
        Case "TbrAdd"       '增加
            FrmDataAdd.Command1(1).Enabled = True
            FrmDataAdd.Command1(2).Enabled = False
            FrmDataAdd.Command1(1).Default = True
            FrmDataAdd.Caption = "增加户主..."
            FrmDataAdd.Show vbModal
            If MdlMain.ReturnSql = "已增加" Then
                Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrRefresh"))
            End If
        Case "TbrChange"    '修改
            On Error GoTo Er1
            If ListView1.ListItems.Count = 0 Then Exit Sub
            Rec.Bookmark = Val(Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1))
            
            With Rec
                FrmDataAdd.Text1(0).Text = .Fields("hsh").Value
                FrmDataAdd.Text1(1).Text = IIf(Len(Trim(.Fields("yname").Value)) = 0, " ", .Fields("yname").Value)
                FrmDataAdd.Text1(2).Text = Trim(.Fields("name").Value)
                FrmDataAdd.Text1(3).Text = IIf(Trim(.Fields("pid").Value) = "", " ", .Fields("pid").Value)
                FrmDataAdd.Text1(4).Text = IIf(Trim(.Fields("phone").Value) = "", " ", .Fields("phone").Value)
                FrmDataAdd.Text1(5).Text = .Fields("length").Value
            End With
            MdlMain.ReturnSql = Rec.Fields("hsh").Value
            FrmDataAdd.Command1(1).Enabled = False
            FrmDataAdd.Command1(2).Default = True
            FrmDataAdd.Command1(2).Enabled = True
            FrmDataAdd.Caption = "修改户主资料..."
            FrmDataAdd.Show vbModal
            If MdlMain.ReturnSql = "已保存" Then
                ListView1.SelectedItem.Text = Rec.Fields("hsh").Value
                ListView1.SelectedItem.SubItems(1) = Rec.Fields("yname").Value
                ListView1.SelectedItem.SubItems(2) = Rec.Fields("name").Value
                ListView1.SelectedItem.SubItems(3) = Rec.Fields("pid").Value
                ListView1.SelectedItem.SubItems(4) = Rec.Fields("phone").Value
            End If
            Exit Sub
Er1:
            If Err.Number = 3704 Then
                Exit Sub
            Else
                MsgBox Err.Number & " : " & Err.Description
            End If
        Case "TbrDel"       '删除
            If ListView1.ListItems.Count = 0 Then Exit Sub
            If MsgBox("真的要删除选定的数据吗？", vbOKCancel + vbExclamation, "删除确认...") = vbCancel Then Exit Sub
            Cn_Rsh.BeginTrans
            Dim TmpStr() As String
            ReDim TmpStr(0)
            Dim TmpHsh() As String
            ReDim TmpHsh(0)
            
            For i = 1 To ListView1.ListItems.Count
                If ListView1.ListItems(i).Selected = True Then
                    Cn_Rsh.Execute "delete from lqryk where hsh=" & Val(ListView1.ListItems(i).Text)
                    TmpStr(UBound(TmpStr)) = ListView1.ListItems(i).Key
                    ReDim Preserve TmpStr(UBound(TmpStr) + 1)
                    
                    TmpHsh(UBound(TmpHsh)) = Val(ListView1.ListItems(i).Text)
                    ReDim Preserve TmpHsh(UBound(TmpHsh) + 1)
                End If
            Next i
            For i = 0 To UBound(TmpHsh) - 1
                Cn_Rsh.Execute "update lqryk set hsh=hsh-1 where hsh>" & TmpHsh(i)
            Next i
            
            Cn_Rsh.CommitTrans
            For i = 0 To UBound(TmpStr) - 1
                ListView1.ListItems.Remove TmpStr(i)
            Next i
            StatusBar1.Panels("panel3").Text = "共有记录：" & ListView1.ListItems.Count & "条"
        Case "TbrDj"    '修改水费单价
            If ListView1.ListItems.Count = 0 Then Exit Sub
            If Option1(0).Value Then
                MdlMain.ReturnSql = ""
                FrmWaterDj.nYear = EdType.Year
                FrmWaterDj.nMonth = EdType.Month
                FrmWaterDj.Label2.Caption = "修改：" & EdType.Year & "年" & EdType.Month & "月的水费单价"
                FrmWaterDj.Show vbModal
                If MdlMain.ReturnSql = "单价修改成功" Then Call Init_ListView1
            End If
        Case "TbrLast"  '取上期度数
            If ListView1.ListItems.Count = 0 Then Exit Sub
            Dim lMonth As Integer
            Dim lYear As Integer
            Dim HowMonth As String
            Dim HowYear As Integer
            
            HowMonth = Trim(InputBox("请输入“上期”是几个月之前：", "上期数录入...", 1))
            If Not IsNumeric(HowMonth) Or Val(HowMonth) = 0 Then
                MsgBox "    输入内容：" & HowMonth & " 只能是不为0的数字，" & vbCrLf & vbCrLf & "请重新输入不为0的数字为期数...", _
                    vbOKOnly + vbCritical, "输入上期数类型出错"
                Exit Sub
            End If
            
            '根据输入的月份个数进行上期月份计算的算法
            '================================================================================================
                HowYear = HowMonth \ 12
                HowMonth = HowMonth Mod 12
                If EdType.Month <= HowMonth Then
                    HowYear = HowYear + 1
                    lMonth = 12 - (HowMonth - EdType.Month)
                Else
                    lMonth = EdType.Month - HowMonth
                End If
                lYear = EdType.Year - HowYear
            '================================================================================================
            If MsgBox("上期月份为：" & lYear & "年" & lMonth & "月" & vbCrLf & vbCrLf & _
                "    确定：上期月份正确，进行更新..." & vbCrLf & vbCrLf & "    取消：上期月份错误，退出...", _
                vbOKCancel + vbExclamation, "上期月份确认") = vbCancel Then Exit Sub
            
            Dim Rs As New ADODB.Recordset
            
            ProgressBar1.Max = ListView1.ListItems.Count * 2
            ProgressBar1.Min = 0
            ProgressBar1.Value = 0
            ProgressBar1.Visible = True
            Label1(0).Visible = False
            Label1(1).Visible = False
            DoEvents
            Dim j As Integer
            j = 1
            '更新本月份的户主资料
            Set Rs = Cn_Rsh.Execute("select * from lqryk where id not in (select id from " & _
                "lqwater where year=" & EdType.Year & " and month=" & EdType.Month & ")")
            If Not Rs.EOF And Not Rs.BOF Then
                Do While Not Rs.EOF
                    ProgressBar1.Value = ProgressBar1.Value + j
                    Cn_Rsh.Execute "insert into lqwater([id],[ycount],[ncount],[dj],[money]," & _
                        "[year],[month],havemoney) values(" & Rs.Fields("id").Value & ",0,0,0,0," & _
                        EdType.Year & "," & EdType.Month & ",' ')"
                    Rs.MoveNext
                Loop
            End If
            
            '从上一月份中取数据更新本月份的上期度数和单价
            Set Rs = Cn_Rsh.Execute("select * from lqwater where " & _
                "[year]=" & lYear & " and [month]=" & lMonth)
            If Not Rs.EOF And Not Rs.BOF Then
                Do While Not Rs.EOF
                    ProgressBar1.Value = ProgressBar1.Value + j
                    Cn_Rsh.Execute "update lqwater set ycount=" & Rs.Fields("ncount").Value & _
                        ",dj=" & Rs.Fields("dj").Value & " where [year]=" & EdType.Year & _
                        " and [month]=" & EdType.Month & " and id=" & Rs.Fields("id").Value
                    Rs.MoveNext
                Loop
            End If
            Rs.Close: Set Rs = Nothing
            ProgressBar1.Visible = False
            Label1(0).Visible = True
            Label1(1).Visible = True
            Call Init_ListView1
        Case "TbrHave"  '已付费设置
            If ListView1.ListItems.Count = 0 Then Exit Sub
            If Option1(0).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 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 "TbrNot"   '未付费设置
            If ListView1.ListItems.Count = 0 Then Exit Sub
            If Option1(0).Value Then        '水费
                ProgressBar1.Max = ListView1.ListItems.Count
                ProgressBar1.Min = 0
                ProgressBar1.Value = 0