[VB6] [VB教學室] -程式淡出與淡入

[複製鏈接]

kma20071128

4 主題	0 好友	2 積分

新手上路

Rank: 1

UID: 19389
帖子: 15
主題: 4
精華: 0
積分: 2
楓幣: 71
威望: 2
存款: 0
贊助金額: 0
推廣: 0
ＧＰ: 0
閱讀權限: 10
性別: 保密
在線時間: 3 小時
註冊時間: 2012-12-30
最後登入: 2013-7-20

發消息

電梯直達

1樓

發表於 2013-7-20 14:28:29 |只看該作者 |倒序瀏覽

淡出是等於關閉程式時不會直接關閉,會慢慢減少透明度
淡入是等於開啟程式時不會直接彈出,會慢慢增加透明度

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 Long

Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const GWL_STYLE = (-16)
Dim Value As Long ' 控制透明度的變量

Private Sub Form_Load()
Dim TempLng As Long
Dim rtn As Long
Value = 0 '預設透明度為0
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 1, Value, LWA_ALPHA
End Sub

Private Sub Timer1_Timer() 'Timer1預設Enabled為 True
Dim TempLng As Long
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 1, Value, LWA_ALPHA
Value = Val(Value) + 5 '透明度每次+5的+上
If Value = 255 Then Timer1 = False '透明度最多是255 這裏是判斷如果Value到了255就關閉
Timer1
End Sub

Private Sub Form_Unload(Cancel As Integer) '操作關閉事件
Timer2.Enabled = True '開啟Timer2 操作淡出事件
Cancel = 1 '令關閉無效,防止表單直接關閉
End Sub

Private Sub Timer2_Timer()
Dim TempLng As Long
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 1, Value, LWA_ALPHA
Value = Val(Value) - 5 '透明度每次-5
If Value = 0 Then End ' 如果Value的數值等於0就結束表單
End Sub