frmsplash.frm

老外用VB写的CNC仿真程序源码

VERSION 5.00
Begin VB.Form frmSplash 
   BackColor       =   &H000080FF&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   5325
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8145
   LinkTopic       =   "Form1"
   Picture         =   "frmSplash.frx":0000
   ScaleHeight     =   355
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   543
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   4305
      Top             =   3405
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   5355
      Top             =   3255
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   3465
      Top             =   2430
   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 SetWindowRgn Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Boolean _
) As Long

Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long


Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal X As Byte, ByVal alpha As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const LWA_COLORKEY = 1
Private Const LWA_ALPHA = 2
Private Const LWA_BOTH = 3
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = -20

Dim g_nTransparency As Integer
Dim color As Long
Dim FadeVal As Integer
    
Private Sub SetTranslucent(ThehWnd As Long, color As Long, nTrans As Integer, flag As Byte)
    On Error GoTo ErrorRtn
    'SetWindowLong and SetLayeredWindowAttributes are API functions, see MSDN for details
    Dim attrib As Long
    attrib = GetWindowLong(ThehWnd, GWL_EXSTYLE)
    SetWindowLong ThehWnd, GWL_EXSTYLE, attrib Or WS_EX_LAYERED
    'anything with color value color will completely disappear if flag = 1 or flag = 3
    SetLayeredWindowAttributes ThehWnd, color, nTrans, flag
    Exit Sub
ErrorRtn:
    MsgBox Err.Description & " Source : " & Err.Source
    
End Sub

Private Sub Form_Click()
    Timer1.Enabled = False
    Timer2.Enabled = True
    
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then Timer2.Enabled = True
End Sub

Private Sub Form_Load()
    Dim temp As Long
    temp = CreateRoundRectRgn(0, 0, 545, 355, 20, 20)
    SetWindowRgn Me.hwnd, temp, True
    FadeVal = 0
    SetTranslucent Me.hwnd, color, FadeVal, LWA_ALPHA
End Sub

Private Sub Timer1_Timer()
 If FadeVal > 250 Then
    FadeVal = 250
    Timer1.Enabled = False
    'Timer3.Enabled = True
End If
SetTranslucent Me.hwnd, color, FadeVal, LWA_ALPHA
FadeVal = FadeVal + 5
End Sub

Private Sub Timer2_Timer()

If FadeVal < 5 Then
    FadeVal = 1
    Unload Me
    Exit Sub
End If
SetTranslucent Me.hwnd, color, FadeVal, LWA_ALPHA
FadeVal = FadeVal - 5
End Sub

Private Sub Timer3_Timer()
Static i%
i = i + 1
If i > 1 Then
    Form_Click
    Timer3.Enabled = False
End If

End Sub