systray.ctl

可以让您轻松设计WINDOWS托盘的控件源代码.

VERSION 5.00
Begin VB.UserControl cSysTray 
   BackColor       =   &H00FFFFFF&
   CanGetFocus     =   0   'False
   ClientHeight    =   240
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   615
   ClipControls    =   0   'False
   EditAtDesignTime=   -1  'True
   InvisibleAtRuntime=   -1  'True
   MouseIcon       =   "SysTray.ctx":0000
   ScaleHeight     =   16
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   41
   ToolboxBitmap   =   "SysTray.ctx":030A
End
Attribute VB_Name = "cSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'-------------------------------------------------------
' Control Property Globals...
'-------------------------------------------------------
Private gInTray As Boolean
Private gTrayId As Long
Private gTrayTip As String
Private gTrayHwnd As Long
Private gTrayIcon As StdPicture
Private gAddedToTray As Boolean
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)

'-------------------------------------------------------
Private Sub UserControl_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
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_InitProperties()
'-------------------------------------------------------
    InTray = defInTray                              ' Init InTray Property
    TrayTip = defTrayTip                            ' Init TrayTip Property
    Set TrayIcon = Picture                          ' Init TrayIcon property
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_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
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'-------------------------------------------------------
    ' Read in the properties that have been saved into the PropertyBag...
    With PropBag
        InTray = .ReadProperty(sInTray, defInTray)       ' Get InTray
        Set TrayIcon = .ReadProperty(sTrayIcon, Picture) ' Get TrayIcon
        TrayTip = .ReadProperty(sTrayTip, defTrayTip)    ' Get TrayTip
    End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'-------------------------------------------------------
    With PropBag
        .WriteProperty sInTray, gInTray                 ' Save InTray to propertybag
        .WriteProperty sTrayIcon, gTrayIcon             ' Save TrayIcon to propertybag
        .WriteProperty sTrayTip, gTrayTip               ' Save TrayTip to propertybag
    End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_Resize()
'-------------------------------------------------------
    Height = MAX_SIZE                   ' Prevent Control from being resized...
    Width = MAX_SIZE
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_Terminate()
'-------------------------------------------------------
    If InTray Then                      ' If TrayIcon is visible
        InTray = False                  ' Cleanup and unplug it.
    End If
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Set 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 = gTrayHwnd                   ' 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