浅出浅入美化窗体


【实例说明】
    浅出浅入加载窗体和卸载窗体。

【编程思路】
    调用API函数。

【设计步骤】
    1.新建一个标准工程,创建一个新窗体和一个标准模块,默认名分别为Form1和Module1。
    2.在窗体上放置CommonButton控件和两个Timer控件。

    3.源程序  [素材源程序下载]

①在模块中添加以下程序:

Option Explicit

'常量声明
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1

'API函数声明
Public Declare Function SetLayeredWindowAttributes Lib "user32" _
        (ByVal hwnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, _
        ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

②在窗体中添加以下程序:

Option Explicit

Dim r As Long
Dim s As Long

Private Sub Command1_Click()
        Timer1.Enabled = False
        '定义透明度为完全显示
        s = 255
        r = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
        r = r Or WS_EX_LAYERED
        SetWindowLong Me.hwnd, GWL_EXSTYLE, r
        SetLayeredWindowAttributes Me.hwnd, 0, s, LWA_ALPHA
        Timer2.Enabled = True
End Sub

Private Sub Form_Load()
        '获取窗体大小
        r = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
        r = r Or WS_EX_LAYERED
        '将半透明值赋予给窗体
        SetWindowLong Me.hwnd, GWL_EXSTYLE, r
        '赋予窗体半透明
        SetLayeredWindowAttributes Me.hwnd, 0, 0, LWA_ALPHA
        '从浅到深
        Timer1.Interval = 1
        Timer1.Enabled = True
        Timer2.Interval = 1
        Timer2.Enabled = False
        Me.Visible = True
End Sub

'从浅到深
Private Sub Timer1_Timer()
        On Error Resume Next
        If s < 255 Then
                s = s + 25
                r = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
                r = r Or WS_EX_LAYERED
                SetWindowLong Me.hwnd, GWL_EXSTYLE, r
                SetLayeredWindowAttributes Me.hwnd, 0, s, LWA_ALPHA
        Else
                Timer1.Enabled = False
        End If
End Sub

'从深到浅
Private Sub Timer2_Timer()
        On Error Resume Next
        If s > 0 Then
                s = s - 25
                r = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
                r = r Or WS_EX_LAYERED
                SetWindowLong Me.hwnd, GWL_EXSTYLE, r
                SetLayeredWindowAttributes Me.hwnd, 0, s, LWA_ALPHA
        Else
                Unload Me
        End If
End Sub