慢慢消失的窗口

哈喽，哈喽，大家好久不见！

有一段时间未给大家更新文章了，今天抽空，给大家分享一个好玩的文章。

我们在关闭窗口时，都是直接点击关闭，那能不能做一个自动关闭的窗体？关闭的同时也需要有仪式感，窗体是慢慢的变淡后再消失？

OK，我们来看看怎么操作。

PART01

建窗体

第一步，我们来新建一个窗体，同时将窗体的弹出方式改成是，自动居中改成是，同时为了效果的明显，可以给窗体设置一个辣眼睛的颜色，放上一些控件，如下图

PART02

添加代码

接下去，我们就来添加一下代码了,先在通用模块中添加一下API函数。

'设置窗体半透明API声明开始--------------------------------------------------
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
'设置窗体半透明API声明结束--------------------------------------------------

Public Sub SetMidTrans(MyForm As Form, ByV As Byte, Optional ByVal TransAlpha As Byte, Optional ByVal TransColor As Long)
'指定窗体为透明
'其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]，dwFlags是透明方式，
'可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；当取值为LWA_COLORKEY时，
'ByV 参数:0 整个窗体透明度;1 窗体内某种颜色全透明

    Dim rtn As Long
    rtn = GetWindowLong(MyForm.hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong MyForm.hwnd, GWL_EXSTYLE, rtn
    Select Case ByV
    Case 0  '整个窗体以透明度为依据实施透明
        SetLayeredWindowAttributes MyForm.hwnd, 0, TransAlpha, LWA_ALPHA
    Case 1  '窗体内某种颜色全透明
        SetLayeredWindowAttributes MyForm.hwnd, TransColor, 0, LWA_COLORKEY
    End Select

End Sub

接着在窗体中添加以下代码

Dim MyWidth As Long, MyHeight As Long
Dim D As Long, TranI As Byte
Private Sub Form_Load()
    TranI = 240
    SetMidTrans Me, 0, TranI
    Me.OnTimer = "=ShowTimer()"
    Me.TimerInterval = 10   
End Sub

Private Function ShowTimer()
    Me.OnTimer = "=DTimer()"    
End Function
Private Function DTimer()
    If D >= 100 Then
        Me.OnTimer = "=HidenTimer()"
        Exit Function
    End If
    D = D + 1
End Function
Private Function HidenTimer() '关闭
    If TranI = 0 Then
        Me.TimerInterval = 0
        DoCmd.Close acForm, Me.Name
        Exit Function
    End If
    TranI = TranI - 2
    SetMidTrans Me, 0, TranI  
End Function

PART03

运行测试

最后，我们就可以来运行看一下效果了。

从动图上我们可以看到，窗口在慢慢的变淡直到消失，这说明，我们需要的功能实现了。

好了，今天的分享就到这里了。