frmsplash.frm

需要控件：Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。

VERSION 5.00
Begin VB.Form frmSplash 
   BackColor       =   &H80000009&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   4260
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6465
   Icon            =   "frmSplash.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   6465
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer3 
      Interval        =   1
      Left            =   1080
      Top             =   2400
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   5000
      Left            =   120
      Top             =   2400
   End
   Begin VB.Timer Trans 
      Enabled         =   0   'False
      Left            =   600
      Top             =   2400
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright's (c) 2005-2006 By Mndsoft"
      ForeColor       =   &H00808080&
      Height          =   225
      Left            =   3060
      TabIndex        =   2
      Top             =   3975
      Width           =   3240
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "程序版本 Version 1.0"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   135
      TabIndex        =   1
      Top             =   3990
      Width           =   1980
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "欢迎使用产品维修资料查询系统"
      Height          =   210
      Left            =   135
      TabIndex        =   0
      Top             =   105
      Width           =   3360
   End
   Begin VB.Image Image1 
      Height          =   3540
      Left            =   15
      Picture         =   "frmSplash.frx":1D2F
      Top             =   330
      Width           =   6435
   End
   Begin VB.Shape Shape1 
      Height          =   4260
      Left            =   0
      Top             =   0
      Width           =   6465
   End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000

Dim Current As Integer ' 透明值 0 = 透明 = 不透明
Dim Max As Integer

Private Sub Trans_Timer()
    Current = Current - 5
    If Current + 1 <= Max Then
        Trans.Enabled = False
        Transparent frmSplash.hwnd, 0
        FrmMain.Show
        frmLogin.Show vbModal
        Unload Me
        Exit Sub
    End If
    Transparent frmSplash.hwnd, Current
End Sub

Private Sub Form_Load()
    Dim newFormat As String
    Dim LCID As Long
    
    newFormat = "yyyy-MM-dd"
    If GetUserLocaleInfo(LCID, LOCALE_SSHORTDATE) <> newFormat Then
       LCID = GetSystemDefaultLCID()
       '设置短日期格式
       Call SetLocaleInfo(LCID, LOCALE_SSHORTDATE, newFormat)

       '发送消息更改系统模式
       Call PostMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, ByVal 0&)
    End If

    If checkWantedAccessDSN("SerManage", "HC") = False Then
       Call CreateMDBDSN(App.pAth & "\ServicingManage", "SerManage", "HC", App.pAth & "\sms.mdb")
    End If
    
    
    Trans.Interval = 1
    Current = 0
    Max = 255
    Transparent frmSplash.hwnd, Current
End Sub

Private Function Transparent(ByVal hwnd As Long, Perc As Integer) As Long
    Dim Msg As Long
    On Error Resume Next
    If Perc < 0 Or Perc > 255 Then
        Transparent = 1
    Else
        Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
        Msg = Msg Or WS_EX_LAYERED
        SetWindowLong hwnd, GWL_EXSTYLE, Msg
        SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA
        Transparent = 0
    End If
    If Err Then
        Transparent = 2
    End If
End Function

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Current = 255
    Max = 0
    Transparent frmSplash.hwnd, Current
    Trans.Enabled = True
End Sub

Private Sub Timer3_Timer()
    Current = Current + 5
    If Current - 1 >= Max Then
        Timer3.Enabled = False
        Transparent frmSplash.hwnd, 255
        Timer1.Enabled = True
        Load FrmMain
        Exit Sub
    End If
    Transparent frmSplash.hwnd, Current
End Sub