屏幕右下角浮出式小消息窗口，透明式消失

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