浏览器

开发平台：
Visual Basic

cSysTray.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 = "cSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'-------------------------------------------------------
' Control Property Globals...
'-------------------------------------------------------
Private gInTray As Boolean
Private gTrayId As Long
Private gTrayTip As String
'Private mvarpHwnd As Long
Private gTrayIcon As StdPicture
Private gAddedToTray As Boolean
Private mvarpHwnd As Long
Const MAX_SIZE = 510
Private Const defInTray = False
Private Const defTrayTip = "VB 5 - SysTray Control." & vbNullChar
'Private Const sInTray = "InTray"
'Private Const sTrayIcon = "TrayIcon"
'Private Const sTrayTip = "TrayTip"
'-------------------------------------------------------
' Control Events...
'-------------------------------------------------------
Public Event MouseMove(id As Long)
Public Event MouseDown(Button As Integer, id As Long)
Public Event MouseUp(Button As Integer, id As Long)
Public Event MouseDblClick(Button As Integer, id As Long)
Public Property Let pHwnd(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.pHwnd = 5
    mvarpHwnd = vData
End Property
Public Property Get pHwnd() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.pHwnd
    pHwnd = mvarpHwnd
End Property
'-------------------------------------------------------
Private Sub Class_Initialize()
'-------------------------------------------------------
    gInTray = defInTray                             ' Set global InTray defalt
    gAddedToTray = False                            ' Set default state
    gTrayId = 0                                     ' Set global TrayId default
'    gTrayHwnd = hwnd                                ' Set and keep HWND of user control
'-------------------------------------------------------
    gTrayTip = defTrayTip
    'InTray = defInTray                              ' Init InTray Property
    'TrayTip = defTrayTip                            ' Init TrayTip Property
    'Set TrayIcon = Picture                          ' Init TrayIcon property
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub Class_Terminate()
'-------------------------------------------------------
    If InTray Then                      ' If TrayIcon is visible
        InTray = False                  ' Cleanup and unplug it.
    End If
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Let TrayIcon(Icon As StdPicture)
'-------------------------------------------------------
    Dim Tray As NOTIFYICONDATA                          ' Notify Icon Data structure
    Dim rc As Long                                      ' API return code
'-------------------------------------------------------
    If Not (Icon Is Nothing) Then                       ' If icon is valid...
        If (Icon.Type = vbPicTypeIcon) Then             ' Use ONLY if it is an icon
            If gAddedToTray Then                        ' Modify tray only if it is in use.
                Tray.uID = gTrayId                      ' Unique ID for each HWND and callback message.
                Tray.hwnd = mvarpHwnd                   ' HWND receiving messages.
                Tray.hIcon = Icon.handle                ' Tray icon.
                Tray.uFlags = NIF_ICON                  ' Set flags for valid data items
                Tray.cbSize = Len(Tray)                 ' Size of struct.
                
                rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
            End If
    
            Set gTrayIcon = Icon                        ' Save Icon to global
            'Set Picture = Icon                          ' Show user change in control as well(gratuitous)
'            PropertyChanged sTrayIcon                   ' Notify control that property has changed.
        End If
    End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get TrayIcon() As StdPicture
'-------------------------------------------------------
    Set TrayIcon = gTrayIcon                        ' Return Icon value
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Let TrayTip(Tip As String)
'-------------------------------------------------------
    Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
    Dim rc As Long                                  ' API Return code
'-------------------------------------------------------
    If gAddedToTray Then                            ' if TrayIcon is in taskbar
        Tray.uID = gTrayId                          ' Unique ID for each HWND and callback message.
        Tray.hwnd = mvarpHwnd                       ' HWND receiving messages.
        Tray.szTip = Tip & vbNullChar               ' Tray tool tip
        Tray.uFlags = NIF_TIP                       ' Set flags for valid data items
        Tray.cbSize = Len(Tray)                     ' Size of struct.
        
        rc = Shell_NotifyIcon(NIM_MODIFY, Tray)     ' Send data to Sys Tray.
    End If
    
    gTrayTip = Tip                                  ' Save Tip
    'PropertyChanged sTrayTip                        ' Notify control that property has changed
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get TrayTip() As String
'-------------------------------------------------------
    TrayTip = gTrayTip                              ' Return Global Tip...
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Let InTray(Show As Boolean)
'-------------------------------------------------------
'    Dim ClassAddr As Long                           ' Address pointer to Control Instance
'-------------------------------------------------------
    If (Show <> gInTray) Then                       ' Modify ONLY if state is changing!
        If Show Then                                ' If adding Icon to system tray...
'            If Ambient.UserMode Then                ' If in RunMode and not in IDE...
                 ' SubClass Controls window proc.
                PrevWndProc = SetWindowLong(mvarpHwnd, GWL_WNDPROC, AddressOf SubWndProc)
                
                ' Get address to user control object
                'CopyMemory ClassAddr, class, 4&
                
                ' Save address to the USERDATA of the control's window struct.
                ' this will be used to get an object refenence to the control
                ' from an HWND in the callback.
                SetWindowLong mvarpHwnd, GWL_USERDATA, ObjPtr(Me) 'ClassAddr
                
                AddIcon mvarpHwnd, gTrayId, TrayTip, TrayIcon ' Add TrayIcon to System Tray...
                gAddedToTray = True                 ' Save state of control used in teardown procedure
'            End If
        Else                                        ' If removing Icon from system tray
            If gAddedToTray Then                    ' If Added to system tray then remove...
                DeleteIcon mvarpHwnd, gTrayId       ' Remove icon from system tray
                
                ' Un SubClass controls window proc.
                SetWindowLong mvarpHwnd, GWL_WNDPROC, PrevWndProc
                gAddedToTray = False                ' Maintain the state for teardown purposes
            End If
        End If
        
        gInTray = Show                              ' Update global variable
'        PropertyChanged sInTray                     ' Notify control that property has changed
    End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Public Property Get InTray() As Boolean
'-------------------------------------------------------
    InTray = gInTray                                ' Return global property
'-------------------------------------------------------
End Property
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub AddIcon(hwnd As Long, id As Long, Tip As String, Icon As StdPicture)
'-------------------------------------------------------
    Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
'    Dim tFlags As Long                              ' Tray action flag
    Dim rc As Long                                  ' API return code
'-------------------------------------------------------
    Tray.uID = id                                   ' Unique ID for each HWND and callback message.
    Tray.hwnd = hwnd                                ' HWND receiving messages.
    
    If Not (Icon Is Nothing) Then                   ' Validate Icon picture
        Tray.hIcon = Icon.handle                    ' Tray icon.
        Tray.uFlags = Tray.uFlags Or NIF_ICON       ' Set ICON flag to validate data item
        Set gTrayIcon = Icon                        ' Save icon
    End If
    
    If (Tip <> "") Then                             ' Validate Tip text
        Tray.szTip = Tip & vbNullChar               ' Tray tool tip
        Tray.uFlags = Tray.uFlags Or NIF_TIP        ' Set TIP flag to validate data item
        gTrayTip = Tip                              ' Save tool tip
    End If
    
    Tray.uCallbackMessage = TRAY_CALLBACK           ' Set user defigned message
    Tray.uFlags = Tray.uFlags Or NIF_MESSAGE        ' Set flags for valid data item
    Tray.cbSize = Len(Tray)                         ' Size of struct.
    
    rc = Shell_NotifyIcon(NIM_ADD, Tray)            ' Send data to Sys Tray.
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Private Sub DeleteIcon(hwnd As Long, id As Long)
'-------------------------------------------------------
    Dim Tray As mAPIs.NOTIFYICONDATA                       ' Notify Icon Data structure
    Dim rc As Long                                  ' API return code
'-------------------------------------------------------
    Tray.uID = id                                   ' Unique ID for each HWND and callback message.
    Tray.hwnd = hwnd                                ' HWND receiving messages.
    Tray.uFlags = 0&                                ' Set flags for valid data items
    Tray.cbSize = Len(Tray)                         ' Size of struct.
    
    rc = Shell_NotifyIcon(NIM_DELETE, Tray)         ' Send delete message.
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'-------------------------------------------------------
Friend Sub SendEvent(MouseEvent As Long, id As Long)
'-------------------------------------------------------
    Select Case MouseEvent                          ' Dispatch mouse events to control
    Case WM_MOUSEMOVE
        RaiseEvent MouseMove(id)
    Case WM_LBUTTONDOWN
        RaiseEvent MouseDown(vbLeftButton, id)
    Case WM_LBUTTONUP
        RaiseEvent MouseUp(vbLeftButton, id)
    Case WM_LBUTTONDBLCLK
        RaiseEvent MouseDblClick(vbLeftButton, id)
    Case WM_RBUTTONDOWN
        RaiseEvent MouseDown(vbRightButton, id)
    Case WM_RBUTTONUP
        RaiseEvent MouseUp(vbRightButton, id)
    Case WM_RBUTTONDBLCLK
        RaiseEvent MouseDblClick(vbRightButton, id)
    End Select
'-------------------------------------------------------
End Sub
'-------------------------------------------------------
'##############################################################
'-------------------------------------------------------
'-------------------------------------------------------
'Private Sub class_Paint()
''-------------------------------------------------------
'    Dim edge As RECT                                ' Rectangle edge of control
''-------------------------------------------------------
'    edge.Left = 0                                   ' Set rect edges to outer
'    edge.Top = 0                                    ' - most position in pixels
'    edge.Bottom = ScaleHeight                       '
'    edge.Right = ScaleWidth                         '
'    DrawEdge hDC, edge, BDR_RAISEDOUTER, BF_RECT Or BF_SOFT    ' Draw Edge...
''-------------------------------------------------------
'End Sub
''-------------------------------------------------------
'
''-------------------------------------------------------

						