frminitdatabase.ebf

是evb描写的教学管理代码,运行在windows mobile上的.

      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label LabelMessage 
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   2520
      Width           =   3255
      _cx             =   5741
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   12648384
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "LabelMessage"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Timer TimerProgress 
      Left            =   4320
      Top             =   2640
      _cx             =   847
      _cy             =   847
      Enabled         =   -1  'True
      Interval        =   1
   End
   Begin VBCE.Label LabelProgressBar2 
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   2160
      Width           =   135
      _cx             =   238
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   6956042
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   ""
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label LabelProgressBar1 
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   2160
      Width           =   3255
      _cx             =   5741
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   12648384
      BackStyle       =   1
      BorderStyle     =   1
      Caption         =   ""
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin IMAGECtl.ImageCtl ImageCtlMain 
      Height          =   1815
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   3255
      _cx             =   5741
      _cy             =   3201
      Picture         =   ""
      Stretch         =   0   'False
   End
End
Attribute VB_Name = "frmInitDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()

    labelMessage.Caption = "初始化数据库..."
    FrameErrorShow.Visible = False
    ImageCtlError.Picture = strPath & "\error.bmp" '初始化图片
    ImageCtlError.Stretch = True
    ImageCtlMain.Picture = strPath & "\Main.bmp"
    ImageCtlMain.Stretch = True
End Sub
Private Sub CommandCancel_Click() '退出系统确认
    Dim i As Integer
    i = MsgBox("退出系统？", vbOKCancel, "确定")
    If i = vbOK Then
        App.End
    End If
End Sub

Private Sub CommandModifyFiles_Click() '修复数据库
    Dim str As String
    Dim i As Integer
    Dim FileSystem1 As FILECTL.FileSystem '创建文件系统的引用
    Set FileSystem1 = CreateObject("Filectl.fileSystem")
    
    FrameErrorShow.Visible = False
    str = strPath & "\MOBILEMISBACKUP.cdb" '数据库文件备份
    If FileExists(str) Then
        TimerProgress.Enabled = True '如果备份数据库存在，在恢复数据库
    
        FileSystem1.FileCopy str, cdbFile
    Else
        FrameErrorShow.Visible = True

        LabelErrorMessage.Caption = "无法修复文件"
        i = MsgBox("是否重新创建数据库？", vbOKCancel, "确定") '如果没有是否创建
        If i = vbOK Then
            CreateDatabase (cdbFile) '创建数据库
            TimerProgress.Enabled = True
            FrameErrorShow.Visible = False
        End If
    End If
    

End Sub

Private Sub CommandSearchFile_Click()
    Dim str As String
    Dim FileSystem1 As FILECTL.FileSystem
    Set FileSystem1 = CreateObject("Filectl.fileSystem")
    
    FrameErrorShow.Visible = False
    CommonDialogDatabase.Filter = "数据库文件|*.cdb" '初始化通用对话框
  '  MsgBox strPath
    CommonDialogDatabase.InitDir = strPath
    CommonDialogDatabase.ShowOpen '"打开"通用对话框
    
    str = CommonDialogDatabase.FileName '得到数据库路径
    If Right(str, 13) <> Right(cdbFile, 13) Then '通过比较右边13个字符的字符串
        FrameErrorShow.Visible = True
        LabelErrorMessage.Caption = "数据库文件错误"
    
    Else
        TimerProgress.Enabled = True
        FileSystem1.FileCopy str, cdbFile '恢复数据库
    End If
    
    
End Sub

Private Sub InitDefaultShow() '根据用户配置文件，选择进入的系统
        Select Case GetValues(UserSetupFiles, "function", "default")
        Case "TA"
            frmTeacherAssistant.Show
            

        Case "JG"
            frmEducationAdmin.Show
            
        Case "SG"
            frmDomitoryAdmin.Show
            
        Case "CG"
        End Select

End Sub

Private Sub TimerProgress_Timer() '模拟进度条
    LabelProgressBar2.Width = LabelProgressBar2.Width + 20 '模拟进度条
    
    If Int((LabelProgressBar1.Width / LabelProgressBar2.Width)) = 3 Then '当长度到达1/3时开始初始化数据库
        
        If Not FileExists(cdbFile) Then '检测数据库是否存在
            FrameErrorShow.Visible = True
            TimerProgress.Enabled = False
        Else
            CONN_Open '打开数据库
            labelMessage.Caption = "数据库初始化完成"
        End If
    ElseIf Int((LabelProgressBar1.Width / LabelProgressBar2.Width)) = 2 Then '当长度达1/2时开始进入系统
        labelMessage.Caption = "进入系统中..."
    End If
    
    If LabelProgressBar2.Width >= LabelProgressBar1.Width Then '进入系统
        TimerProgress.Enabled = False 'Timer关闭
       
        frmInitDatabase.Hide '窗体隐藏
        If Not FileExists(UserSetupFiles) Then
            frmMain.Show        '如果用户配置文件不存在，在显示主窗口
        ElseIf GetValues(UserSetupFiles, "FUNCTION", "SHOW") = "TRUE" Then
            frmMain.Show '如果用户配置文件中显示主窗口
        Else
            InitDefaultShow '直接进入子系统
        End If
    End If
End Sub