NotifyIconCtrl.ctl

 VERSION 5.00
Begin VB.UserControl NotifyIconCtrl
   ClientHeight    =   420
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   870
   HasDC           =   0   'False
   InvisibleAtRuntime=   -1  'True
   Picture         =   "NotifyIconCtrl.ctx":0000
   ScaleHeight     =   28
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   58
   ToolboxBitmap   =   "NotifyIconCtrl.ctx":1314
End
Attribute VB_Name = "NotifyIconCtrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
''' NotifyIconCtrl  v2.0

' Taskbar Notification Icon ActiveX Control
' Includes support for new Windows 2000 NotifyIcon balloon help functionality
' Internal Menus collection via the CtrlPopupMenu class and the TrackMenu() function

''' An Icon control for Windows 2000 written in Visual Basic

''' Copyright (C) 2000 Nathan Moschkin.

''' Free to copy and distribute, intact.  Give credit to me and anyone else
''' who may edit this code.

''' and be sure to comment!

''' Please inquire before using any of this code or the OCX control commercially.
''' All Rights Reserved.

''' E-Mail questions or comments to nmosch@tampabay.rr.com


Option Explicit

' Open the popup menu, optionally need to get the location so we declare GetCursorPos, too.

Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const WM_USER = &H400
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_MOUSEMOVE = &H200
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_CONTEXTMENU = &H7B

' Old NotifyIconData

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

' NotifyIconData for Window NT 5.0 (Windows 2000)

Private Type NOTIFYICONDATA5
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type
 
' Shell_NotifyIcon features for Windows NT 5.0 (Windows 2000)

Private Const NIN_SELECT = (WM_USER + 0)
Private Const NINF_KEY = &H1
Private Const NIN_KEYSELECT = (NIN_SELECT + NINF_KEY)
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NOTIFYICON_VERSION = 3
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10

Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2

' Regular NotifyIcon Features for Windows 95/98/NT

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

' Notify Icon Infotip flags

Private Const NIIF_NONE = &H0

' icon flags are mutualy exclusive
' and take only the lowest 2 bits

Private Const NIIF_INFO = &H1
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3

' Notify Icon Balloon Icon constants

Public Enum NII
    None = &H0
    Info = &H1
    Warning = &H2
    Error = &H3
End Enum

' Events that are raised by this control

Public Event MouseMove()
Public Event MouseDown(Button As Integer)
Public Event MouseUp(Button As Integer)
Public Event DblClick(Button As Integer)
Public Event ContextMenu()
Public Event Click(Button As Integer)

' Get current OS version

Private Declare Function GetVersion Lib "kernel32" () As Long

' Shell_NotifyIconA if OSVersion <= 4

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

' Shell_NotifyIconA if OSVersion >= 5

Private Declare Function Shell_NotifyIcon5 Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA5) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal hBitmap As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

' Private variables to hold public property values

Private mIcon As StdPicture
Private mVisible As Boolean

Private mToolTip As String
Private mDisabledToolTip As String

Private mhIcon As OLE_HANDLE
Private mVersion As Long
Private mImgList As ImageList

' Disabled text and title

Private mDisabledBalloonTitle As String
Private mDisabledBalloonText As String
Private mDisabledBalloonIcon As NII

' Balloon title and text properties

Private mBalloonTitle As String
Private mBalloonText As String
Private mBalloonIcon As NII

' Enabled property

Private mEnabled As Boolean

' Popup Menu collection

Private mMenuPopup As CtrlPopupMenu

' More private API constants

Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3

Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_VGACOLOR = &H80
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBSECTION = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' Local NOTIFYICONDATA

Private IData As NOTIFYICONDATA
Private IData5 As NOTIFYICONDATA5

Private OSV5 As Boolean

' Balloon icon property (W2K)

Public Property Let BalloonIcon(ByVal vData As NII)
    mBalloonIcon = vData
    PropertyChanged "BalloonIcon"
End Property

Public Property Get BalloonIcon() As NII
    BalloonIcon = mBalloonIcon
End Property

' Balloon Title property (W2K)

Public Property Let BalloonTitle(ByVal vData As String)
    mBalloonTitle = StrFix(vData, 63)
    PropertyChanged "BalloonTitle"
End Property

Public Property Get BalloonTitle() As String
    BalloonTitle = mBalloonTitle
End Property

' balloon text property (W2K)
Public Property Get BalloonText() As String
    BalloonText = mBalloonText
End Property

Public Property Let BalloonText(ByVal vData As String)
    mBalloonText = StrFix(vData, 255)
    PropertyChanged "BalloonText"
End Property


Public Property Let DisabledBalloonIcon(ByVal vData As NII)
    mDisabledBalloonIcon = vData
    PropertyChanged "DisabledBalloonIcon"
End Property

Public Property Get DisabledBalloonIcon() As NII
    DisabledBalloonIcon = mDisabledBalloonIcon
End Property

' DisabledBalloon Title property (W2K)

Public Property Let DisabledBalloonTitle(ByVal vData As String)
    mDisabledBalloonTitle = StrFix(vData, 63)
    PropertyChanged "DisabledBalloonTitle"
End Property

Public Property Get DisabledBalloonTitle() As String
    DisabledBalloonTitle = mDisabledBalloonTitle
End Property

' DisabledBalloon text property (W2K)
Public Property Get DisabledBalloonText() As String
    DisabledBalloonText = mDisabledBalloonText
End Property

Public Property Let DisabledBalloonText(ByVal vData As String)
    mDisabledBalloonText = StrFix(vData, 255)
    PropertyChanged "DisabledBalloonText"
End Property

' Truncate a long string and/or pad a short string

Private Function StrFix(ByVal sz As String, ByVal uLen As Long, Optional ByVal LengthFix As Boolean = False) As String

    Dim i As Long, x As String
   
    If Len(sz) > uLen Then
        x = Mid(sz, 1, uLen)
    Else
        If LengthFix = True Then
            i = uLen = Len(sz)
            x = sz + String(i, 0)
        Else
            x = sz
        End If
    End If
   
    StrFix = x
End Function

' Handle to the icon on the taskbar (Read only)

Public Property Get hIcon() As Long
    hIcon = mhIcon
End Property

' Change the tool tip by calling the notify function

Private Sub SetTip()
    If mVisible = True Then
        If mEnabled = True Then
            If OSV5 = True Then
                IData5.uFlags = NIF_TIP
                IData5.szTip = TipStr(mToolTip)
                Shell_NotifyIcon5 NIM_MODIFY, IData5
            Else
                IData.uFlags = NIF_TIP
                IData.szTip = TipStr(mToolTip)
                Shell_NotifyIcon NIM_MODIFY, IData
            End If
        Else
            If OSV5 = True Then
                IData5.uFlags = NIF_TIP
                IData5.szTip = TipStr(mDisabledToolTip)
                Shell_NotifyIcon5 NIM_MODIFY, IData5
            Else
                IData.uFlags = NIF_TIP
                IData.szTip = TipStr(mDisabledToolTip)
                Shell_NotifyIcon NIM_MODIFY, IData
            End If
        End If
    End If
End Sub

Public Property Get PopupMenu() As CtrlPopupMenu
    Set PopupMenu = mMenuPopup
End Property

Public Property Set PopupMenu(vData As CtrlPopupMenu)
    Set mMenuPopup = vData
   
End Property

' Set the icon invisible or visible
' this function does not implement the hide feature of Windows 2000, but
' instead simply destroys the icon.

Private Function SetVisible(ByVal vData As Boolean) As Boolean
    Dim i As Long
   
    If Not mIcon Is Nothing Then
        If OSV5 = True Then
            IData5.hwnd = hwnd
            IData5.cbSize = Len(IData5)
            IData5.uFlags = NIF_ICON + NIF_MESSAGE
            IData5.uCallbackMessage = &H200
            IData5.szTip = TipStr(mToolTip)
            IData5.hIcon = mhIcon
            IData5.uVersion = NOTIFYICON_VERSION
            IData5.uID = vbNull
            If vData = True Then
                i = Shell_NotifyIcon5(NIM_MODIFY, IData5)
                If i = 0 Then
                    i = Shell_NotifyIcon5(NIM_ADD, IData5)
                    If i <> 0 Then
                        Shell_NotifyIcon5 NIM_SETVERSION, IData5
                    Else
                        SetVisible = False
                        Exit Function
                    End If
                End If
            Else
                Shell_NotifyIcon5 NIM_DELETE, IData5
            End If
        Else
            IData.hwnd = hwnd
            IData.cbSize = Len(IData)
            IData.uFlags = NIF_ICON + NIF_MESSAGE
            IData.uCallbackMessage = &H200
            IData.szTip = TipStr(mToolTip)
            IData.hIcon = mhIcon
            IData.uID = vbNull
            If vData = True Then
                i = Shell_NotifyIcon(NIM_MODIFY, IData)
                If i = 0 Then
                    i = Shell_NotifyIcon(NIM_ADD, IData)
                    If i = 0 Then
                        SetVisible = False
                        Exit Function
                    End If
                End If
            Else
                Shell_NotifyIcon NIM_DELETE, IData
            End If
        End If
    End If
   
    SetVisible = vData
   
End Function

Public Property Let Enabled(ByVal vData As Boolean)
    mEnabled = vData
    PropertyChanged "Enabled"
End Property

Public Property Get Enabled() As Boolean
    Enabled = mEnabled
End Property

' Public 'Visible' property, sets the icon visible or invisible.
' setting the property changes the state.

Public Property Let Visible(ByVal vData As Boolean)
    On Error Resume Next
   
    If mIcon Is Nothing Then
        mVisible = False
    Else
        mVisible = vData
    End If
   
    If mVisible = False Then
        SetVisible (False)
    Else
        SetVisible (True)
    End If
   
    PropertyChanged "Visible"
End Property

Public Property Get Visible() As Boolean
    Visible = mVisible
End Property

Private Sub UserControl_Initialize()
    Dim iKey As Long
    Dim v As String
   
    mVersion = GetVersion
   
    ' Get the Windows version
   
    If (mVersion And &HFF) = 5 Then
        ' This is Windows 2000
       
        OSV5 = True
    End If
   
    ' two different scenarios for working with
    ' old and new Windows icons
   
   
    If OSV5 = True Then
   
        IData5.cbSize = Len(IData5)
        IData5.uID = vbNull
        IData5.uCallbackMessage = &H200
        IData5.szTip = String(128, 0)
        IData5.szInfo = String(256, 0)
        IData5.szInfoTitle = String(64, 0)
        IData5.uVersion = NOTIFYICON_VERSION
        IData5.uFlags = 0
       
    Else
   
        IData.cbSize = Len(IData)
        IData.uID = vbNull
        IData.uCallbackMessage = &H200
        IData.szTip = String(64, 0)
   
    End If
   
    Set mMenuPopup = New CtrlPopupMenu
   
End Sub

' Get the tip string (can be 128 or 64 bytes depending on the OS version)

Private Function TipStr(vData As String) As String

    If OSV5 = True Then
       
        TipStr = StrFix(vData, 127, True)
    Else
   
        TipStr = StrFix(vData, 63, True)
    End If
    TipStr = TipStr + Chr(0)
End Function

' MOUSEMOVE is passed as the windowproc function
' that this windowed control receives when the mouse
' is activated over the taskbar icon.

' the actual event is passed in the 'X' parameter; no other parameters
' are available for the event, so in order to get the x and y values
' of the cursor position, you should call the GetCursorPos () API function


Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Static LastEvent As Integer
   
    If mEnabled = False Then Exit Sub
   
    If x = WM_LBUTTONDBLCLK Then
        RaiseEvent DblClick(1)
   
    ElseIf x = WM_RBUTTONDBLCLK Then
        RaiseEvent DblClick(2)
   
    ElseIf x = WM_MBUTTONDBLCLK Then
        RaiseEvent DblClick(3)
   
    ElseIf x = WM_LBUTTONUP Then
        RaiseEvent MouseUp(1)
        RaiseEvent Click(1)
   
    ElseIf x = WM_RBUTTONUP Then
        RaiseEvent MouseUp(2)
        RaiseEvent Click(2)
   
    ElseIf x = WM_MBUTTONUP Then
        RaiseEvent MouseUp(3)
        RaiseEvent Click(3)
   
    ElseIf x = WM_LBUTTONDOWN Then
        RaiseEvent MouseDown(1)
   
    ElseIf x = WM_RBUTTONDOWN Then
        RaiseEvent MouseDown(2)
   
    ElseIf x = WM_MBUTTONDOWN Then
        RaiseEvent MouseDown(3)
   
    ElseIf x = WM_MOUSEMOVE Then
        RaiseEvent MouseMove
   
    ElseIf x = WM_CONTEXTMENU Then
        RaiseEvent ContextMenu
    End If
   
    LastEvent = x
   
End Sub

' This 'usercontrol' portion is never visible, and contains only a
' picture, never allow resizing

Private Sub UserControl_Resize()
    UserControl.Height = 400
    UserControl.Width = 850
End Sub

' Persist the properties

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Icon", mIcon
    PropBag.WriteProperty "ToolTip", mToolTip, vbNullString
    PropBag.WriteProperty "DisabledToolTip", mDisabledToolTip, vbNullString
    PropBag.WriteProperty "Visible", mVisible, False
   
    PropBag.WriteProperty "BalloonText", mBalloonText, vbNullString
    PropBag.WriteProperty "BalloonTitle", mBalloonTitle, vbNullString
    PropBag.WriteProperty "BalloonIcon", mBalloonIcon, 0
    PropBag.WriteProperty "DisabledBalloonText", mDisabledBalloonText, vbNullString
    PropBag.WriteProperty "DisabledBalloonTitle", mDisabledBalloonTitle, vbNullString
    PropBag.WriteProperty "DisabledBalloonIcon", mDisabledBalloonIcon, 0
    PropBag.WriteProperty "Enabled", mEnabled, True
End Sub

' when this sub is called, it calls the notifyicon function
' to show the balloon.  the default timeout is 30000 milliseconds (30 seconds)

' once the balloon show message is posted, the modify flag is called with
' the NIF_TIP value set, setting the tip to normal.

' When you set the tip to normal, the next time the user hovers over the icon, it will
' display a normal tool tip.  Setting the tip back to normal immediately does not
' affect the balloon when it's already visible.

Public Sub ShowBalloon(Optional umTimeout As Long = 30000)

    If OSV5 = True Then
        If mEnabled = True Then
            IData5.hwnd = hwnd
            IData5.uID = vbNull
            IData5.uFlags = NIF_INFO
            IData5.uVersion = umTimeout
            IData5.szInfo = StrFix(mBalloonText, 255, True) + Chr(0)
            IData5.szInfoTitle = StrFix(mBalloonTitle, 63, True) + Chr(0)
            IData5.dwInfoFlags = mBalloonIcon
            IData5.cbSize = Len(IData5)
            Shell_NotifyIcon5 NIM_MODIFY, IData5
           
            IData5.szTip = StrFix(mToolTip, 127, True) + Chr(0)
            IData5.uFlags = NIF_TIP
            Shell_NotifyIcon5 NIM_MODIFY, IData5
       
        Else
            IData5.hwnd = hwnd
            IData5.uID = vbNull
            IData5.uFlags = NIF_INFO
            IData5.uVersion = umTimeout
            IData5.szInfo = StrFix(mDisabledBalloonText, 255, True) + Chr(0)
            IData5.szInfoTitle = StrFix(mDisabledBalloonTitle, 63, True) + Chr(0)
            IData5.dwInfoFlags = mDisabledBalloonIcon
            IData5.cbSize = Len(IData5)
            Shell_NotifyIcon5 NIM_MODIFY, IData5
           
            IData5.szTip = StrFix(mToolTip, 127, True) + Chr(0)
            IData5.uFlags = NIF_TIP
            Shell_NotifyIcon5 NIM_MODIFY, IData5
        End If
    End If
   
End Sub

' Read saved data

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   
    IData.hwnd = hwnd
   
    mBalloonIcon = PropBag.ReadProperty("BalloonIcon", 0)
    mBalloonText = PropBag.ReadProperty("BalloonText", vbNullString)
    mBalloonTitle = PropBag.ReadProperty("BalloonTitle", vbNullString)
    mDisabledBalloonIcon = PropBag.ReadProperty("DisabledBalloonIcon", 0)
    mDisabledBalloonText = PropBag.ReadProperty("DisabledBalloonText", vbNullString)
    mDisabledBalloonTitle = PropBag.ReadProperty("DisabledBalloonTitle", vbNullString)
    mVisible = PropBag.ReadProperty("Visible", False)
    Set Icon = PropBag.ReadProperty("Icon", Nothing)
    ToolTip = PropBag.ReadProperty("ToolTip", vbNullString)
    mDisabledToolTip = PropBag.ReadProperty("DisabledToolTip", vbNullString)
    mEnabled = PropBag.ReadProperty("Enabled", True)
   
       
   
End Sub

' The icon is any picture

Public Property Get Icon() As StdPicture
   
    Set Icon = mIcon

End Property

Private Sub UserControl_Terminate()
    SetVisible False
    DoEvents
End Sub

Public Property Set Icon(vData As StdPicture)
    On Error Resume Next
    Set mIcon = vData
   
    If Not mIcon Is Nothing Then
        ' Copy the image to a new icon handle.  No matter what
        ' kind of image, it will be able to be displayed
       
        mhIcon = CopyImage(mIcon.Handle, IMAGE_ICON, 16, 16, &H44)
        SetVisible mVisible
    Else
        Visible = False
    End If
   
    PropertyChanged "Icon"
   
End Property

' the normal tooltip property

Public Property Let ToolTip(vData As String)
    If OSV5 = True Then
        mToolTip = StrFix(vData, 127)
    Else
        mToolTip = StrFix(vData, 63)
    End If
   
    SetTip
    PropertyChanged "ToolTip"
End Property

Public Property Get ToolTip() As String
    ToolTip = mToolTip
End Property


Public Property Let DisabledToolTip(vData As String)
    If OSV5 = True Then
        mDisabledToolTip = StrFix(vData, 127)
    Else
        mDisabledToolTip = StrFix(vData, 63)
    End If
   
    SetTip
    PropertyChanged "DisabledToolTip"
End Property

Public Property Get DisabledToolTip() As String
    DisabledToolTip = mDisabledToolTip
End Property

' This is the TrackMenu function.  This will call
' the track menu API to open the menu we have created with the CtrlPopupMenu class structure.

Public Function TrackMenu(Optional ByVal x As Integer, Optional ByVal y As Integer) As CtrlPopupMenu
    Dim r As RECT, i As Integer, uV As POINTAPI
   
    If (x <> 0) And (y <> 0) Then
        uV.x = x
        uV.y = y
    Else
        GetCursorPos uV
    End If
   
    i = (TrackPopupMenu(mMenuPopup.hMenu, &H100, uV.x, uV.y, 0, hwnd, r) And &HFFFF)
   
    ' The search function will read the whole data collection.
    ' If it is textual, then it will search every menu and every
    ' submenu of every menu and so forth looking for a matching key.
    ' If it's an integer value, then we assume, that it refers directly to the
    ' MenuID assigned by the GetCtrlID function in CtrlPopupMenu
       
    ' Set the object returned by the search.  Now we know what the user selected.
   
    Set TrackMenu = mMenuPopup.Search(i)
       
       
End Function

Project Homepage: