clssystray.cls

邮件提醒程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SysTray"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'This code was written by Alan Toews, June 14, 2001
'Feel free to use or modify this code, but please
'do not take credit for it. If you use , find a bug,
'or have a suggestion, please let me know.
'Feedback encourages development, and is one of the few
'returns an author gets for distributing free code.
'You can contact me at:
'
'[e-mail]


Option Explicit

'apis for detecting explorer crash
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
'this type is necessary for the Shell_NotifyIcon API
Private Type NOTIFYICONDATA
 cbSize As Long
 hwnd As Long
 uId As Long
 uFlags As Long
 uCallBackMessage As Long
 hIcon As Long
 szTip As String * 64
End Type

'constants for use with SetWindowLong API
Private Const GWL_WNDPROC = (-4)
Private Const GWL_USERDATA = (-21)

'Constants for use with Shell_NotifyIcon API
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

'Constants for use with NOTIFYICONDATA Type
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

'Constants for use in Callback lParam value
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBCLICK = &H209

'API declarations for setting the tray icon
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'API declarations for capturing mouse events in the tray icon
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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

'Variables used to set & clear
'tray icon & callback functions
Private nidTray As NOTIFYICONDATA
Private WindowProc As Long

'public events to be raised when the user interacts with the icon
Public Event MouseDown(button As Integer)
Public Event MouseUp(button As Integer)
Public Event MouseMove()
Public Event Click(button As Integer)
Public Event DblClick(button As Integer)
Public Event Minimize()
Public Event Restore()
Public Event Refreshed()

'enumeration type used to set the tray click behaviors.
Public Enum stEnumTrayMenu
    stNone = &H0
    stOnLeftUp = &H1
    stOnRightUp = &H2
    stOnMiddleUp = &H4
    stOnLeftDown = &H8
    stOnRightDown = &H10
    stOnMiddleDown = &H20
    stOnLeftDblClick = &H40
    stOnRightDblClick = &H80
    stOnMiddleDblClick = &H100
    stOnAllClickEvents = &H1FF
End Enum

'enumeration to set tray icon behavior
Public Enum stEnumTrayStyle
    stHideFormWhenMin = 1
    stHideTrayWhenNotMin = 2
    stNormal = 0
End Enum

'Private property variables
Private stIcon As StdPicture    'Icon to use for the tray
Private stVisible As Boolean    'Is icon shown in the tray or not
Private WithEvents stForm As Form          'Parent form (needed for hWnd)
Attribute stForm.VB_VarHelpID = -1
Private WithEvents stTimer As Timer        'Timer object used for persistence
Attribute stTimer.VB_VarHelpID = -1
Private stMenu As Menu          'right click menu
Private sthWnd As Long
Private stTrayTip As String     'tool tip to appear when mouse is hovering over tray
Private stMenuStyle As stEnumTrayMenu
Private stTrayStyle As stEnumTrayStyle
Private stRestoreFromTray As stEnumTrayMenu
Private stPersistent As Boolean

'private variables
Private LastWindowState
Private LastTrayHWND As Long
'*********************************************
'Declare all properties here:
'*********************************************
Public Property Get Persistent() As Boolean
    Persistent = stTimer.Enabled
End Property
Public Property Let Persistent(NewVal As Boolean)
    stTimer.Interval = 1000
    stTimer.Enabled = NewVal
End Property
Public Property Get RestoreFromTrayOn() As stEnumTrayMenu
    RestoreFromTrayOn = stRestoreFromTray
End Property
Public Property Let RestoreFromTrayOn(NewVal As stEnumTrayMenu)
    stRestoreFromTray = NewVal
End Property
Public Property Get TrayFormStyle() As stEnumTrayStyle
    TrayFormStyle = stTrayStyle
End Property
Public Property Let TrayFormStyle(NewVal As stEnumTrayStyle)
    stTrayStyle = NewVal
    If CBool(stTrayStyle And stHideTrayWhenNotMin) Then If stForm.Visible Then RemoveFromTray
End Property

Public Property Get PopupStyle() As stEnumTrayMenu
    PopupStyle = stMenuStyle
End Property
Public Property Let PopupStyle(NewVal As stEnumTrayMenu)
    stMenuStyle = NewVal
End Property
Public Property Get Icon() As StdPicture
    Set Icon = stIcon
End Property
Public Property Let Icon(NewVal As StdPicture)
    'change the icon in the tray
    Set stIcon = NewVal
    
    'if the tray icon is loaded, then change it now.
    If Not stVisible Then Exit Property
    ' Update the tray icon.
    With nidTray
        .hIcon = stIcon.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, nidTray
End Property
Public Property Get Visible() As Boolean
    Visible = stVisible
End Property
Public Property Let Visible(NewVal As Boolean)
    'toggle whether the icon is loaded in the form or not
    ' the stvisible variable is set in each of the called functions
    'also, if we've set to hide the tray icon when the tray is visible, then
    'check that the form is not visible before showing
    
    If CBool(stTrayStyle And stHideTrayWhenNotMin) Then NewVal = Not stForm.Visible
    If NewVal = stVisible Then Exit Property
    If NewVal Then
        ShowInTray
    Else
        RemoveFromTray
    End If
End Property
Public Property Get Form() As Object
    Set Form = stForm
End Property
Public Property Let Form(NewVal As Object)
    'if the form changes, then make sure to
    'clear any popup menu specified.
    'if the user tries to call a popup menu on a form other than
    'the stForm form, then we'll get an error, or
    'the wrong form will be displayed.
    If NewVal Is Nothing Then Set NewVal = frmInternal
    
    If NewVal.Name <> stForm.Name Then
        Set stForm = NewVal
        Set stMenu = Nothing
        LastWindowState = stForm.WindowState
        If LastWindowState = vbMinimized Then LastWindowState = vbNormal
    End If
End Property
Public Property Get PopupMenu() As Object
    Set PopupMenu = stMenu
End Property
Public Property Let PopupMenu(NewVal As Object)