vbAccelerator - Contents of code file: fSysTray.frm

Begin VB.Form frmSysTray 
   Caption         =   "Sys Tray Interface"
   ClientHeight    =   225
   ClientLeft      =   5610
   ClientTop       =   3360
   ClientWidth     =   3105
   Icon            =   "fSysTray.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   225
   ScaleWidth      =   3105
   Begin VB.Menu mnuPopup 
      Caption         =   "&Popup"
      Begin VB.Menu mnuSysTray 
         Caption         =   ""
         Index           =   0
Attribute VB_Name = "frmSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' frmSysTray.
' Steve McMahon
' based on code supplied from Ben Baird:

'        Ben Baird <psyborg@cyberhighway.com>
'        Copyright (c) 1997, Ben Baird
'        Demonstrates setting an icon in the taskbar's
'        system tray without the overhead of subclassing
'        to receive events.

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias
 "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Const WM_MOUSEMOVE = &H200
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const MAX_TOOLTIP As Integer = 64
    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
Private nfIconData As NOTIFYICONDATA

Public Event SysTrayMouseDown(ByVal eButton As MouseButtonConstants)
Public Event SysTrayMouseUp(ByVal eButton As MouseButtonConstants)
Public Event SysTrayMouseMove()
Public Event SysTrayDoubleClick(ByVal eButton As MouseButtonConstants)
Public Event MenuClick(ByVal lIndex As Long, ByVal sKey As String)

Private m_bAddedMenuItem As Boolean
Private m_iDefaultIndex As Long

Public Property Get ToolTip() As String
Dim sTip As String
Dim iPos As Long
    sTip = nfIconData.szTip
    iPos = InStr(sTip, Chr$(0))
    If (iPos <> 0) Then
        sTip = Left$(sTip, iPos - 1)
    End If
    ToolTip = sTip
End Property
Public Property Let ToolTip(ByVal sTip As String)
    If (sTip & Chr$(0) <> nfIconData.szTip) Then
        nfIconData.szTip = sTip & Chr$(0)
        nfIconData.uFlags = NIF_TIP
        Shell_NotifyIcon NIM_MODIFY, nfIconData
    End If
End Property
Public Property Get IconHandle() As Long
    IconHandle = nfIconData.hIcon
End Property
Public Property Let IconHandle(ByVal hIcon As Long)
    If (hIcon <> nfIconData.hIcon) Then
        nfIconData.hIcon = hIcon
        nfIconData.uFlags = NIF_ICON
        Shell_NotifyIcon NIM_MODIFY, nfIconData
    End If
End Property
Public Function AddMenuItem(ByVal sCaption As String, Optional ByVal sKey As
 String = "", Optional ByVal bDefault As Boolean = False) As Long
Dim iIndex As Long
    If Not (m_bAddedMenuItem) Then
        iIndex = 0
        m_bAddedMenuItem = True
        iIndex = mnuSysTray.UBound + 1
        Load mnuSysTray(iIndex)
    End If
    mnuSysTray(iIndex).Visible = True
    mnuSysTray(iIndex).Tag = sKey
    mnuSysTray(iIndex).Caption = sCaption
    If (bDefault) Then
        m_iDefaultIndex = iIndex
    End If
    AddMenuItem = iIndex
End Function
Private Function ValidIndex(ByVal lIndex As Long) As Boolean
    ValidIndex = (lIndex >= mnuSysTray.LBound And lIndex <= mnuSysTray.UBound)
End Function
Public Sub EnableMenuItem(ByVal lIndex As Long, ByVal bState As Boolean)
    If (ValidIndex(lIndex)) Then
        mnuSysTray(lIndex).Enabled = bState
    End If
End Sub
Public Function RemoveMenuItem(ByVal iIndex As Long) As Long
Dim i As Long
    If ValidIndex(iIndex) Then
        If (iIndex = 0) Then
            mnuSysTray(0).Caption = ""
            ' remove the item:
            For i = iIndex + 1 To mnuSysTray.UBound
                mnuSysTray(iIndex - 1).Caption = mnuSysTray(iIndex).Caption
                mnuSysTray(iIndex - 1).Tag = mnuSysTray(iIndex).Tag
            Next i
            Unload mnuSysTray(mnuSysTray.UBound)
        End If
    End If
End Function
Public Property Get DefaultMenuIndex() As Long
    DefaultMenuIndex = m_iDefaultIndex
End Property
Public Property Let DefaultMenuIndex(ByVal lIndex As Long)
    If (ValidIndex(lIndex)) Then
        m_iDefaultIndex = lIndex
        m_iDefaultIndex = 0
    End If
End Property
Public Function ShowMenu()
    If (m_iDefaultIndex > -1) Then
        Me.PopupMenu mnuPopup, 0, , , mnuSysTray(m_iDefaultIndex)
        Me.PopupMenu mnuPopup, 0
    End If
End Function

Private Sub Form_Load()
    'Add the icon to the system tray...
    With nfIconData
        .hwnd = Me.hwnd
        .uID = Me.Icon
        .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon.Handle
        .szTip = App.FileDescription & Chr$(0)
        .cbSize = Len(nfIconData)
    End With
    Shell_NotifyIcon NIM_ADD, nfIconData
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y
 As Single)

    Select Case x
    Case 7680 'MouseMove
        RaiseEvent SysTrayMouseMove
    Case 7695 'LeftMouseDown
        RaiseEvent SysTrayMouseDown(vbLeftButton)
    Case 7710 'LeftMouseUp
        RaiseEvent SysTrayMouseUp(vbLeftButton)
    Case 7725 'LeftDblClick
        RaiseEvent SysTrayDoubleClick(vbLeftButton)
    Case 7740 'RightMouseDown
        RaiseEvent SysTrayMouseDown(vbRightButton)
    Case 7755 'RightMouseUp
        RaiseEvent SysTrayMouseUp(vbRightButton)
    Case 7770 'RightDblClick
        RaiseEvent SysTrayDoubleClick(vbRightButton)
    End Select

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub

Private Sub mnuSysTray_Click(Index As Integer)
    RaiseEvent MenuClick(Index, mnuSysTray(Index).Tag)
End Sub