状态栏图标和通知

    Option Explicit

    Public Const MAX_TOOLTIP As Integer = 64

    Public Const NIF_ICON = &H2

    Public Const NIF_MESSAGE = &H1

    Public Const NIF_TIP = &H4

    Public Const NIM_ADD = &H0
   
    Public Const NIM_MODIFY = &H1

    Public Const NIM_DELETE = &H2

    Public Const WM_MOUSEMOVE = &H200

    Public Const WM_LBUTTONDOWN = &H201

    Public Const WM_LBUTTONUP = &H202

    Public Const WM_LBUTTONDBLCLK = &H203

    Public Const WM_RBUTTONDOWN = &H204

    Public Const WM_RBUTTONUP = &H205

    Public Const WM_RBUTTONDBLCLK = &H206

    Public Const SW_RESTORE = 9

    Public Const SW_HIDE = 0

    Public nfIconData As NOTIFYICONDATA

    Public Type NOTIFYICONDATA

        cbSize As Long
   
        hwnd As Long
   
        uID As Long
   
        uFlags As Long
   
        uCallbackMessage As Long
   
        hIcon As Long
   
        szTip As String * MAX_TOOLTIP

    End Type

    Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

    Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call DelStatusIcon
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim lMsg As Single
   
    lMsg = x / Screen.TwipsPerPixelX
   
    Select Case lMsg
   
        Case WM_LBUTTONUP
            Call ShowMe '单击左键，显示窗体
           
        Case WM_RBUTTONUP
            SetForegroundWindow Me.hwnd ' 激活窗体，以便可以消除PopupMenu 弹出的菜单
            PopupMenu Me.mmu  '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
       
        Case WM_MOUSEMOVE
           
        Case WM_LBUTTONDOWN
       
        Case WM_LBUTTONDBLCLK
       
        Case WM_RBUTTONDOWN
       
        Case WM_RBUTTONDBLCLK
       
        Case Else
   
    End Select

End Sub

Private Sub HideMe()
    App.TaskVisible = False
    Me.Hide
End Sub

Private Sub SetStatusIcon()
    With nfIconData
        .hwnd = Me.hwnd
       
        .uID = Me.hwnd
       
        .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
       
        .uCallbackMessage = WM_MOUSEMOVE
       
        .hIcon = Me.Icon.Handle
       
        '定义鼠标移动到托盘上时显示的Tip
       
        .szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
       
        .cbSize = Len(nfIconData)
    End With
   
    Call Shell_NotifyIcon(NIM_ADD, nfIconData)
End Sub

Private Sub UpdateIconTime()
    With nfIconData
        .uFlags = NIF_TIP
       
        .szTip = Format(Now, "yyyy-MM-dd hh:nn:ss dddd") & vbNullChar
    End With
   
    Call Shell_NotifyIcon(NIM_MODIFY, nfIconData)
End Sub

Private Sub UpdateIcon()
    With nfIconData
        .uFlags = NIF_ICON
       
        .hIcon = Me.Icon.Handle
    End With
   
    Call Shell_NotifyIcon(NIM_MODIFY, nfIconData)
End Sub

Private Sub DelStatusIcon()
    Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub ShowMe()
    ShowWindow Me.hwnd, SW_RESTORE
    App.TaskVisible = True
    '下面两句的目的是把窗口显示在窗口最顶层
    Me.Show
    Me.SetFocus
End Sub

Private Sub Form_Load()
   
    Call SetIcon(101)

    Call SetStatusIcon
   
    Call HideMe

End Sub

Private Sub SetIcon(ByVal index As Integer)
    Me.Icon = LoadResPicture(index, vbResIcon)
End Sub