Visual Basic Subclassing Routines
Shell_NotifyIcon: Respond to Systray Icon/Menu Interaction
     
Posted:   Monday April 13, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows 98
OS restrictions:   None
Author:   VBnet - Randy Birch
     

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 and the BAS modules systray.bas and winproc.bas created in Shell_NotifyIcon: Add Icon to Windows System Tray.

Windows95 OSR2, Windows98, WinNT4 or Win2000 in order to use the GetDiskFreeSpaceEx API below (see the comments section at the end of the page for more info).

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.


vbnsShellNot2.gif (11145 bytes)Now that the methodology for adding and deleting the systray icon has been covered, as well as responding to mouse messages, this page provides a mini-app that can be called from the systray icon.

The app below retrieves the users drives, identifies its type, and adds them to a popup menu.  On selecting a drive, the drive's statistics are shown.

For the chart, this app requires that the MSChart control be added to the project. If you chose to use another charting package, be sure that the syntax for displaying the graph is correct before running with subclassing enabled.

This project requires two forms.

To a new form (frmMain), add a parent menu bar item named 'zmnuDemo', and under it a menu array element (mnuDriveDetails(0)). Assure that it is an menu array element, and ignore the caption - this will be dynamically created based on the drives installed at program execution. For demo purposes, I left the menu visible on the form above, but it can be invisible. Add a command button (Command1) and a label (Label1). In addition, add a 16x16 icon to the form's Icon property. This icon will be used as the icon to display in the taskbar.

Add a second form (drvInfo).  DrvInfo has three labels for the statistic descriptions, and a second array of three labels (lbInfo(0) - lbInfo(2)) to receive the actual stats. Add the Microsoft Chart Control to the project via the Components menu, and add a chart (MSChart1) to the form.  Set the chart type to 14 - Pie. Optionally set the colours as desired. Set the charts ColumnCount to 2, and RowCount to 1. Add two pixboxes (Picture1/Picture2), and set their BackColor to represent the chart legend. Finally, add a command button (Command1).

 BAS Module Code
There are no changes to any BAS module code.

 Form 1 Code - frmMain.frm
Add the following code to frmMain:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long

Private Declare Function GetDriveType Lib "kernel32" _
     Alias "GetDriveTypeA" _
     (ByVal nDrive As String) As Long

Private Const DRIVE_UNKNOWN As Long = 0
Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6
      

Private Sub CreateDriveMenu()

   Dim c As Long
   Dim drvType As String
   Dim drvName As String
   Dim allDrives As String
   
  'get the list of all available drives
   allDrives = GetDriveString()
   
  'Separate the drive strings and add them
  'to the menu.
   Do Until allDrives = vbNullChar
   
     'strip off one drive item from allDrives
      drvName = StripNulls(allDrives)
      drvType = rgbGetDriveType(drvName)
      
     'add a new entry to the drive to the menu,
     'skipping menu array item 0
      If c > 0 Then Load mnuDriveDetails(c)
      
      mnuDriveDetails(c).Caption = drvName & " stats " & drvType
      mnuDriveDetails(c).Visible = True
      
      c = c + 1
      
   Loop
   
  'add a separator and a close option
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "-"
   
   c = c + 1
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "Close Tray Icon"

   c = c + 1
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "Exit Drive Info"
   
  'uncomment this to hide the menu
  'zmnuDemo.Visible = False

End Sub


Private Sub ShellTrayRemove()

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


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."
   
   Label2.Caption = msg

  'add an icon to the system tray
   If ShellTrayAdd = 1 Then

      CreateDriveMenu  'populate the menu with drive info
      SubClass Me.hwnd 'prepare to receive the systray events

   End If
End Sub


Private Function rgbGetDriveType(thisDrv As String) As String

 'returns string representing the type of drive.
 
   Select Case GetDriveType(thisDrv)
      Case DRIVE_UNKNOWN:  rgbGetDriveType = "[unknown]"
      Case DRIVE_NO_ROOT_DIR:   rgbGetDriveType = "[error: no root]"
      Case DRIVE_REMOVABLE:
         Select Case Left$(thisDrv, 1)
            Case "a", "b": rgbGetDriveType = "[floppy]"
            Case Else:     rgbGetDriveType = "[removable]"
         End Select
      
      Case DRIVE_FIXED:   rgbGetDriveType = "[hard drive]"
      Case DRIVE_REMOTE:  rgbGetDriveType = "[network]"
      Case DRIVE_CDROM:   rgbGetDriveType = "[CD-ROM]"
      Case DRIVE_RAMDISK: rgbGetDriveType = "[RAM disk]"
   End Select
  
End Function


Private Function GetDriveString() As String

  'returns string of available
  'drives each separated by a null
   Dim sBuffer As String
   
  'possible 26 drives, four characters each (including null)
   sBuffer = Space$(26 * 4)
  
  If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

     'trim the spaces, but do not 
     'trim off the trailing null!
      GetDriveString = Trim$(sBuffer)
      
   End If

End Function


Private Function StripNulls(startStrg As String) As String

  'Takes a string separated by a delimiter
  '(Chr$(0) here), and split off 1 item,
  'and shorten the string so that the
  'next item is ready for removal.
   Dim pos As Integer
   
   pos = InStr(startStrg, Chr$(0))
   
   If pos Then
      StripNulls = Mid(startStrg, 1, pos - 1)
      startStrg = Mid(startStrg, pos + 1)
      Exit Function
   End If
  
End Function


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 = frmMain.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 UnSubClass()

  'restore the default message handling
  'before exiting
   If defWindowProc Then
      SetWindowLong frmMain.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


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 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 mnuDriveDetails_Click(Index As Integer)

   Dim currDrive As String

   Select Case Index
      
     'the last menu item - exit
      Case mnuDriveDetails.Count - 1
         
        'You can not end the app using an
        'Unload frmMain statement, as unloading
        'while the menu event is processing
        'will cause a GPF. So here, we'll cheat
        'and close by sending ourselves a WM_CLOSE
        'message after removing the tray icon!
        '
        'The PostMessage call sends a message as
        'though the user had pressed the X button
        'or the Close command from the System Menu
        'was chosen (QueryUnload UnloadMode
        'value = vbFormControlMenu)
         ShellTrayRemove
         Call PostMessage(frmMain.hwnd, WM_CLOSE, 0&, ByVal 0&)

     'the second-last menu item is selected - close icon
      Case mnuDriveDetails.Count - 2
         
        'nuke the systray item
         ShellTrayRemove
      
     'a drive stats item
      Case Else
      
        'pretty straight forward.
        '
        'get the drive from the caption (ie c:\)
        'pass to the drvInfo form and show.     
            
        'Once form 'drvInfo' gets the letter
        'and GetDriveStats is called, the form
        'retrieves the drive stats and creates
        'the stat details before displaying.
         currDrive = Left$(mnuDriveDetails(Index).Caption, 3)
                
         With drvInfo
            .DriveToGet currDrive
            .GetDriveStats
            .Show vbModal
         End With
   
   End Select
   
End Sub
 Form 2 Code - drvInfo.frm
Add the following code to form drvInfo:

Option Explicit
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
   Alias "GetDiskFreeSpaceExA" _
   (ByVal lpcurrDrive As String, _
   lpFreeBytesAvailableToCaller As Currency, _
   lpTotalNumberOfBytes As Currency, _
   lpTotalNumberOfFreeBytes As Currency) As Long

'passed as a parameter from the main form
'menu click (to the sub 'DriveToGet')
Private workDrv As String


Private Sub Form_Load()

  'centre this form
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
  'saves me searching all over the
  'place for the icon!
   Me.Icon = frmMain.Icon

End Sub 


Private Sub Command1_Click()

   Unload Me
   
End Sub


Public Sub DriveToGet(selectedDrive As String)

   workDrv = selectedDrive

End Sub


Public Sub GetDriveStats()

   Dim TotalBytes As Currency
   Dim TotalFree As Currency
   Dim FreeToCaller As Currency
   
  'some temp vars for calculations
   Dim tmp As Currency
   Dim tmpTotal As Currency
   Dim tmpFree As Currency
   
  'passed empty and filled in the
  'CreateChartStats sub
   Dim pcUsed As Single
   Dim pcFree As Single
   
  'get the drive space info
   Call GetDiskFreeSpaceEx(workDrv, FreeToCaller, TotalBytes, TotalFree)
   
  'since we're using a chart, the values
  'need to be turned into percentages (tmp)
  'and the chart filled
   
  'If values were returned (disk present),
  'calc the percentage free multiplying
  'the returned values of TotalBytes and
  'TotalFree by 10000 to adjust for the
  '4 decimal places that the currency
  'data type returns.
   tmpTotal = (TotalBytes * 10000)
   tmpFree = (TotalFree * 10000)

   If TotalBytes > 0 Then tmp = (tmpFree / tmpTotal)
   
  'now pass the drive and tmp (even if 0)
  'to the chart routine.  The sub returns
  'pcUsed and pcFree for use below.
   CreateChartStats workDrv, tmp, pcUsed, pcFree
   
  'show the results
   lbInfo(0).Caption> = Format$(tmpFree, "###,###,###,##0") & " bytes " & pcFree & "%"
   lbInfo(1).Caption = Format$(tmpTotal - tmpFree, "###,###,###,##0") & " bytes " & pcUsed & "%"
   lbInfo(2).Caption = Format$(tmpTotal, "###,###,###,##0") & " bytes"
   
End Sub


Private Sub CreateChartStats(workDrv As String, tmp, pcUsed, pcFree)

  'reduce the values to percent
   pcFree = Int(tmp * 100)
   pcUsed = Int(100 - pcFree)
   
  'and fill in a chart
   With MSChart1
      
      .chartType = 14
      .ShowLegend = False
      .ColumnCount = 2
      .RowCount = 1
      .RowLabel = "Drive " & UCase$(Left$(workDrv, 1))
      
      .Column = 1
      .Row = 1
      .Data = pcUsed
   
      .Column = 2
      .Row = 1
      .Data = pcFree
      
   End With
   
End Sub
 Comments
Again. double check all your code, in particular the form, menu and control names, and any changed routine names. Save the project, then run. On starting the form's icon will appear in the taskbar.  By leaving the mouse over the icon, the icon's ToolTip will appear. Right-clicking over the icon will display the popup menu listing the drives and drive types available on the system. Making a selection will invoke the drvInfo form displaying the drive's statistics.  Selecting Close Tray Icon will remove the icon from the tray.

If you were to issue an Unload frmMain command via the sys tray popup menu, while subclassing was still activated, you will generate a GPF.  Therefore the code shown here uses another technique to allow application termination - it posts to itself a WM_CLOSE message. This is processed after the menu event has completed, and results in a UnloadMode message similar to pressing the X button or selecting the system menu's Close option. The Unload event fires, and subclassing is safely terminated.


Beginning with the introduction of Windows95 OEM Service Pack 2 and its Fat32 disk system, and continuing through the Fat32-able Windows 98, the correct API to call for systems with drive partitions greater then 2 gigabytes is GetDiskFreeSpaceEx. NT4 also supports GetDiskFreeSpaceEx.

The OEM Service Pack 2 version of Windows95, and Windows 98, provides among other enhancements, optional support for FAT32 partitions, allowing a single partition of up to 5 gigabytes with a cluster size of only 4k. The original release version of Windows95 supports only partitions or drives up to 2 gigabytes in size. Using the GetDiskFreeSpaceEx code above on older original Win95 systems will return an 'error 453 - Entry point not found for GetDiskFreeSpaceEx'. On these older systems, the correct API to use is GetDiskFreeSpace.

To assure that the correct method is used to calculate the free space, Microsoft recommends obtaining the user's version of Windows using GetVersionEx prior to calling the free space API.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter