'添加一个shape
'添加一个PicturebBox,依它为容器添加一个shape,背景色设为蓝色
'添加一个时钟控件
- 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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long,ByVal crKey As Long,ByVal bAlpha As Byte,ByVal dwFlags As Long) As Long
- Const WS_EX_LAYERED = &H80000
- Const GWL_EXSTYLE = (-20)
- Const LWA_ALPHA = &H2
- Const LWA_COLORKEY = &H1
- Dim tmd As Long
- Private Sub Form_Load()
- Show
- Shape1.BackColor = &H80000002
- Shape1.BackStyle = 1
- tmd = 255
- Timer1.Interval = 50
- Shape1.Width = Picture1.Width
- SetWindowLong hwnd,GWL_EXSTYLE,WS_EX_LAYERED
- SetLayeredWindowAttributes hwnd,tmd,LWA_ALPHA '越少越透明,限制0-255
- End Sub
- Private Sub Timer1_Timer()
- On Error Resume Next
- tmd = tmd - 1
- SetLayeredWindowAttributes hwnd,LWA_ALPHA
- Shape1.Width = Shape1.Width - Picture1.Width / 255
- If tmd < 0 Then
- Timer1.Enabled = False
- MsgBox "OK!"
- End If
- End Sub