窗口的淡入淡出(急!!在线等!!实现后结贴!)

Question

从屏幕的左上角开始出现,由小变大,变大到我指定的大小,并且移动到我指定的地方.

Answer 1

API MoveWindow 移动窗体移动过程中改动窗体大小就可以了啊

Answer 2

这哪是淡入淡出啊
淡入淡出 该窗体透明度API MoveWindow  申明 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Answer 3

用image对象和时间控件
改变大小是改变高度和宽度
移动是改变left和top

Answer 4

淡入：
首先声明
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
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim qb As Long
Dim qidong As LongPrivate Sub Form_Load()
     rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
     rtn = rtn Or WS_EX_LAYERED
     SetWindowLong hwnd, GWL_EXSTYLE, rtn
     SetLayeredWindowAttributes hwnd, 1, 0, LWA_ALPHA
End SubPrivate Sub Timer3_Timer()
Dim rtn As Long
    If qb < 255 Then
        qb = qb + 4
        If qb > 255 Then
            qb = qb - 1
        End If
     rtn = GetWindowLong(hwnd, GWL_EXSTYLE)     rtn = rtn Or WS_EX_LAYERED     SetWindowLong hwnd, GWL_EXSTYLE, rtn     SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA    Else
        Timer3.Interval = 0
    End If
End Sub以上完毕后实现淡入，下面淡出：Private Sub Form_Unload(Cancel As Integer)
If qidong = 0 Then
Cancel = -1
Timer4.Interval = 1
Form1.Timer3.Interval = 1
Form1.Show
Else
Unload Me
End If
End SubPrivate Sub Timer4_Timer()
    If qb > 0 Then
        qb = qb - 4
        If qb < 0 Then
            qb = qb + 1
        End If
     rtn = GetWindowLong(hwnd, GWL_EXSTYLE)     rtn = rtn Or WS_EX_LAYERED     SetWindowLong hwnd, GWL_EXSTYLE, rtn     SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA    Else
        Timer4.Interval = 0
        qidong = 1
    End If
End Sub效果不错，就是速度有点慢，今天下午刚刚做好，是放在自己程序里的，所以可能有多余语句……

Answer 5

有淡出效果……这个程序现在我已经生成EXE了，完全没有问题~

Answer 6

偶稍微改动了一下
'窗体淡入淡出
'需1个timer控件 Interval属性设置为10 enable设置为truePrivate 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
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As LongPrivate Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1Dim i As Long
Dim flag As Boolean
Private Sub Form_Load()
     rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
     rtn = rtn Or WS_EX_LAYERED
     SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn
     Dim i As Integer
     
     SetLayeredWindowAttributes Me.hwnd, 1, 0, LWA_ALPHA
     
     flag = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = True
i = 255
flag = True
Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
If flag Then
    i = i - 1
    If i > 0 Then
    MoveWindow Me.hwnd, i, i, 400, 300, True
    SetLayeredWindowAttributes Me.hwnd, 1, i, LWA_ALPHA
    Else
    Timer1.Enabled = False
    End
    End If
Else
    i = i + 1
    If i < 255 Then
    MoveWindow Me.hwnd, i, i, 400, 300, True
    SetLayeredWindowAttributes Me.hwnd, 1, i, LWA_ALPHA
    Else
    Timer1.Enabled = False
    End If
End If
End Sub

Answer 7

我将楼上兄弟的程序改编了一下,有一点体会,不知是否正确.
就是:
Timer4.Interval = 0 
Unload Me
这两句的顺序很重要(在Form_Unload中),不知是不是有窗体的内容在运行的话,窗体的不会真正关闭.<不知这句话是否正确,请楼上的朋友指点一下>.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
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const Speed = 5 '控制速度Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim qb As LongPrivate Sub Form_Load()
     rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
     rtn = rtn Or WS_EX_LAYERED
     SetWindowLong hwnd, GWL_EXSTYLE, rtn
     SetLayeredWindowAttributes hwnd, 1, 0, LWA_ALPHA
     Timer3.Interval = 1
     qb = 0
End SubPrivate Sub Timer3_Timer()
Dim rtn As Long
If qb < 255 Then
    qb = qb + Speed
    If qb > 255 Then qb = 255
    
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA
Else
    Timer3.Interval = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Timer4.Interval = 0 Then
    Cancel = -1
    Timer4.Interval = 1
Else
    Timer4.Interval = 0 '&Otilde;&acirc;&Agrave;&iuml;&micro;&Auml;&acute;&Icirc;&ETH;ò&ordm;&Uuml;&Ouml;&Oslash;&Ograve;&ordf;
    Unload Me
End If
End SubPrivate Sub Timer4_Timer()
If qb > 0 Then
    qb = qb - Speed
    If qb < 0 Then qb = 0
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA
Else
    Unload Me
End If
End Sub

Answer 8

我将楼上兄弟的程序改编了一下,有一点体会,不知是否正确.
就是:
Timer4.Interval = 0 
Unload Me
这两句的顺序很重要(在Form_Unload中),不知是不是有窗体的内容在运行的话,窗体的不会真正关闭.<不知这句话是否正确,请楼上的朋友指点一下>.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
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const Speed = 5 '控制速度Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim qb As LongPrivate Sub Form_Load()
     rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
     rtn = rtn Or WS_EX_LAYERED
     SetWindowLong hwnd, GWL_EXSTYLE, rtn
     SetLayeredWindowAttributes hwnd, 1, 0, LWA_ALPHA
     Timer3.Interval = 1
     qb = 0
End SubPrivate Sub Timer3_Timer()
Dim rtn As Long
If qb < 255 Then
    qb = qb + Speed
    If qb > 255 Then qb = 255
    
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA
Else
    Timer3.Interval = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Timer4.Interval = 0 Then
    Cancel = -1
    Timer4.Interval = 1
Else
    Timer4.Interval = 0 
    Unload Me
End If
End SubPrivate Sub Timer4_Timer()
If qb > 0 Then
    qb = qb - Speed
    If qb < 0 Then qb = 0
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hwnd, 1, qb, LWA_ALPHA
Else
    Unload Me
End If
End Sub

Answer 9

gabazi(网客) 的程序可能更接近斑竹的要求.唉,这里的高手真多.不容易混呀!!! ^_^

Answer 10

怎么我试的结果提示“找不到DLL 入口点SetLayeredWindowAttributes in user32”我用的是98,是不是98不支持？