逐渐透明的窗体

Question

我想实现这样一个效果,
即窗体逐渐透明,从不透明到透明或从透明到不透明

Answer 1

SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA

Answer 2

Option ExplicitPrivate 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 = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1Private Sub Command1_Click()
    Dim i As Integer
    
    For i = 0 To 255
        DarkMe i
    Next i
    
End SubPublic Function DarkMe(ByVal intValue As Integer)
    Dim rtn As Long
    If intValue < 0 Or intValue > 255 Then
        Exit Function
    End If
    
    rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, rtn
    
    SetLayeredWindowAttributes hWnd, 0, intValue, LWA_ALPHA
End Function

Answer 3

楼上用循环，效果肯定不是很明显，只是一闪而过。我用Timer也写了一个，楼主可以试试。
--------------------------------------------------------------------------------
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 LongConst LWA_ALPHA = &H2
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)Dim i As Integer '透明程度参数范围为0-255Private Sub Form_Load()
  Timer1.Enabled = True
  Timer1.Interval = 50
  Me.Visible = False
End SubPrivate Sub Timer1_Timer()
   Dim rtn As Long
  If i + 2 <= 255 Then
     rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)    '取的窗口原先的样式
     rtn = rtn Or WS_EX_LAYERED   '使窗体添加上新的样式WS_EX_LAYERED  
     SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn   '把新的样式赋给窗体
     i = i + 2
     SetLayeredWindowAttributes Me.hwnd, 0, i, LWA_ALPHA'
     Me.Visible = True
  Else
     Timer1.Enabled = False
  End If
End Sub

Answer 4

用animatewindow一个函数就搞定了，9x，nt都支持 用不着SetLayeredWindowAttributes 这个2000以上才支持的函数，耗费资源又多！

Answer 5

Const AW_HOR_POSITIVE = &H1 'Animates the window from left to right. This flag can be used with roll or slide animation.
Const AW_HOR_NEGATIVE = &H2 'Animates the window from right to left. This flag can be used with roll or slide animation.
Const AW_VER_POSITIVE = &H4 'Animates the window from top to bottom. This flag can be used with roll or slide animation.
Const AW_VER_NEGATIVE = &H8 'Animates the window from bottom to top. This flag can be used with roll or slide animation.
Const AW_CENTER = &H10 'Makes the window appear to collapse inward if AW_HIDE is used or expand outward if the AW_HIDE is not used.
Const AW_HIDE = &H10000 'Hides the window. By default, the window is shown.
Const AW_ACTIVATE = &H20000 'Activates the window.
Const AW_SLIDE = &H40000 'Uses slide animation. By default, roll animation is used.
Const AW_BLEND = &H80000 'Uses a fade effect. This flag can be used only if hwnd is a top-level window.
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    'Set the graphic mode to persistent
    Me.AutoRedraw = True
    Me.Print "Unload me"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Animate the window
    AnimateWindow Me.hwnd, 200, AW_VER_POSITIVE Or AW_HOR_NEGATIVE Or AW_HIDE
    'Unload our form completely
    Set Form1 = Nothing
End Sub
 Close this window

Answer 6

TO: hisofty(瘦马) 你的代码妙处暂时未体会到,不过XP下测试运行好像没有楼想要的效果....