状态栏图标和通知

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