frmstatus.frm

此为水费收费管理系统

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmStatus 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   915
   ClientLeft      =   30
   ClientTop       =   30
   ClientWidth     =   3840
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   915
   ScaleWidth      =   3840
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer6 
      Interval        =   1
      Left            =   3375
      Top             =   375
   End
   Begin VB.Timer Timer5 
      Interval        =   1
      Left            =   2910
      Top             =   405
   End
   Begin VB.Timer Timer4 
      Interval        =   1
      Left            =   2460
      Top             =   435
   End
   Begin MSComCtl2.Animation Animation1 
      Height          =   660
      Left            =   420
      TabIndex        =   0
      Top             =   144
      Width           =   900
      _ExtentX        =   1588
      _ExtentY        =   1164
      _Version        =   393216
      BackColor       =   12632256
      FullWidth       =   60
      FullHeight      =   44
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "正在整理数据..."
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   240
      Left            =   1452
      TabIndex        =   1
      Top             =   324
      Width           =   1800
   End
End
Attribute VB_Name = "FrmStatus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim i As Integer
Dim j As Integer

Private Sub Form_Load()
    Call SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAG)
    If Dir(App.Path & "\findcomp.avi") = "" Then
'        MsgBox "文件丢失，请与管理员联系！", vbOKOnly + vbInformation, "文件呢？"
    Else
        Animation1.AutoPlay = True
        Animation1.Open App.Path & "\Findcomp.avi"
    End If
    Timer4.Enabled = False
    Timer5.Enabled = False
    Timer6.Enabled = False
'    Timer7.Enabled = False
'    Timer8.Enabled = False
'    Timer9.Enabled = False
    
    Select Case MdlMain.FrmStatusType
        Case "数据备份"
            Timer4.Enabled = True
        Case "数据还原"
            Timer5.Enabled = True
            
        Case "只显示处理进度"
            Timer6.Enabled = True
        Case "数据结算"
'            Timer7.Enabled = True
        Case "读取历史数据"
'            Timer8.Enabled = True
        Case "历史数据查询完毕"
'            Timer9.Enabled = True
    End Select
End Sub

Private Sub Timer4_Timer()      '数据备份
    Timer4.Enabled = False
    Dim ObjCompress As New ClsCompress
    Dim lnglngResult As Long
    lnglngResult = ObjCompress.CompressFile(FrmBackUp.MdbFileName, FrmBackUp.NamPathName, 9)
    Set ObjCompress = Nothing
    Select Case lnglngResult
        Case 0
            MdlMain.FrmStatusType = "备份成功"
        Case 9999
            MdlMain.FrmStatusType = "路径出错"
        Case 99999
            MdlMain.FrmStatusType = "未知错误"
    End Select
    Unload Me
    Exit Sub
End Sub

Private Sub Timer5_Timer()      '数据还原
    Timer5.Enabled = False
    Dim ObjCompress As New ClsCompress
    Dim lnglngResult As Long
    lnglngResult = ObjCompress.DecompressFile(FrmRestore.NamFileName, FrmRestore.MdbPathName)
    Set ObjCompress = Nothing
    Select Case lnglngResult
        Case 0
            MdlMain.FrmStatusType = "还原成功"
        Case 9999
            MdlMain.FrmStatusType = "路径出错"
        Case 99999
            MdlMain.FrmStatusType = "未知错误"
    End Select
    Unload Me
    Exit Sub
End Sub

Private Sub Timer6_Timer()      '只显示处理进度
    Timer6.Enabled = False
    Unload Me
End Sub

'Private Sub Timer7_Timer()      '数据结算
'    Timer7.Enabled = False
'    Dim ObjCompress As New ClsCompress
'    Dim lnglngResult As Long
'    lnglngResult = ObjCompress.CompressFile(MdlMain.JSMdbFname, MdlMain.JSNamFname, 9)
'    Set ObjCompress = Nothing
'    Select Case lnglngResult
'        Case 0
'            MdlMain.FrmStatusType = "结算成功"
'        Case 9999
'            MdlMain.FrmStatusType = "路径出错"
'        Case 99999
'            MdlMain.FrmStatusType = "未知错误"
'    End Select
'    Unload Me
'    Exit Sub
'End Sub
'
'Private Sub Timer8_Timer()          '读取历史数据
'    Timer8.Enabled = False
'    Dim Fs As New Scripting.FileSystemObject
'    Dim ObjCompress As New ClsCompress
'    Dim lnglngResult As Long
'
'    On Error GoTo NumErr
'    If MdlMain.JieSuanStu = False Then
'        lnglngResult = ObjCompress.CompressFile(MdlMain.JSMdbFname, MdlMain.JSTmpFname, 9)
'        If Fs.FileExists(MdlMain.JSMdbFname) = True Then Fs.DeleteFile MdlMain.JSMdbFname, True
'    End If
'
'    lnglngResult = ObjCompress.DecompressFile(MdlMain.JSNamFname, MdlMain.JSMdbFname)
'    Set ObjCompress = Nothing
'    Select Case lnglngResult
'        Case 0
'            MdlMain.FrmStatusType = "历史数据读取成功"
'        Case 9999
'            MdlMain.FrmStatusType = "路径出错"
'        Case 99999
'            MdlMain.FrmStatusType = "未知错误"
'    End Select
'    Unload Me
'    Exit Sub
'NumErr:
'    If Err.Number = 70 Then
'        MsgBox "系统数据库访问出错，请确认是否正在使用数据库！！" & vbCrLf & vbCrLf & _
'            "如果正在使用数据库请关闭后再试一次。" & vbCrLf & vbCrLf & _
'            "如果还是不行请联系系统开发人员。", vbOKOnly + _
'            vbExclamation, "数据库正在使用？？"
'    Else
'        MsgBox Err.Number & "：" & Err.Description, vbOKOnly + vbQuestion, "系统出错！"
'    End If
'    Unload Me
'End Sub
'
'Private Sub Timer9_Timer()          '历史数据查询完毕
'    Timer9.Enabled = False
'    Dim Fs As New Scripting.FileSystemObject
'    Dim ObjCompress As New ClsCompress
'    Dim lnglngResult As Long
'
'    On Error GoTo NumErr
'    If Fs.FileExists(MdlMain.JSMdbFname) = True Then Fs.DeleteFile MdlMain.JSMdbFname, True
'    lnglngResult = ObjCompress.DecompressFile(MdlMain.JSTmpFname, MdlMain.JSMdbFname)
'    Set ObjCompress = Nothing
'    Select Case lnglngResult
'        Case 0
'            MdlMain.FrmStatusType = "历史数据查询完毕"
'        Case 9999
'            MdlMain.FrmStatusType = "路径出错"
'        Case 99999
'            MdlMain.FrmStatusType = "未知错误"
'    End Select
'    Unload Me
'    Exit Sub
'NumErr:
'    If Err.Number = 70 Then
'        MsgBox "系统数据库访问出错，请确认是否正在使用数据库！！" & vbCrLf & vbCrLf & _
'            "如果正在使用数据库请关闭后再试一次。" & vbCrLf & vbCrLf & _
'            "如果还是不行请联系系统开发人员。", vbOKOnly + _
'            vbExclamation, "数据库正在使用？？"
'    Else
'        MsgBox Err.Number & "：" & Err.Description, vbOKOnly + vbQuestion, "系统出错！"
'    End If
'    Unload Me
'End Sub
'
'