frminfo.frm

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

VERSION 5.00
Begin VB.Form frmInfo 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   0  'None
   ClientHeight    =   780
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6120
   LinkTopic       =   "Form1"
   ScaleHeight     =   780
   ScaleWidth      =   6120
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer4 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   120
      Top             =   120
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   840
      Top             =   2040
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   2280
      Top             =   960
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   960
      Top             =   840
   End
   Begin VB.Label lblInfo 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Testing Testing"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   5655
   End
End
Attribute VB_Name = "frmInfo"
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 Form_Resize()
    Me.Left = Screen.Width - Me.Width - 100
    Me.Top = Screen.Height * 0.8
    Timer4.Enabled = True
End Sub

Private Sub lblInfo_Click()
    Timer1.Enabled = False
    Timer2.Enabled = True
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

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