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
