frmsplash.frm

北大青鸟教学管理系统是学习规范编程范本.功能非常完备,代码编写有章法,不可多得

VERSION 5.00
Begin VB.Form frmSplash 
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   5985
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8250
   LinkTopic       =   "Form1"
   ScaleHeight     =   5985
   ScaleWidth      =   8250
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   0
      Top             =   5520
   End
   Begin VB.PictureBox PicSource 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   6060
      Left            =   2040
      Picture         =   "frmSplash.frx":0000
      ScaleHeight     =   400
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   551
      TabIndex        =   1
      Top             =   1320
      Visible         =   0   'False
      Width           =   8325
   End
   Begin VB.PictureBox PicDest 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   6000
      Left            =   0
      Picture         =   "frmSplash.frx":152B7
      ScaleHeight     =   400
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   551
      TabIndex        =   0
      Top             =   0
      Width           =   8265
   End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim W%, H%
Dim Timer_Count As Integer
Dim I As Integer
Dim J As Integer
Dim Delay As Long

Private Sub Form_Load()
    If App.PrevInstance = True Then
        MsgBox "已有一个程序在运行！", vbInformation + vbOKOnly, "运行错误"
        End
    End If
    Dim Tmp As Long
On Error GoTo ErrLab
    W = PicSource.ScaleWidth
    H = PicSource.ScaleWidth
    PicDest.Left = 0
    PicDest.Top = 0
    
    Con.ConnectionString = "driver={SQL SERVER};server=.;uid=sa;pwd=;database=StudyManage"  '打开数据库
    Con.Open
    Exit Sub
ErrLab:     '抛出异常
    If Err.Number = -2147467259 Then
        '当第一次使用时或者数据库不存在时,恢复默认数据库
        Con.ConnectionString = "driver={SQL SERVER};server=.;uid=sa;pwd="
        Con.Open
        Con.Execute ("RESTORE DATABASE StudyManage from Disk='" & App.Path & "\database\db.101'")       '创建数据库
        Con.DefaultDatabase = "StudyManage"
    Else
        Tmp = MsgBox("数据库连接失败!是否重试?", vbCritical + vbYesNo, "数据库连接错误")
        If Tmp = vbYes Then
            Err.Clear
            Resume
        Else
            End
        End If
    End If
End Sub

Private Sub PicDest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        If Con.State = adStateOpen Then         '如果数据库已连接上，则点击右键则可跳过Splsah屏幕
            Unload Me
            frmlogin.Show
        End If
    End If
End Sub

Private Sub Timer1_Timer()
    Timer_Count = Timer_Count + 1
    If Timer_Count = 3 Then
        For I = 0 To 19
            For J = I To H Step 20
                Call BitBlt(PicDest.hDC, 0, J, W, 1, PicSource.hDC, 0, J, SRCCOPY)
                PicDest.Refresh
            Next J
            For Delay = 0 To 50000 * 50         '延时
            Next Delay
        Next I
    End If
    If Timer_Count = 5 And Con.State = adStateOpen Then '数据库为打开状态时，显示登录窗口
        Unload Me
        Load frmlogin
        frmlogin.Show
    End If
End Sub