VB 实现屏幕右下角浮出式消息窗口，透明淡出效果。

'任务栏高度[此部分相关代码转载自 枕善居]
Private Declare Function SystemParametersInfo Lib "user32" 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