frmabout.frm

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

VERSION 5.00
Begin VB.Form frmAbout 
   BackColor       =   &H80000009&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   4260
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6465
   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 Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "X"
      Height          =   180
      Left            =   6240
      TabIndex        =   3
      ToolTipText     =   "关闭"
      Top             =   60
      Width           =   135
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "E-mail:[e-mail]"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   150
      TabIndex        =   2
      Top             =   3975
      Width           =   2145
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright's (c) 2005-2006 By Mndsoft"
      ForeColor       =   &H00808080&
      Height          =   225
      Left            =   3060
      TabIndex        =   1
      Top             =   3975
      Width           =   3240
   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         =   "frmAbout.frx":0000
      Top             =   330
      Width           =   6435
   End
   Begin VB.Shape Shape1 
      Height          =   4260
      Left            =   0
      Top             =   0
      Width           =   6465
   End
End
Attribute VB_Name = "frmAbout"
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 Label7_Click()
   Unload Me
End Sub

Private Sub Trans_Timer()
    Current = Current - 5
    If Current + 1 <= Max Then
        Trans.Enabled = False
        Transparent frmAbout.hWnd, 0
        Unload Me
        Exit Sub
    End If
    Transparent frmAbout.hWnd, Current
End Sub

Private Sub Form_Load()
    Trans.Interval = 1
    Current = 0
    Max = 255
    Transparent frmAbout.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 frmAbout.hWnd, Current
    Trans.Enabled = True
End Sub

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