'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_ADD As Long = &H0
Public Const NIM_MODIFY As Long = &H1
Public Const NIM_DELETE As Long = &H2
Public Const NIF_ICON As Long = &H2     'adding an ICON
Public Const NIF_TIP As Long = &H4      'adding a TIP
Public Const NIF_MESSAGE As Long = &H1  'want return messages

'rodent constant we'll need for the callback
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203

Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLCLK As Long = &H209

Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206

'shell version / NOTIFYICONDATA 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

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

Public 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

Public NID As NOTIFYICONDATA

Public Declare Function Shell_NotifyIcon Lib "shell32" _
   Alias "Shell_NotifyIconA" _
   (ByVal dwMessage As Long, _
   lpData As NOTIFYICONDATA) 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 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


Public 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

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

'isSubclassed: flag indicating that subclassing
'              has been done. Provides the means
'              to call the correct message-handler.
Public isSubclassed As Boolean

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

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

Public Declare Function SetForegroundWindow Lib "user32" _
   (ByVal hwnd As Long) As Long
   
Public Declare Function PostMessage Lib "user32" _
   Alias "PostMessageA" _
   (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    
Public Declare Function SetWindowLong Lib "user32" _
   Alias "SetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Any) As Long

Public 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
                            
                            
'our own window message procedure
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 it is 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:

                    'show the menu                  
                     With Form1
                        .PopupMenu .zmnuDemo
                     End With                  
                  
               End Select
            
           'handle any other form messages by
           'passing to the default message proc
            Case Else
            
               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

Option Explicit

Private Sub Form_Load()
     
  'centre this form
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
   Dim msg As String
   msg = "Systray ToolTip && Popup Menu Demo." & vbCrLf & vbCrLf
   msg = msg & "Move the mouse over the systray 'drive'"
   msg = msg & " icon. The tooltip will appear." & vbCrLf & vbCrLf
   msg = msg & "Right-clicking displays the popup menu. "
   msg = msg & "Choose an option."
   
   Label1.Caption = msg

  'add an icon to the system tray. If is
  'is successful (returns 1) then subclass
  'to intercept messages
   If ShellTrayAdd = 1 Then
   
     'prepare to receive the systray messages
      SubClass Form1.hwnd
      
   End If

End Sub


Private Sub Form_Unload(Cancel As Integer)

  'Remove the icon added to the taskbar
   ShellTrayRemove
   
  'remove subclassing
   UnSubClass
       
  'assure unloading proceeds
   Cancel = False
    
End Sub


Private Sub Command1_Click()

  'call the unload event. This MUST execute
  'to un-subclass the form before exiting.
  'If you GPF on exiting, this is the reason!
  'Always save the project before running.
   Unload Me

End Sub


Private Sub mFile_Click(Index As Integer)

  'code demonstrating typical reaction to
  'the menu clicks.  
   Select Case Index
      
      Case 0, 1, 3:
         
         MsgBox "Called from File " & mFile(Index).Caption
      
      Case 5: ShellTrayRemove
      Case 6:
         
        'Executing 'Unload Me' from within a
        'menu event invoked from a systray icon
        'will cause a GPF. The proper way to
        'terminate under these circumstances
        'is to send a WM_CLOSE message to the
        'form. The form will process the
        'message as though the user had selected
        'Close from the sysmenu, invoking the
        'normal chain of shutdown events, removing
        'the tray icon, terminating the subclassing
        'cleanly and ultimately preventing the GPF.
        '
        'This code can also be called directly from
        'the form's menu as well, so no special coding
        'is required to differentiate between an end
        'command from a popup systray menu, or from
        'a normal form menu.
        '
        'The UnloadMode of QueryUnload/UnloadMode
        'will equal vbFormControlMenu when this
        'close method is used.
         Call PostMessage(Form1.hwnd, WM_CLOSE, 0&, ByVal 0&)
      
      Case Else
   End Select
              
End Sub


Public Function ShellTrayAdd() As Long

 'prepare the NOTIFYICONDATA type with the
 'required parameters:
 
 '.cbSize: Size of this structure, in bytes.
 '
 '.hwnd:   Handle of the window that will receive
 '         notification messages associated with
 '         an icon in the taskbar status area.
 '
 'uID:     Application-defined identifier of
 '         the taskbar icon. In an application
 '         with a single tray icon, this can be
 '         an arbitrary number.  For apps with
 '         multiple icons, each icon ID must be
 '         different as this member identifies
 '         which of the icons was selected.
 '
 '.uFlags: flags that indicate which of the other
 '         members contain valid data. This member
 '         can be a combination of the following:
 '         NIF_ICON    hIcon member is valid.
 '         NIF_MESSAGE uCallbackMessage member is valid.
 '         NIF_TIP     szTip member is valid.
 '
 'uCallbackMessage: Application-defined message identifier.
 '         The system uses this identifier for
 '         notification messages that it sends
 '         to the window identified in hWnd.
 '         These notifications are sent when a
 '         mouse event occurs in the bounding
 '         rectangle of the icon. (Note: 'callback'
 '         is a bit misused here (in the context of
 '         other callback demonstrations); there is
 '         no systray-specific callback defined -
 '         instead the form itself must be subclassed
 '         to respond to this message.
 '
 'hIcon:   Handle to the icon to add, modify, or delete.
 '
 'szTip:   Tooltip text to display for the icon. Must
 '         be terminated with a Chr$(0).
 
 'Shell_NotifyIcon messages:
 'dwMessage: Message value to send. This parameter
 '           can be one of these values:
 '           NIM_ADD     Adds icon to status area
 '           NIM_DELETE  Deletes icon from status area
 '           NIM_MODIFY  Modifies icon in status area
 '
 'pnid:      Address of the prepared NOTIFYICONDATA.
 '           The content of the structure depends
 '           on the value of dwMessage.

   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
    
   With NID
      .cbSize = NOTIFYICONDATA_SIZE
      .hwnd = Form1.hwnd
      .uID = 125&
      .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
      .uCallbackMessage = WM_MYHOOK
      .hIcon = Me.Icon
      .szTip = "VBnet System Tray Callback Demo" & Chr$(0)
    End With
   
    ShellTrayAdd = Shell_NotifyIcon(NIM_ADD, NID)

End Function


Private Sub ShellTrayRemove()

  'Remove the icon from the taskbar
   Call Shell_NotifyIcon(NIM_DELETE, NID)
   
End Sub


Private Sub UnSubClass()

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


Private 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