vb 窗体透明效果（控件不透明）

'窗体透明，控件不透明的代码：Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Const WS_EX_LAYERED = &H80000Private Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Private Const LWA_COLORKEY = &H1

Private Sub Form_Load()   Me.BackColor = &HFF0000   Dim rtn As Long   Dim BorderStyler   BorderStyler = 0   rtn = GetWindowLong(hwnd, GWL_EXSTYLE)   rtn = rtn Or WS_EX_LAYERED   SetWindowLong hwnd, GWL_EXSTYLE, rtn   SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEYEnd Sub

-----------------------------------------------------------------------------------------------------------------------------------------------------------------

‘窗体逐渐变透明：'添加一个PicturebBox，依它为容器添加一个shape，背景色设为蓝色'添加一个时钟控件Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongConst WS_EX_LAYERED = &H80000Const GWL_EXSTYLE = (-20)Const LWA_ALPHA = &H2Const LWA_COLORKEY = &H1Dim tmd As LongPrivate Sub Form_Load()ShowShape1.BackColor = &H80000002Shape1.BackStyle = 1tmd = 255Timer1.Interval = 50Shape1.Width = Picture1.Width     SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_LAYERED     SetLayeredWindowAttributes hwnd, 0, tmd, LWA_ALPHA '越少越透明，限制0-255End SubPrivate Sub Timer1_Timer()On Error Resume Nexttmd = tmd - 1SetLayeredWindowAttributes hwnd, 0, tmd, LWA_ALPHAShape1.Width = Shape1.Width - Picture1.Width / 255If tmd < 0 Then  Timer1.Enabled = False  MsgBox "OK!"End IfEnd Sub