clssystray.cls

自动检查邮件

    Set stMenu = NewVal
End Property
Public Property Get TrayTip() As String
    TrayTip = stTrayTip
End Property
Public Property Let TrayTip(NewVal As String)
    stTrayTip = NewVal
    
    'if the icon is in the tray, then
    'update the tip immediately
    If Not stVisible Then Exit Property
    With nidTray
        .szTip = stTrayTip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, nidTray
End Property

'*********************************************
'Declare all private subs & functions here:
'*********************************************
Private Sub ShowInTray()
    
    'On Error Resume Next
    With nidTray
        .cbSize = Len(nidTray)
        .hwnd = stForm.hwnd
        .uId = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE
        .hIcon = stIcon.Handle
        .szTip = stTrayTip & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, nidTray
    stVisible = True
    
    'set tray callback function
    WindowProc = SetWindowLong(stForm.hwnd, GWL_WNDPROC, AddressOf mCallbackFunction)
End Sub

Private Sub RemoveFromTray()
    'Disable callback
    SetWindowLong stForm.hwnd, GWL_WNDPROC, WindowProc
    
    'If Not stVisible Then Exit Sub
    Shell_NotifyIcon NIM_DELETE, nidTray
    stVisible = False

End Sub

Private Sub Class_Initialize()
    'grab the hWnd of the tray to make sure it is loaded
    LastTrayHWND = FindWindow("Shell_TrayWnd", vbNullString)
    
    'make sure that the form and menu variables point to somewhere.
    Set stForm = frmInternal
    Set stTimer = frmInternal.Timer1
    Set stIcon = frmInternal.Icon
    
    stMenuStyle = stOnRightUp
    Set stMenu = frmInternal.mPopup
    Init Me
    stRestoreFromTray = stOnLeftDblClick
End Sub

Private Sub Class_Terminate()
    'clean up behind us
    On Error Resume Next
    RemoveFromTray
    Set stForm = Nothing
    Set stIcon = Nothing
    Unload frmInternal
End Sub

Friend Function CallBack(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        
        'if the user clicked on the tray icon then
        'lets look at how they clicked and decide what to do.
        'when we set the tray icon, we gave it a callback message value of WM_MOUSEMOVE
        'if we receive that value, then we know its the tray icon responding.
        
        'the lParam value specifies what action was performed.
        'ie: left mouse down, middle mouse double click, etc..
        If Msg = WM_MOUSEMOVE Then
            'if no menu is specified, then set the display style to none
            If stMenu Is Nothing Then stMenuStyle = stNone
            'for each case we want to check whether the menu should be displayed or not
            Select Case lParam
                'case button is down
                Case WM_LBUTTONDOWN
                    If CBool(stRestoreFromTray And stOnLeftDown) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseDown(vbLeftButton)
                    If CBool(stMenuStyle And stOnLeftDown) Then stForm.PopupMenu stMenu
                Case WM_RBUTTONDOWN
                    If CBool(stRestoreFromTray And stOnRightDown) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseDown(vbRightButton)
                    If CBool(stMenuStyle And stOnRightDown) Then stForm.PopupMenu stMenu
                Case WM_MBUTTONDOWN
                    If CBool(stRestoreFromTray And stOnMiddleDown) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseDown(vbMiddleButton)
                    If CBool(stMenuStyle And stOnMiddleDown) Then stForm.PopupMenu stMenu
                    
                'case button double click
                Case WM_LBUTTONDBLCLK
                    If CBool(stRestoreFromTray And stOnLeftDblClick) And stForm.WindowState = vbMinimized Then FormRestore
                    If CBool(stMenuStyle And stOnLeftDblClick) Then stForm.PopupMenu stMenu
                    RaiseEvent DblClick(vbLeftButton)
                Case WM_RBUTTONDBLCLK
                    If CBool(stRestoreFromTray And stOnRightDblClick) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent DblClick(vbRightButton)
                    If CBool(stMenuStyle And stOnRightDblClick) Then stForm.PopupMenu stMenu
                Case WM_MBUTTONDBCLICK
                    If CBool(stRestoreFromTray And stOnMiddleDblClick) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent DblClick(vbMiddleButton)
                    If CBool(stMenuStyle And stOnMiddleDblClick) Then stForm.PopupMenu stMenu
                
                'case button up
                Case WM_LBUTTONUP
                    If CBool(stRestoreFromTray And stOnLeftUp) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseUp(vbLeftButton)
                    RaiseEvent Click(vbLeftButton)
                    If CBool(stMenuStyle And stOnLeftUp) Then stForm.PopupMenu stMenu
                Case WM_RBUTTONUP
                    If CBool(stRestoreFromTray And stOnRightUp) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseUp(vbRightButton)
                    RaiseEvent Click(vbRightButton)
                    If CBool(stMenuStyle And stOnRightUp) Then stForm.PopupMenu stMenu
                Case WM_MBUTTONUP
                    If CBool(stRestoreFromTray And stOnMiddleUp) And stForm.WindowState = vbMinimized Then FormRestore
                    RaiseEvent MouseUp(vbMiddleButton)
                    RaiseEvent Click(vbMiddleButton)
                    If CBool(stMenuStyle And stOnMiddleUp) Then stForm.PopupMenu stMenu
                    
                'case mouse moves
                Case WM_MOUSEMOVE
                    RaiseEvent MouseMove
            End Select
        End If
        
        CallBack = CallWindowProc(WindowProc, hwnd, Msg, wParam, lParam)
End Function

Private Sub stForm_Resize()
    If stForm.WindowState <> vbMinimized Then
        If Not stForm.Visible Then stForm.Visible = True
        LastWindowState = stForm.WindowState
    Else
        FormMinimize
    End If
End Sub

'*********************************************
'Declare all public subs & functions here:
'*********************************************
Public Sub ShowAbout()
    frmInternal.Show
End Sub
Public Sub FormMinimize()
    
    'stForm.Visible = True
    If stForm.WindowState <> vbMinimized Then stForm.WindowState = vbMinimized
    
    If CBool(stTrayStyle And stHideFormWhenMin) Then stForm.Visible = False
    If CBool(stTrayStyle And stHideTrayWhenNotMin) And Not stVisible Then ShowInTray
    RaiseEvent Minimize
End Sub
Public Sub FormRestore()
    
    'for some reason, this needs to be run more than once
    'I put in the loop, so that it will ensure that the
    'form will be restored on the first try by the user.
    Do While stForm.WindowState = vbMinimized
        '** the form must be visible before we resize it, or we will crash.
        stForm.Visible = True
        'safety check in case the LastWindowstate somehow got set to minimized
        If LastWindowState = vbMinimized Then LastWindowState = vbNormal
        stForm.WindowState = LastWindowState
        
    Loop
    stForm.SetFocus
    'if desired, remove the icon from the tray when restored.
    If CBool(stTrayStyle And stHideTrayWhenNotMin) And stVisible Then RemoveFromTray
    RaiseEvent Restore
End Sub


Private Sub stTimer_Timer()
    'this function checks the hWnd of the system tray
    'if the value changes, then we will reload the tray icon
    Dim tmp As Long, x As Long
    
    'get the hWnd value of the system tray
    tmp = FindWindow("Shell_TrayWnd", vbNullString)
    
    
    'check for a change from the last time, and make sure it is a valid hWnd
    If (tmp <> LastTrayHWND) And (tmp > 0) Then
        Debug.Print stVisible, stPersistent
        If stVisible Then
            
            'reset subclassing callback
            RemoveFromTray
            
            'replace the icon in the system tray once explorer has restarted
            ShowInTray
            RaiseEvent Refreshed

        End If
    End If
    
    LastTrayHWND = tmp
End Sub