[VBnet Subclassing] Shell_NotifyIcon: Animate the System Tray Icon


	Visual Basic Subclassing Routines Animating the Display of a System Tray Icon

Posted:	Tuesday January 29, 2002
Updated:	Monday December 26, 2011

Applies to:	VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	None
Author:	VBnet - Randy Birch, MSDN

Related:	Shell_NotifyIcon: Windows Systray NOTIFYICONDATA Overview Shell_NotifyIcon: Add Icon to Windows System Tray Shell_NotifyIcon: Respond to Systray Icon/Menu Interaction Shell_NotifyIcon: Respond to Systray Icon/Menu Interaction in a MDI App Shell_NotifyIcon: Animate the System Tray Icon Shell_NotifyIcon: Display Systray Balloon Tips Shell_NotifyIcon: Respond to Systray Balloon Tip Clicks Shell_NotifyIcon: Use SetTimer to Define Balloon Tip Life

Prerequisites

VB5 or VB6 to support AddressOf.

This demo contains new code added January 2003 to properly determine the Shell32.dll version and use the appropriately-sized NOTIFYICONDATA structure. Although this will handle the display of the systray icon across Windows versions, application designers targeting Windows 2000 and XP should nonetheless take appropriate steps to ensure their app degrades gracefully to utilize only the functionality provided in earlier system's shell versions. For information concerning using the systray across all Windows versions it is strongly recommended you refer to Shell_NotifyIcon: Windows Systray NOTIFYICONDATA Overview.

I've got so many unpublished code routines and pages it is not funny... there's just not enough time with the background research involved. This is a perfect example .. I wrote my first version of this in early 1996 with VB4-32 and Windows 95.

Anyone who's watched Windows' modem status, network traffic or NT Task Manager CPU load systray icons might have wondered how Windows creates the animation icon effect on a systray icon.

Ported from an old C code example in the 1995 MSDN, this demo show how to correctly create and install a systray icon, modify its tool tip, show a menu from the tray icon, and cycle through a series of icons pre-loaded into an imagelist to create a systray animation. (The original VB4-32 did not support subclassing so my old version used the WM_RBUTTONUP message and the screen coordinate Magic Number to circumvent the need for subclassing in activating the systray icon's menu. That method was (and remains), at best, a hack.

This application uses a VB menu for the systray context menu (set to visible for the illustration), and also contains two controls not shown - a VB Timer and a VB Imagelist. The interface of the app contains four primary areas:

1. The menu, which for this demo should be created as per the instructions below.
2. The "Enable Tray Icon" checkbox - checking / unchecking this loads and unloads the systray icon, turning on / off subclassing of the app.
3. The "Tool Tip" area. At any point the current text can be edited, and hitting Change Tip applies the new tip to the systray icon.
4. The "Cycle Icons" area. Although beating to the heart of the systray animation system, the option buttons themselves are actually unneeded and are for display simply to provide a visual look at what the timer control is doing. The 16 icons for the demo shown can be obtained from the file available here.

When the "Cycle Icon States" check box is unchecked, you can click any of the 16 buttons to have the app switch the systray icon to the selected image (called 'states' on the form). When the check is active control of the icon display is transferred to a Timer control on the form which calls the modify method every interval, specifying an new icon from the imagelist. An Exit Sub test assures that clicking the option buttons while animating does not affect the display.

The Hide Window button will set the form to invisible; it can be reactivated through the systray menu.

BAS Module Code

The WindowProc code for subclassing and the generic the shell version determination code is utilized in a BAS module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'defWindowProc: Variable to hold the ID of the
'               default window message processing
'               procedure. Returned by SetWindlowLong.
Public defWindowProc As Long

'mouse constant we'll need for the callback
Public Const WM_RBUTTONUP As Long = &H205

'Get/SetWindowLong messages
Private Const GWL_WNDPROC As Long = (-4)
Private Const GWL_HWNDPARENT As Long = (-8)
Private Const GWL_ID As Long = (-12)
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)
Private Const GWL_USERDATA As Long = (-21)

'general windows messages
Private Const WM_USER As Long = &H400
Private Const WM_APP As Long = &H8000&
Public Const WM_MYHOOK As Long = WM_APP + &H15
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_COMMAND As Long = &H111

'shell version / NOTIFIYICONDATA struct size constants
Public Const NOTIFYICONDATA_V1_SIZE As Long = 88  'pre-5.0 structure size
Public Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Public Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Public NOTIFYICONDATA_SIZE As Long

Private Declare Function SetForegroundWindow Lib "user32" _
   (ByVal hWnd As Long) As Long
   
Private Declare Function PostMessageLong Lib "user32" _
   Alias "PostMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
Private Declare Function SetWindowLong Lib "user32" _
   Alias "SetWindowLongA" _
   (ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Any) As Long

Private Declare Function CallWindowProc Lib "user32" _
   Alias "CallWindowProcA" _
   (ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long

Private Declare Function GetFileVersionInfo Lib "version.dll" _
   Alias "GetFileVersionInfoA" _
  (ByVal lptstrFilename As String, _
   ByVal dwHandle As Long, _
   ByVal dwLen As Long, _
   lpData As Any) As Long
   
Private Declare Function VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   lpBuffer As Any, _
   nVerSize As Long) As Long

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

Public Function WindowProc(ByVal hWnd As Long, _
                           ByVal uMsg As Long, _
                           ByVal wParam As Long, _
                           ByVal lParam As Long) As Long

  'window message procedure
  '
  'If the handle returned is to our form,
  'call a form-specific message handler to
  'deal with the tray notifications.  If it
  'is a general system message, pass it on to
  'the default window procedure.
  '
  'If its ours, we look at lParam for the
  'message generated, and react appropriately.
   On Error Resume Next
  
   Select Case hWnd
   
     'form-specific handler
      Case Form1.hWnd
         
         Select Case uMsg
           'WM_MYHOOK was defined as
           'the .uCallbackMessage
           'message of NOTIFYICONDATA
            Case WM_MYHOOK
            
              'maintain focus on the app
              'window to assure the menu
              'disappears should the mouse
              'be clicked outside the menu
               Call SetForegroundWindow(Form1.hWnd)
           
              'lParam is the value of the message
              'that generated the tray notification.
               Select Case lParam
                  Case WM_RBUTTONUP:
                     With Form1
                        .PopupMenu .mnuOptions
                     End With
               End Select
            
            Case Else
              'handle any other form messages by
              'passing to the default message proc
               WindowProc = CallWindowProc(defWindowProc, _
                                            hWnd, _
                                            uMsg, _
                                            wParam, _
                                            lParam)
               Exit Function
            
         End Select

     
     'this takes care of messages when the
     'handle specified is not that of the form
      Case Else
      
          WindowProc = CallWindowProc(defWindowProc, _
                                      hWnd, _
                                      uMsg, _
                                      wParam, _
                                      lParam)
   End Select
   
End Function


Public Sub SubClass(hWnd As Long)

  'assign our own window message
  'procedure (WindowProc)
  
   On Error Resume Next
   defWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
   
End Sub


Public Sub UnSubClass(hwndForm As Long)

  'restore the default message handling
  'before exiting
   If defWindowProc Then
      SetWindowLong hwndForm, GWL_WNDPROC, defWindowProc
      defWindowProc = 0
   End If
   
End Sub


Public Function FARPROC(ByVal pfn As Long) As Long
  
  'Wrapper procedure that receives and returns
  'the value of the AddressOf operator.
  'Required as AddressOf can not be used as
  'an argument in API structures (VB UDTs).
   FARPROC = pfn

End Function


Public Function IsShellVersion(ByVal version As Long) As Boolean

  'returns True if the Shell version
  '(shell32.dll) is equal or later than
  'the value passed as 'version'
   Dim nBufferSize As Long
   Dim nUnused As Long
   Dim lpBuffer As Long
   Dim nVerMajor As Integer
   Dim bBuffer() As Byte
   
   Const sDLLFile As String = "shell32.dll"
   
   nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
   
   If nBufferSize > 0 Then
    
      ReDim bBuffer(nBufferSize - 1) As Byte
    
      Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
    
      If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
         
         CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
        
         IsShellVersion = nVerMajor >= version
      
      End If  'VerQueryValue
    
   End If  'nBufferSize
  
End Function

Form Code

To a form (Form1), add two check boxes (Check1, Check2), three command buttons (Command1/2/3), a textbox (Text1), a label (Label1), and 16 option buttons in a control array (Option1(0) - Option1(15)). Add an Imagelist control (Imagelist1), and populate it with all 16 icons from the file available here. The image list's "image 1" should be file globe1.ico, image 2 should be globe2.ico, and so on.

Add a menu to the form to act as the systray icon's popup menu with the following parameters:

Parent menu: mnuOptions, no index
First submenu: mOpts(0), "Show Form"
Second submenu: mOpts(1), "Cycle Icons"
Third submenu: mOpts(2), "Icon Speed"
Fourth submenu: mOpts(3), Separator (-)
Fifth submenu: mOpts(4), "Exit"

Under the third menu item (mOpts(2)), create a submenu named mOptSpeed with the following members:

First submenu: mOptSpeed (0), "Very Slow (Timer=250)"
Second submenu: mOptSpeed (1), "Slow (Timer=100)"
Third submenu: mOptSpeed (2), "Fast (Timer=15)"
Fourth submenu: mOptSpeed (3), "Very Fast (Timer=5)"

Paste the following code to the form:

Option Explicit

'the current icon displayed
Dim currIcon As Long
 
'required constants, types & declares
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_ICON = &H2     'adding an ICON
Private Const NIM_TIP = &H4      'adding a TIP
Private Const NIM_MESSAGE = &H1  'we want return messages

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Type NOTIFYICONDATA
   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
   uTimeoutAndVersion As Long
   szInfoTitle As String * 64
   dwInfoFlags As Long
   guidItem As GUID
End Type

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


Private Sub Form_Load()

  'centre the form
   Me.Move (Screen.Width - Me.Width) / 2, _
           (Screen.Height - Me.Height) / 2
           
  'set button start-up states
   Check1.Value = False
   Option1(0).Value = True
   Check2.Value = False
   Label1.Caption = "Select an Icon to display " & _
                 "in the System Tray, and " & _
                    "Right-click the systray icon " & _
                    "for the popup menu!"
   
  'set tool tip text start-up state
   Text1.Text = "Right-click to see more options"
   
  'set command button start-up states
   Command3.Enabled = Check1.Value = 1
   Command2.Enabled = Check1.Value = 1
  
  'set message label start-up state
   Label1.Visible = Check1.Value = 1
   
  'set Cycle Icon check box and frame state
   Check2.Enabled = Check1.Value = 1

  'set menu start-up states
   mOptSpeed(2).Checked = True
   mOptSpeed_Click 2
   
   Me.Icon = ImageList1.ListImages.Item(1).Picture

End Sub


Private Sub Command1_Click()

  'action based on checked value
   If defWindowProc <> 0 Then
   
      ShellTrayRemove
      
     'restore default window procedure
      UnSubClass Me.hWnd
      defWindowProc = 0
            
   End If
   
   Unload Me

End Sub


Private Sub Command2_Click()
   
  'set the new Tool Tip text
   ShellTrayModifyImageTip Text1.Text
  
End Sub


Private Sub Command3_Click()

  'hide the form. Only enabled
  'if the Enabled box is checked.
   Me.Hide
              
End Sub


Private Sub Check1_Click()

  'action based on checked value
   If Check1.Value = 1 Then

     'add an icon to the system tray. If is
     'is successful (returns 1) then subclass
     'to intercept messages
      If ShellTrayAdd(Text1.Text) = 1 Then
      
        'prepare to receive the systray messages
         SubClass Me.hWnd
      
      End If
         
   Else
   
      UnSubClass Me.hWnd
      ShellTrayRemove
      
   End If
  
  'enable buttons if applicable
   Check2.Enabled = Check1.Value = 1
   Command2.Enabled = Check1.Value = 1
   Command3.Enabled = Check1.Value = 1

   Label1.Visible = Check1.Value = 1
  
End Sub


Private Sub Check2_Click()

  'cycle the icons by enabling the timer
   Timer1.Enabled = Check2.Value = 1

End Sub


Private Sub SetShellVersion()

   Select Case True
      Case IsShellVersion(6)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE '6.0 structure size
      
      Case IsShellVersion(5)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE 'pre-6.0 structure size
      
      Case Else
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE 'pre-5.0 structure size
   End Select

End Sub


Private Sub ShellTrayRemove()

  'Remove the icon added to the taskbar
   Call Shell_NotifyIcon(NIM_DELETE, nid)
 
End Sub


Private Sub ShellTrayModifyImage(IconHandle As Long)

   With nid
      .cbSize = Len(nid)
      .hIcon = IconHandle
    End With
   
   Call Shell_NotifyIcon(NIM_MODIFY, nid)

End Sub


Sub ShellTrayModifyImageTip(msg As String)

   With nid
      .cbSize = Len(nid)
      .szTip = msg & vbNullChar
    End With
   
   Call Shell_NotifyIcon(NIM_MODIFY, nid)

End Sub


Public Function ShellTrayAdd(msg As String) As Long
         
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
         
   With nid
  
      'size of the NID type
      .cbSize = NOTIFYICONDATA_SIZE
       
      'Handle of the window to receive
      'notification messages associated
      'with an icon in the taskbar
      .hWnd = Me.hWnd
    
      'Application-defined identifier
      'of the taskbar icon. Here, we'll
      'use the window handle
      .uID = Me.hWnd
     
      'Flags indicating which of
      'the other structure members
      'contain valid data
      .uFlags = NIM_ICON Or NIM_TIP Or NIM_MESSAGE
 
      'Our custom message sent whenever
      'the mouse acts on our icon in
      'the systray.
      .uCallbackMessage = WM_MYHOOK
     
      'Handle of the taskbar icon to
      'add, modify, or delete
      .hIcon = ImageList1.ListImages.Item(1).Picture
     
      'tooltip text.
      'If NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE
      'then max size = 64 else max size = 128
      .szTip = msg & vbNullChar
   
   End With
   
  'Call passing NIM_ADD. Returns 1
  'if successful or 0 otherwise
   ShellTrayAdd = Shell_NotifyIcon(NIM_ADD, nid)

End Function


Private Sub mOpts_Click(Index As Integer)

  '0: show the form
  '1: toggle the Cycle Icon States checkbox
  '4: exit the app

   Select Case Index
     Case 0: Me.Show
     Case 1: Check2.Value = Abs(Not (Check2.Value * -1))
     Case 4: Command1_Click
   End Select
   
End Sub


Public Sub mOptSpeed_Click(Index As Integer)

  'track the current selection
   Static currSpeed As Integer
   
  'uncheck the previous selection
   mOptSpeed(currSpeed).Checked = False
   
  'set the new timer interval
   Select Case Index
      Case 0: Timer1.Interval = 350
      Case 1: Timer1.Interval = 200
      Case 2: Timer1.Interval = 100
      Case 3: Timer1.Interval = 30
   End Select
   
  'check the new menu selection
   mOptSpeed(Index).Checked = True
   
  'set the flag to the new Index
   currSpeed = Index
   
  'if the Cycle Icon States box is checked,
  'enable the timer
   Timer1.Enabled = Check2.Value = 1
   
End Sub


Private Sub Option1_Click(Index As Integer)

  'don't interrupt display if
  'the timer is active
   If Timer1.Enabled Then Exit Sub
  
  'Load the appropriate icon.
  'The button indices are from
  '0 to 15, but the list images
  'indices range from 1 to 16,
  'so to show Icon1.ico to Icon16.ico
  'we have to add 1 to the Index
   ShellTrayModifyImage ImageList1.ListImages.Item(Index + 1).Picture
   currIcon = Index

End Sub


Private Sub Timer1_Timer()

  'add 1 to the current icon and
  'check that it is within acceptable range
   currIcon = currIcon + 1
   If currIcon > 16 Then currIcon = 1

  'update the icon state option button to
  'reflect the current icon displayed
   Option1(currIcon - 1).Value = True
  
  'and update the system tray icon
   ShellTrayModifyImage ImageList1.ListImages.Item(currIcon).Picture

End Sub


Private Sub Text1_Change()

 'enable button if applicable
  Command2.Enabled = Check1.Value = 1

End Sub

Comments

Double check all your code, and use Run/Start With Full Compile to catch any errors before the subclassing kicks in. In particular, should you have chosen to use different form, menu or control names, or changed the names of routines, you must assure that every occurrence in the project is correct. Save the project, then run. On the form's icon will appear in the taskbar when the Enable check is made.

PayPal Link