frmmain.frm

此为水费收费管理系统

   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   240
      Index           =   0
      Left            =   210
      TabIndex        =   4
      Top             =   765
      Width           =   720
   End
   Begin VB.Menu MnuTo 
      Caption         =   "="
   End
   Begin VB.Menu MnuXiTongSheZhi 
      Caption         =   "系统管理(&S)"
      Begin VB.Menu MnuXtSjBf 
         Caption         =   "数据备份(&B)"
      End
      Begin VB.Menu MnuXtSjHy 
         Caption         =   "数据还原(&R)"
      End
      Begin VB.Menu MnuLine6 
         Caption         =   "-"
      End
      Begin VB.Menu MnuGgDlYh 
         Caption         =   "更改登陆用户(&C)"
         Visible         =   0   'False
      End
      Begin VB.Menu MnuGgYhMm 
         Caption         =   "更改用户密码(&P)"
      End
      Begin VB.Menu MnuDlYhGlQ 
         Caption         =   "登录用户管理(&U)."
      End
      Begin VB.Menu MnuLine18 
         Caption         =   "-"
      End
      Begin VB.Menu MnuExit 
         Caption         =   "退出系统(&X)"
      End
   End
   Begin VB.Menu MnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu MnuBangZhu 
         Caption         =   "系统帮助(&H)"
      End
      Begin VB.Menu MnuGyBXt 
         Caption         =   "关于本系统(&A)"
      End
      Begin VB.Menu MnuLine22 
         Caption         =   "-"
      End
      Begin VB.Menu MnuLianXi 
         Caption         =   "与我们联系(&L)."
      End
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public WithEvents m_Menu As EnhancedMenu
Attribute m_Menu.VB_VarHelpID = -1
Dim hbmoving As Boolean
Const sglSplitLimit = 500

Dim HelpPath As String
Dim i As Integer

'数据列表打印使用的数据结构
Private Type DataList_Struct
    Hsh As String           '号数
    Name1 As String         '户名
    Pid As String           '账号
    Money1 As Double        '金额

    Phone As String             '电话
    Water As String             '水费已付
    Sanitation As String        '卫生费已付
    
    Ycount As Double    '上期度数
    Ncount As Double    '本期度数
    Dj As Currency      '单价
    MoneyStr As String  '金额大写
End Type

'添加数据时的结构
Private Type AddData_Struct
    Year As Integer         '年份
    Month As Integer        '月份
    
    '以下两点暂时未用
    EditType As Integer     '正在编辑的类型，有三种：0 户主资料     1 水费资料      2 卫生费资料
    StrEd As String         '提示信息字符串
End Type
Dim EdType As AddData_Struct

Public Rec As New ADODB.Recordset

Private Sub Command1_Click()
    Toolbar1.Buttons("TbrPnt").Enabled = True
    If Option1(0).Value Then
        EdType.Year = Combo1(0).Text
        EdType.Month = Combo1(1).Text
        Label1(0).Caption = "当前列表显示：" & Combo1(0).Text & "年" & Combo1(1).Text & _
            "月份自来水费收费情况"
        Label1(1).Caption = "当前列表显示：" & Combo1(0).Text & "年" & Combo1(1).Text & _
            "月份自来水费收费情况"
    ElseIf Option1(1).Value Then
        EdType.Year = Combo2.Text
        EdType.Month = 0
        
        Label1(0).Caption = "当前列表显示：" & Combo2.Text & "年卫生费收费情况"
        Label1(1).Caption = "当前列表显示：" & Combo2.Text & "年卫生费收费情况"
    End If
    Call Init_ListView1
    Command2.Enabled = True
End Sub

Private Sub Command2_Click()
    If Trim(Text1.Text) = "" Then
        MsgBox "没有输入要查找的户名，请重新输入...", vbOKOnly + vbExclamation, "没有查找内容"
        Text1.SetFocus
        Exit Sub
    End If
    Call Init_ListView1(True)
End Sub

Private Sub Form_Load()
    Set m_Menu = New EnhancedMenu
    m_Menu.Subclass Me.hWnd
    
    Set m_Menu(2).SubMenu(1).Picture = LoadPicture(SysDbPath + "\COMMIT.ICO")
    Set m_Menu(2).SubMenu(2).Picture = LoadPicture(SysDbPath + "\open.ICO")
    Set m_Menu(2).SubMenu(4).Picture = LoadPicture(SysDbPath + "\index.ICO")
    Set m_Menu(2).SubMenu(5).Picture = LoadPicture(SysDbPath + "\userpower.ICO")
'    Set m_Menu(2).SubMenu(7).Picture = LoadPicture(SysDbPath + "\grid.ICO")
    Set m_Menu(2).SubMenu(7).Picture = LoadPicture(SysDbPath + "\close.ICO")
    Set m_Menu(3).SubMenu(1).Picture = LoadPicture(SysDbPath + "\preview.ICO")
    Set m_Menu(3).SubMenu(4).Picture = LoadPicture(SysDbPath + "\line.ICO")
    m_Menu(3).RightJustify = True
    
'    HelpPath = App.Path & "\help\default.HTM"
    Me.Caption = "水费卫生费管理系统（当前用户：" & MdlMain.LoginUser & "）"
'    StatusBar1.Panels("panel3").Text = "登陆日期：" & MdlMain.LoginTime.LgTime
    Label1(0).Caption = "当前列表显示：2004年1月份水费收费情况"
    Label1(1).Caption = "当前列表显示：2004年1月份水费收费情况"
    
    For i = 1 To 12
        Combo1(1).AddItem i
    Next i
    For i = 0 To 50
        Combo1(0).AddItem 1990 + i
        Combo2.AddItem 1990 + i
    Next i
    Combo1(0).Text = MdlMain.LoginTime.LgYear
    Combo1(1).Text = MdlMain.LoginTime.LgMonth
    Combo2.Text = MdlMain.LoginTime.LgYear
    Text1.Text = ""
    
    Me.Show
    DoEvents
    Option1(2).Value = True
'    Call Init_ListView1
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If MsgBox("你真的要退出本系统吗？", vbOKCancel + vbInformation, "请确认...") = vbCancel Then
        Cancel = True
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    ProgressBar1.Visible = False
    Label1(0).Visible = True
    Label1(1).Visible = True
    ProgressBar1.Left = 50
    ProgressBar1.Top = Toolbar1.Top + Toolbar1.Height + 120
    ProgressBar1.Width = Me.ScaleWidth - ProgressBar1.Left - 50
    
    ListView1.Left = 50
    ListView1.Top = ProgressBar1.Top + ProgressBar1.Height + 160
    ListView1.Width = ProgressBar1.Width - 3000
    ListView1.Height = Me.ScaleHeight - ListView1.Top - 50 - StatusBar1.Height
    
    Picture1.Top = ListView1.Top
    Picture1.Height = ListView1.Height
    Picture1.Left = ListView1.Left + ListView1.Width + 80
    Picture1.Width = Me.ScaleWidth - Picture1.Left - 70
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    m_Menu.Destroy: Set m_Menu = Nothing
    Rec.Close: Set Rec = Nothing
    Cn_Rsh.Close: Set Cn_Rsh = Nothing
End Sub

Private Sub ListView1_DblClick()
    If Option1(0).Value Then        '水费
        On Error GoTo ER2
        If ListView1.ListItems.Count = 0 Then Exit Sub
        Rec.Bookmark = Val(Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1))
        
        With Rec
            FrmWater.Pid = Rec.Fields("id").Value
            FrmWater.nYear = EdType.Year
            FrmWater.nMonth = EdType.Month
            
            FrmWater.Text1(0).Text = .Fields("hsh").Value
            FrmWater.Text1(1).Text = Trim(.Fields("name").Value)
            FrmWater.Text1(2).Text = ListView1.SelectedItem.SubItems(2)
            FrmWater.Text1(3).Text = ListView1.SelectedItem.SubItems(3)
            FrmWater.Text1(4).Text = ListView1.SelectedItem.SubItems(4)
            FrmWater.Text1(5).Text = ListView1.SelectedItem.SubItems(5)
            FrmWater.Text1(6).Text = ListView1.SelectedItem.SubItems(6)
            
            FrmWater.Label2.Caption = "水费收费时间：" & EdType.Year & "年" & EdType.Month & "月"
        End With
        
        FrmWater.Command1(2).Default = True
        FrmWater.Command1(2).Enabled = True
        FrmWater.Show vbModal
        Exit Sub
ER2:
        If Err.Number = 3704 Then
            Exit Sub
        Else
            MsgBox Err.Number & " : " & Err.Description
        End If
    ElseIf Option1(1).Value Then    '卫生费
        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
            FrmSanitation.Pid = Rec.Fields("id").Value
            FrmSanitation.Text1(0).Text = .Fields("hsh").Value
            FrmSanitation.Text1(1).Text = Trim(.Fields("name").Value)
            FrmSanitation.Text1(2).Text = IIf(IsNull(.Fields("money").Value), "", .Fields("money").Value)
            FrmSanitation.Label2.Caption = "卫生费收费年份：" & EdType.Year
        End With
        MdlMain.OpenType = EdType.Year
        
        FrmSanitation.Command1(2).Default = True
        FrmSanitation.Command1(2).Enabled = True
        FrmSanitation.Show vbModal
        Exit Sub
Er1:
        If Err.Number = 3704 Then
            Exit Sub
        Else
            MsgBox Err.Number & " : " & Err.Description
        End If
    ElseIf Option1(2).Value Then    '户主资料
        Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrChange"))
    End If
End Sub

Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeySpace Then Call ListView1_DblClick
End Sub

Private Sub m_Menu_ItemSelect(MenuObject As MenuItem)
    Select Case MenuObject.Caption
        Case "数据备份(&B)"
            FrmBackUp.Show vbModal
        Case "数据还原(&R)"
            MdlMain.ReturnSql = ""
            FrmRestore.Show vbModal
            If MdlMain.ReturnSql = "已还原" Then Call Init_ListView1
            
        Case "更改用户密码(&P)"
            FrmPwdGl.Show vbModal
        Case "登录用户管理(&U)."
            FrmLoginUser.Show vbModal
        Case "退出系统(&X)"
            Unload Me
        
        Case "增加(&A)."
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrAdd"))
        Case "修改(&C)"
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrChange"))
        Case "删除(&D)"
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrDel"))
        
        Case "系统帮助(&H)"
            MsgBox "本系统暂时未能提供帮助，不便之处请多多包涵！", vbOKOnly + vbInformation, "系统信息"
        Case "关于本系统(&A)"