frmmain.frm

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

         Caption         =   "-"
      End
      Begin VB.Menu mnu33 
         Caption         =   "打印汇总表"
      End
      Begin VB.Menu mnu34 
         Caption         =   "电费计算"
         Shortcut        =   ^J
      End
      Begin VB.Menu numa 
         Caption         =   "-"
      End
      Begin VB.Menu numjssj 
         Caption         =   "接收集抄数据"
      End
      Begin VB.Menu m331 
         Caption         =   "-"
      End
      Begin VB.Menu mnu35 
         Caption         =   "大图标"
      End
      Begin VB.Menu mnu36 
         Caption         =   "小图标"
      End
      Begin VB.Menu mnu37 
         Caption         =   "列  表"
      End
      Begin VB.Menu mnu38 
         Caption         =   "报  表"
      End
   End
   Begin VB.Menu mnu4 
      Caption         =   "其它(&T)"
      Begin VB.Menu mnu41 
         Caption         =   "跨月处理"
      End
      Begin VB.Menu m441 
         Caption         =   "-"
      End
      Begin VB.Menu mnu42 
         Caption         =   "生成上报数据"
      End
      Begin VB.Menu M442 
         Caption         =   "-"
      End
      Begin VB.Menu mnu43 
         Caption         =   "查找历史..."
      End
      Begin VB.Menu kdfl 
         Caption         =   "-"
      End
      Begin VB.Menu mnu44 
         Caption         =   "发送数据"
      End
      Begin VB.Menu mnu45 
         Caption         =   "接收数据"
      End
   End
   Begin VB.Menu mnu5 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnu51 
         Caption         =   "帮助"
         Shortcut        =   {F1}
      End
      Begin VB.Menu m551 
         Caption         =   "-"
      End
      Begin VB.Menu mnu52 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
'Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  
Dim mbMoving As Boolean
Const sglSplitLimit = 800
Public mnode As node
Public Item As ListItem
Public sj As Database
Public dwsj, cmsj, bksj, djsj As Recordset
Public yy, mm, dd As String
Public sqldbf As Recordset
Public i2 As Integer '定义是否生新生成columnheader
Public qdf As QueryDef
Public prg1, prg2 As Integer '为 1 时选定供电局，为 2 时选定供电所，为 3 时选定村,为 4 时选定用户

Private Sub Form_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    Me.Caption = "滕州供电局村级电费管理系统--欢迎使用"
    Me.Icon = ImageList1.ListImages(1).Picture
    
    

    yy = Year(Now)
    mm = Month(Now)
    dd = Day(Now)
    
    prg1 = 0
    prg2 = 0
    pathM = App.Path
    lvListView.View = GetSetting(App.Title, "Settings", "viewmode", 3)
    
    tmp = pathM + "\data\cjsj.mdb"
    Set sj = OpenDatabase(tmp, False, False, ";pwd=sunlm")
    Set dwsj = sj.OpenRecordset("dwk")
    Set cmsj = sj.OpenRecordset("cm")
    Set bksj = sj.OpenRecordset("bk")
    Set djsj = sj.OpenRecordset("dj")
    Set tvTreeView.ImageList = ImageList1
    Set lvListView.Icons = Imagebig
    Set lvListView.SmallIcons = ImageList1
    Dim sjm As String
    
    
    
    'sj.Execute "UPDATE mmk " _
        & "SET user = 'tzgdj' " _
        & "WHERE user = 'sun';"
     'sj.Execute "update mmk set user ='tz' where user='12345';"
     
     
    

    Set mnode = tvTreeView.Nodes.add()
    mnode.Text = "滕州供电局"
    mnode.Key = "gdj"
    mnode.Image = "gdj"
    dwsj.MoveFirst
    Do While Not dwsj.EOF
        Set monde = tvTreeView.Nodes.add("gdj", tvwChild)
        monde.Text = dwsj.dwmc
        keym = "gds" + dwsj!bh
        sjm = dwsj!bh
        monde.Key = "gds" + dwsj!bh
        monde.Image = "gds"
        sqlm = "select * from cm where cm!bh='" & sjm + "'"
        Set sqldbf = sj.OpenRecordset(sqlm)
        sqldbf.MoveFirst
        Do While Not sqldbf.EOF
            Set monde = tvTreeView.Nodes.add(keym, tvwChild)
            monde.Text = sqldbf!Name
            monde.Key = "byq" + sqldbf!byqh + "F" + sqldbf!bh
            monde.Image = "cm1"
            monde.SelectedImage = "cm2"
            sqldbf.MoveNext
        Loop
        dwsj.MoveNext
    Loop
    i2 = 0
End Sub


Private Sub Form_Paint()
    lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    'tbToolBar.Buttons(lvListView.View + LISTVIEW_BUTTON).Value = tbrPressed
    'mnuListViewMode(lvListView.View).Checked = True
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer

    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
End Sub



Private Sub mnuHelpAbout_Click()
    frmSplash.Show
End Sub



Private Sub mnuViewOptions_Click()
    'To Do
    MsgBox "在此处添加“选项”对话框代码！"
End Sub



Private Sub mnuViewStatusBar_Click()
    If mnuViewStatusBar.Checked Then
        sbStatusBar.Visible = False
        mnuViewStatusBar.Checked = False
    Else
        sbStatusBar.Visible = True
        mnuViewStatusBar.Checked = True
    End If
    SizeControls imgSplitter.Left
End Sub


Private Sub mnuViewToolbar_Click()
    If mnuViewToolbar.Checked Then
        tbToolBar.Visible = False
        mnuViewToolbar.Checked = False
    Else
        tbToolBar.Visible = True
        mnuViewToolbar.Checked = True
    End If
    SizeControls imgSplitter.Left
End Sub





Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
End Sub


Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    

    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
End Sub


Sub SizeControls(X As Single)
    On Error Resume Next
    

    '设置 Width 属性
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    tvTreeView.Width = X
    imgSplitter.Left = X
    lvListView.Left = X + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40


    '设置 Top 属性
    If tbToolBar.Visible Then
        tvTreeView.Top = tbToolBar.Height + picTitles.Height
    Else
        tvTreeView.Top = picTitles.Height
    End If
    lvListView.Top = tvTreeView.Top
    

    '设置 height 属性
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height)
    Else
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    End If
    

    lvListView.Height = tvTreeView.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
End Sub


Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    If Source = imgSplitter Then
        SizeControls X
    End If
End Sub


Private Sub lvListView_ColumnClick(ByVal ColumnHeaderm As ColumnHeader)
    lvListView.SortKey = ColumnHeaderm.Index - 1
    lvListView.Sorted = True
     If lvListView.SortOrder = lvwAscending Then
            lvListView.SortOrder = lvwDescending
        Else
            lvListView.SortOrder = lvwAscending
     End If
End Sub
Private Sub mnu11_Click()
 inputmm.Show 1
 mnu2.Enabled = boolean1(1)
 mnu3.Enabled = boolean1(1)
 mnu4.Enabled = boolean1(1)
 mnu12.Enabled = boolean1(1)
 tvTreeView.Enabled = boolean1(1)
 lvListView.Enabled = boolean1(1)
 tbToolBar.Enabled = boolean1(1)
 If boolean1(1) Then
    Select Case lvListView.View
        Case 0
            mnu35.Checked = True
            mnu35_Click
        Case 1
            mnu36.Checked = True
            mnu36_Click
        Case 2
            mnu37.Checked = True
            mnu37_Click
        Case 3
            mnu38.Checked = True
            mnu38_Click
    End Select
 End If
End Sub

Private Sub mnu121_Click()
    CommonDialog1.ShowPrinter
End Sub

Private Sub mnu122_Click()
    frmmm.Show 1
End Sub

Private Sub mnu13_Click()
    timedate.Show 1
End Sub

Private Sub mnu14_Click()
    Unload Me
End Sub

Private Sub mnu21_Click()

  If prg1 = 2 Or prg1 = 3 Or prg2 = 2 Then
        If prg1 = 2 Then
             string1(1) = Mid(tvTreeView.SelectedItem.Key, 4)
             string1(2) = tvTreeView.SelectedItem.Text
        End If
        If prg1 = 3 Then
             string1(1) = Mid(tvTreeView.SelectedItem.Parent.Key, 4)
             string1(2) = tvTreeView.SelectedItem.Parent.Text
        End If
        If prg2 = 2 Then
            string1(1) = Mid(lvListView.SelectedItem.Key, 4)
            string1(2) = lvListView.SelectedItem.Text
        End If
        addcm.Show 1
        If boolean1(1) Then
           Set monde = tvTreeView.Nodes.add(string1(1), tvwChild)
           monde.Text = string1(2)
           monde.Key = string1(3)
           monde.Image = "cm1"
           monde.SelectedImage = "cm2"
           Erase string1
           Erase boolean1
           tvTreeView.Refresh
        End If
        
    Else
        ab = MsgBox("    请选定供电所    ", vbOKOnly, "提示")
  End If
End Sub

Private Sub mnu22_Click()
  If prg1 = 3 Then ' Or prg2 = 4 Or prg2 = 3
        If prg1 = 3 Then
             string1(1) = Mid(tvTreeView.SelectedItem.Key, 4, InStr(tvTreeView.SelectedItem.Key, "F") - 1 - 3)
             string1(2) = tvTreeView.SelectedItem.Text
             string1(14) = Mid(tvTreeView.SelectedItem.Parent.Key, 4)
        End If
        'If prg2 = 3 Then
        '     string1(1) = lvListView.SelectedItem.SubItems(1)
        '     string1(2) = lvListView.SelectedItem.Text
        'End If
        
        boolean1(2) = True
        boolean1(1) = False
        While boolean1(2)
            adduser.Show 1
            If boolean1(1) Then
                Set itemm = lvListView.ListItems.add()
                itemm.Icon = "yh1"
                itemm.SmallIcon = "yh1"
                itemm.Text = string1(4)
                itemm.Key = "use" + string1(1) + "F" + string1(3)
                itemm.SubItems(1) = string1(1)
                itemm.SubItems(2) = string1(3)
                itemm.SubItems(3) = string1(13)
                itemm.SubItems(4) = string1(13)
                itemm.SubItems(5) = 0
                itemm.SubItems(6) = 0
                itemm.SubItems(7) = 0
                itemm.SubItems(8) = 0
                itemm.SubItems(9) = string1(6)
                itemm.SubItems(10) = string1(7)
                itemm.SubItems(11) = 1
                'string1(3) = ""
                string1(13) = ""
                string1(6) = ""