VB 实现屏幕右下角浮出式消息窗口，透明淡出效果。
Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_GETWORKAREA = 48
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'透明
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
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
'延迟
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'最前
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_BOTTOM = 1
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
'可见区域
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Dim MyRect As Long
Dim MyRgn As Long
Dim X1 As Integer, Y1 As Integer
Dim X2 As Integer, Y2 As Integer
Dim OpenSpeed As Integer
Dim CloseSpeed As Integer
Dim WiteLong As Integer
Private Sub Form_Load()
'------------------------------
OpenSpeed = 10 '出现时速度
CloseSpeed = 10 '关闭时淡出的速度
Timer1.Interval = 10 '出现时显示平滑度
WiteLong = 30 '关闭前等待时间(秒),为0则不会自动关闭
'------------------------------
'计算任务栏高
Dim lRes As Long
Dim rectVal As RECT
Dim TaskbarHeight As Integer
lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, rectVal, 0)
TaskbarHeight = Screen.Height - rectVal.Bottom * Screen.TwipsPerPixelY
'确定位置
Me.Move Screen.Width * 0.75, Screen.Height * 0.75 - TaskbarHeight, _
Screen.Width \ 4, Screen.Height \ 4
'永在最前
SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left \ Screen.TwipsPerPixelX, Me.Top \ Screen.TwipsPerPixelY, Me.Width, Me.Height, 1
'为遮蔽窗体计算坐标
X1 = 0
Y1 = Me.Width \ Screen.TwipsPerPixelX
X2 = Me.Width \ Screen.TwipsPerPixelX
Y2 = Me.Height \ Screen.TwipsPerPixelY - 1
'遮蔽部分窗体为不可见
MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CloseMe(1) '以什么样的方式关闭自己，有 1-淡出 和 2-收缩 可选
Call DeleteObject(MyRect)
End Sub
Private Sub Timer1_Timer()
Y2 = Y2 - OpenSpeed
If Y2 <= 0 Then
MyRect = CreateRectRgn(0, 0, Me.Width \ Screen.TwipsPerPixelX, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
Timer1.Enabled = False
'----------------------
If WiteLong <> 0 Then
Timer2.Interval = 1000
Timer2.Enabled = True
End If
End If
MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
End Sub
Private Sub Timer2_Timer()
Static NL As Integer
NL = NL + 1
If NL >= WiteLong Then Unload Me
End Sub
'==============================================
'0 - 不使用卸载效果
'1 - 使用透明淡出效果
'2 - 使用收缩效果
'==============================================
Private Sub CloseMe(Optional N As Integer = 1)
Select Case N
Case 0
Exit Sub
Case 1
Dim rtn As Long
rtn = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn
For I = 255 To 10 Step -10
SetLayeredWindowAttributes Me.hWnd, 0, I, LWA_ALPHA
DoEvents
Sleep CloseSpeed
Next I
Case 2
While Y2 < (Me.Height / Screen.TwipsPerPixelY)
Y2 = Y2 + OpenSpeed
MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
Sleep OpenSpeed
Wend
Case Else
End Select
End Sub
?
