frmmain.frm

这是一套农村电费计算程序的源码。能够对用户电费进行计算、查询、打印。

                string1(7) = ""
           End If
        Wend
    Else
        ab = MsgBox("    请选定单位名称中的村名    ", vbOKOnly + 32, "提示")
  End If
End Sub

Private Sub mnu23_Click()
    xgdj.Show 1
End Sub

Private Sub mnu24_Click()
    If prg2 = 4 Then
            boolean1(1) = False
            string1(1) = lvListView.SelectedItem.SubItems(1)
            string1(2) = tvTreeView.SelectedItem.Text
            string1(3) = lvListView.SelectedItem.SubItems(2)
            string1(4) = lvListView.SelectedItem.Text
            string1(5) = lvListView.SelectedItem.SubItems(3)
            string1(6) = lvListView.SelectedItem.SubItems(4)
            string1(7) = lvListView.SelectedItem.SubItems(11)
            'string1(8) = lvListView.SelectedItem.SubItems(12)
            string1(8) = lvListView.SelectedItem.Index
            xguser.Show 1
            If boolean1(1) = True Then
                lvListView.SelectedItem.Text = string1(1)
                lvListView.SelectedItem.SubItems(3) = string1(2)
                lvListView.SelectedItem.SubItems(11) = string1(3)
            End If
            Erase string1
            Erase boolean1
        Else
            ab = MsgBox("    请选定有效的用户    ", vbOKOnly + 32, "提示")
    End If
End Sub

Private Sub mnu25_Click()
    If prg2 = 4 Then
            hm = lvListView.SelectedItem.Text
            string1(1) = lvListView.SelectedItem.SubItems(1)
            string1(2) = lvListView.SelectedItem.SubItems(2)
            ab = MsgBox(hm + "   用户真的消户吗，消户后无法恢复，请确认！", vbYesNo + 48, "提示")
            If ab = 6 Then
                sj.Execute "delete from bk where byqh='" + string1(1) + "' and hh='" + string1(2) + "';"
                lvListView.ListItems.Remove (lvListView.SelectedItem.Index)
                Erase string1
            End If
        Else
            ab = MsgBox("    请选定有效的用户    ", vbOKOnly + 32, "提示")
    End If

End Sub

Private Sub mnu26_Click()
    tzdj.Show 1
End Sub

Private Sub mnu29_Click()
    'If lvListView.ListItems.Count <> 0 Then
    '    af = tvTreeView.SelectedItem.Key
    'End If
    'MsgBox tvTreeView.Nodes.Count & "," & lvListView.ListItems.Count
    'ab = MsgBox(prg1 & "" & prg2)
    
    If prg2 = 4 Then
            boolean1(1) = False
            string1(1) = lvListView.SelectedItem.SubItems(1)
            string1(2) = tvTreeView.SelectedItem.Text
            string1(3) = lvListView.SelectedItem.SubItems(2)
            string1(4) = lvListView.SelectedItem.SubItems(9)
            string1(5) = lvListView.SelectedItem.SubItems(4)
            string1(6) = lvListView.SelectedItem.SubItems(12)
            string1(7) = lvListView.SelectedItem.SubItems(8)
            string1(8) = lvListView.SelectedItem.SubItems(7)
            string1(9) = lvListView.SelectedItem.SubItems(3)
            lhbfrm.Show 1
            If boolean1(1) = True Then
                lvListView.SelectedItem.SubItems(8) = string1(1)
                If string1(1) <> "" Then
                        lvListView.SelectedItem.SubItems(12) = string1(2)
                    Else
                        lvListView.SelectedItem.SubItems(12) = ""
                End If
                lvListView.SelectedItem.SubItems(7) = string1(4)
                lvListView.SelectedItem.SubItems(8) = string1(5)
                lvListView.SelectedItem.SubItems(3) = string1(6)
                
            End If
            Erase string1
            Erase boolean1
        Else
            ab = MsgBox("    请选定有效的用户    ", vbOKOnly + 32, "提示")
    End If
End Sub

Private Sub mnu31_Click()
'ab = tvTreeView_NodeClick(tvTreeView.Nodes(tvTreeView.SelectedItem.Index))
End Sub

Private Sub mnu32_Click()
    If (prg1 = 3 And prg2 = 4) Or prg1 = 2 Then
            string1(1) = tvTreeView.SelectedItem.Text  '村名
            string1(2) = lvListView.SelectedItem.SubItems(1) '配变编号
            string1(3) = prg1
            If prg1 = 2 Then
                string1(4) = Mid(tvTreeView.SelectedItem.Key, 4) '单位编号
            End If
            boolean1(1) = False
            dyfp.Show 1
            Erase string1
            Erase boolean1
        Else
            ab = MsgBox("    请选定配变    ", vbOKOnly + 16, "提示")
    End If

End Sub

Private Sub mnu33_Click()
    MsgBox Mid(tvTreeView.SelectedItem.Parent.Key, 4)
End Sub

Private Sub mnu34_Click()
    If (prg1 = 3 And prg2 = 4) Or prg1 = 2 Then
            string1(1) = tvTreeView.SelectedItem.Text  '村名
            string1(2) = lvListView.SelectedItem.SubItems(1) '配变编号
            string1(12) = tvTreeView.SelectedItem.Text
            string1(13) = prg1
            If prg1 = 2 Then
                string1(14) = Mid(tvTreeView.SelectedItem.Key, 4)
            End If
            boolean1(1) = False
            dfjs.Show 1
            
            If boolean1(1) = True And prg1 <> 2 Then
                add (string1(2))
            End If
        Else
            ab = MsgBox("    请选定配变    ", vbOKOnly + 16, "提示")
    End If
End Sub

Private Sub mnu35_Click()
    lvListView.View = lvwIcon
    mnu35.Checked = True
    mnu36.Checked = False
    mnu37.Checked = False
    mnu38.Checked = False
    tbToolBar.Buttons(1).Value = tbrPressed
End Sub

Private Sub mnu36_Click()
    lvListView.View = lvwSmallIcon
    mnu35.Checked = False
    mnu36.Checked = True
    mnu37.Checked = False
    mnu38.Checked = False
    tbToolBar.Buttons(2).Value = tbrPressed
End Sub

Private Sub mnu37_Click()
    lvListView.View = lvwList
    mnu35.Checked = False
    mnu36.Checked = False
    mnu37.Checked = True
    mnu38.Checked = False
    tbToolBar.Buttons(3).Value = tbrPressed
End Sub

Private Sub mnu38_Click()
    lvListView.View = lvwReport
    mnu35.Checked = False
    mnu36.Checked = False
    mnu37.Checked = False
    mnu38.Checked = True
    tbToolBar.Buttons(4).Value = tbrPressed
End Sub

Private Sub mnu39_Click()
    If prg2 = 4 Then
        
    End If
End Sub

Private Sub mnu41_Click()
    kyfrm.Show 1
End Sub

Private Sub mnu52_Click()
frmSplash.Show 1
End Sub

Private Sub mnusrbm_Click()
If prg1 = 3 Then
       'string1(1) = lvListView.SelectedItem.SubItems(1)
       ' string1(2) = tvTreeView.SelectedItem.Text
       ' string1(3) = lvListView.SelectedItem.SubItems(2)
       ' string1(4) = lvListView.SelectedItem.SubItems(9)
       ' string1(5) = lvListView.SelectedItem.SubItems(4)
       ' string1(6) = lvListView.SelectedItem.SubItems(12)
       ' string1(7) = lvListView.SelectedItem.SubItems(8)
       ' string1(8) = lvListView.SelectedItem.SubItems(7)
      '  string1(9) = lvListView.SelectedItem.SubItems(3)
        string1(14) = Mid(tvTreeView.SelectedItem.Key, 4, InStr(tvTreeView.SelectedItem.Key, "F") - 1 - 3)
        boolean1(2) = False
        srbm.Show 1
        If boolean1(2) Then
            add (string1(14))
        End If
        Erase string1
        Erase boolean1
    Else
        ab = MsgBox("    请选定配变    ", vbOKOnly + 16, "提示")
End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)


    Select Case Button.Key

        Case "ViewLarge"
           mnu35_Click
        Case "ViewSmall"
            mnu36_Click
        Case "ViewList"
            mnu37_Click
        Case "ViewDetails"
            mnu38_Click
    End Select
End Sub







Private Sub mnuHelpContents_Click()
    

    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        'nRet = OSWinHelp(Me.hWnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub


Private Sub mnuHelpSearch_Click()
    

    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        'nRet = OSWinHelp(Me.hWnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Sub mnuListViewMode_Click(Index As Integer)
    '不选中当前类型
'    mnuListViewMode(lvListView.View).Checked = False
    '设置 listview 模式
    lvListView.View = Index
    '选中新类型
    'mnuListViewMode(Index).Checked = True
    '设置工具栏为同一新类型
    tbToolBar.Buttons(Index + LISTVIEW_BUTTON).Value = tbrPressed
End Sub


Private Sub mnuViewLineUpIcons_Click()
    'To Do
    lvListView.Arrange = lvwAutoLeft
End Sub
Private Sub tvTreeView_NodeClick(ByVal node As node)
    Select Case Mid(node.Key, 1, 3)
        Case "byq"
            prg1 = 3
            lvListView.ListItems.Clear
            If i2 = 0 Then
                lvListView.ColumnHeaders.Clear
                lvListView.ColumnHeaders.add , , "户    名", 900
                lvListView.ColumnHeaders.add , , "配变编号", 650
                lvListView.ColumnHeaders.add , , "户号", 350
                lvListView.ColumnHeaders.add , , "本月表码", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "上月表码", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "本月电量", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "应收电费", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "新表起码", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "旧表止码", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "厂    号", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "局    号", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "表    损", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "新表厂号", 650, lvwColumnCenter
                lvListView.ColumnHeaders.add , , "地    址", 650, lvwColumnCenter
                'lvListView.ColumnHeaders.Add , , "加减电量", 650, lvwColumnCenter
            End If
            sqlm = "select * from bk where bk!byqh='" & Mid(node.Key, 4, InStr(node.Key, "F") - 1 - 3) + "'"
            
            i2 = 1
            Set sqldbf = sj.OpenRecordset(sqlm)
            lvListView.ListItems.Clear
            Do While Not sqldbf.EOF
                Set itemm = lvListView.ListItems.add()
                itemm.Icon = "yh1"
                itemm.SmallIcon = "yh1"
                itemm.Text = sqldbf!hm
                itemm.Key = "use" + sqldbf!byqh + "F" + sqldbf!hh
                itemm.SubItems(1) = sqldbf!byqh
                itemm.SubItems(2) = sqldbf!hh
                itemm.SubItems(3) = sqldbf!bybm
                itemm.SubItems(4) = sqldbf!sybm
                itemm.SubItems(5) = IIf(IsNull(sqldbf!bydl), 0, sqldbf!bydl)
                itemm.SubItems(6) = IIf(IsNull(sqldbf!ysdf), 0, sqldbf!ysdf)
                itemm.SubItems(7) = sqldbf!bqm
                itemm.SubItems(8) = sqldbf!bzm
                itemm.SubItems(9) = sqldbf!ch
                itemm.SubItems(10) = sqldbf!jh
                itemm.SubItems(11) = sqldbf!bsh
                If sqldbf!xbch <> "" Then
                    itemm.SubItems(12) = sqldbf!xbch
                End If
                itemm.SubItems(13) = sqldbf!dz
                'itemm.SubItems(12) = sqldbf!jjdl
                sqldbf.MoveNext
            Loop
            If lvListView.ListItems.Count = 0 Then
                    prg2 = 0
                Else
                    prg2 = 4
            End If
        Case "gds"
            prg1 = 2
            i2 = 0
            lvListView.ColumnHeaders.Clear
            'lvListView.View = lvwIcon
            lvListView.ColumnHeaders.add , , "村    名"
            lvListView.ColumnHeaders.add , , "配变编号", , lvwColumnCenter
            lvListView.ColumnHeaders.add , , "单位编号", , lvwColumnCenter
            sqlm = "select * from cm where cm!bh='" & Mid(node.Key, 4) + "'"
            Set sqldbf = sj.OpenRecordset(sqlm)
            lvListView.ListItems.Clear
            Do While Not sqldbf.EOF
                Set itemm = lvListView.ListItems.add()
                itemm.Key = "byq" + CStr(sqldbf!cmid)
                itemm.Text = sqldbf!Name
                itemm.Icon = "byq"
                itemm.SmallIcon = "byq"
                'itemm.Key = "byq" + CStr(sqldbf!cmid)
                itemm.SubItems(1) = sqldbf!byqh
                itemm.SubItems(2) = sqldbf!bh
                sqldbf.MoveNext
            Loop
            If lvListView.ListItems.Count = 0 Then
                    prg2 = 0
                Else
                    prg2 = 3
            End If
        Case "gdj"
            prg1 = 1
            i2 = 0
            lvListView.ColumnHeaders.Clear
            lvListView.ColumnHeaders.add , , "单位名称"
            lvListView.ColumnHeaders.add , , "单位编号", , lvwColumnCenter
            sqlm = "select * from dwk"
            Set sqldbf = sj.OpenRecordset(sqlm)
            lvListView.ListItems.Clear
            Do While Not sqldbf.EOF
                Set itemm = lvListView.ListItems.add()
                itemm.Key = "gds" + sqldbf!bh
                itemm.Text = sqldbf!dwmc
                itemm.Icon = "gds"
                itemm.SmallIcon = "gds"
                itemm.SubItems(1) = sqldbf!bh
                sqldbf.MoveNext
            Loop
            If lvListView.ListItems.Count = 0 Then
                    prg2 = 0
                Else
                    prg2 = 2
            End If
    End Select
End Sub
Public Sub add(sj1 As String)
                sqlm = "select * from bk where bk!byqh='" & sj1 + "'"
                Set sqldbf = sj.OpenRecordset(sqlm)
                sqldbf.MoveFirst
                lvListView.ListItems.Clear
                Do While Not sqldbf.EOF
                    Set itemm = lvListView.ListItems.add()
                    itemm.Icon = "yh1"
                    itemm.SmallIcon = "yh1"
                    itemm.Text = sqldbf!hm
                    itemm.Key = "use" + sqldbf!byqh + "F" + sqldbf!hh
                    itemm.SubItems(1) = sqldbf!byqh
                    itemm.SubItems(2) = sqldbf!hh
                    itemm.SubItems(3) = sqldbf!bybm
                    itemm.SubItems(4) = sqldbf!sybm
                    itemm.SubItems(5) = IIf(IsNull(sqldbf!bydl), 0, sqldbf!bydl)
                    itemm.SubItems(6) = IIf(IsNull(sqldbf!ysdf), 0, sqldbf!ysdf)
                    itemm.SubItems(7) = sqldbf!bqm
                    itemm.SubItems(8) = sqldbf!bzm
                    itemm.SubItems(9) = sqldbf!ch
                    itemm.SubItems(10) = sqldbf!jh
                    itemm.SubItems(11) = sqldbf!bsh
                    If sqldbf!xbch <> "" Then
                        itemm.SubItems(12) = sqldbf!xbch
                    End If
                itemm.SubItems(13) = sqldbf!dz
                    'itemm.SubItems(12) = sqldbf!jjdl
                    sqldbf.MoveNext
                Loop
End Sub