Visual Basic Subclassing Routines
Shell_NotifyIcon: Respond to Systray Icon/Menu Interaction in a MDI App
     
Posted:   Saturday July 31, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows NT4
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. All code will be created from this page.

Note: You will need to be running 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.


The procedure to create and manipulate a shell systray icon from a MDI parent form is very similar to the method used in a SDI application. Detailed explanations of the Shell_NotifyIcon methods have been provided in the proceeding two pages (above), so this demo will only provide the comments where there code differs from that mentioned before.

This demo shows how to create the advanced Systray Popup demo using a MDI parent (frmMDIMain - to house the drive menu) and with two MDI child windows (frmChild, displaying a label and with a single menu item, and frmChildDrvInfo, displaying the actual drive statistics).

Since the MDI parent in this example houses the popup menu that serves as both a systray popup menu as well as a visible &File menu, it receives the actual subclassing.

In this demo, frmChild also receives a menu, to point out an interesting phenomenon that occurs when either or both of the Child forms do have menus. As per MDI mandate, the child menu will replace the menu bar on the MDI parent. But the popup is still accessible via subclassing, meaning that your application can subclass the MDI parent and still show and react to normal child menus without losing any of the parent's systray popup functionality.

This project requires three forms:

To a new MDI form (frmMDIMain), add a parent menu bar item named 'zmnuDemo', and under it a single 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. Set the project start-up form to frmMDIMain.

To a second form (frmChild), set its MDIChild property True, and add any menu element. Inside the menu event, add a simple msgbox call - i.e. "MsgBox "Called from Child form"

For the third form (frmChildDrvInfo), you may wnat to copy the DrvInfo form created in the SDI Advanced demo, to save recreating.

If you're starting from scratch, on frmChildDrvInfo add 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 picture boxes (Picture1/Picture2), and set their BackColor to represent the chart legend. Finally, add a command button (cmdOK).

 BAS Module 1 Code - ShellNotifyMDI.bas
Place the following code into the general declarations area of 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Required Public constants, types & declares
'for the Shell_NotifyIcon methods
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


Public Function ShellTrayAdd(frm As Form) As Long
       
  'prepare the NOTIFYICONDATA type with the
  'required parameters:
 
  'for information on the data structure members, 
  'please see the other Advanced topic at the top 
  'of the page.
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
    
   With NID
     .cbSize = NOTIFYICONDATA_SIZE
     .hwnd = frm.hwnd
     .uID = 125&
     .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     .uCallbackMessage = WM_MYHOOK
     .hIcon = frm.Icon
     .szTip = "VBnet MDI System Tray Callback Demo" & Chr$(0)
   End With

   Call Shell_NotifyIcon(NIM_ADD, NID)

End Function


Public Sub ShellTrayRemove()

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


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()

  'restore the default message handling
  'before exiting
   If defWindowProc Then
      SetWindowLong frmMDIMain.hwnd, GWL_WNDPROC, defWindowProc
      defWindowProc = 0
   End If
   
End Sub
 BAS Module 2 Code - WindowProcMDI.bas
Place the following code into the general declarations area of a second 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 SetWindowLong.
Public defWindowProc As Long

'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
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111

'we need to define a message that we will 
'respond to when sent from the systray icon, 
'so create one using WM_APP
Private Const WM_APP As Long = &H8000&
Public Const WM_MYHOOK As Long = WM_APP + &H15

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 GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long) 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
                            
                            
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's ours, we look at lParam for the
  'message generated, and react appropriately.

   On Error Resume Next
  
   Select Case hwnd
   
     'form-specific handler
      Case frmMDIMain.hwnd
         
         Select Case uMsg
          'check uMsg for the application-defined
          'identifier (NID.uID) assigned to the
          'systray icon in NOTIFYICONDATA (NID).
  
           'WM_MYHOOK was defined as the message sent
           'as the .uCallbackMessage member of
           'NOTIFYICONDATA the systray icon
            Case WM_MYHOOK
            
              'lParam is the value of the message
              'that generated the tray notification.
               Select Case lParam
                  Case WM_RBUTTONUP:

                 'assure that when the popup menu closes 
                 'focus returns to our app  
                  Call SetForegroundWindow(frmMDIMain.hwnd)

                 'show the popup from the MDI parent  
                  frmMDIMain.PopupMenu frmMDIMain.zmnuDemo
               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


Public Function FARPROC(ByVal pfn As Long) As Long
  
  'A dummy procedure that receives and returns
  'the value of the AddressOf operator.
 
  'Obtain and set the address of the callback
  'This workaround is needed as you can't assign
  'AddressOf directly to a member of a user-
  'defined type, but you can assign it to another
  'long and use that (as returned here)
 
  FARPROC = pfn

End Function
 Form 1 Code - frmMDIMain.frm
To the main MDI form - frmMDIMain - add the following code:

Option Explicit

'needed locally in this form
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 MDIForm_Load()

  'saves me searching the disk for the old drive icon,
  'and because a child form's property is referenced,
  'this loads the child!
   Me.Icon = frmChild.Icon

  'add an icon to the system tray
   ShellTrayAdd Me
   
   CreateDriveMenu
   
  'prepare to receive the systray events
   SubClass frmMDIMain.hwnd

End Sub


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 = rgbGetLogicalDriveStrings()
   
  'Separate the drive strings and add them
  'to the menu.
   Do Until allDrives = Chr(0)
   
     'strip off one drive item from allDrives
      drvName = StripNulls(allDrives)
      drvType = GetDriveString(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 the Close and Exit options
   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"

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, three characters each, plus trailing null
   sBuffer = Space$(26 * 4)
  
  If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

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

End Function


Private Function StripNulls(startstr As String) As String

 'Take a string separated by Chr$(0)
 'and split off 1 item, shortening the
 'string so next item is ready for removal.
  Dim pos As Long

  pos = InStr(startstr$, Chr$(0))
  
  If pos Then
      
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
    
  End If

End Function


Private Sub MDIForm_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)

   Const WM_CLOSE = &H10

   Select Case Index
      
     'the last menu item - exit
      Case mnuDriveDetails.Count - 1
         
        '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(frmMDIMain.hwnd, WM_CLOSE, 0&, ByVal 0&)
         
      
     'the second-last menu item - 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 (i.e. c:\)
        'pass to the frmChildDrvInfo form and show.
         
         Dim currDrive As String
         currDrive = Left$(mnuDriveDetails(Index).Caption, 3)
        
        'Once form 'frmChildDrvInfo' gets the letter
        'and GetDriveStats is called, the form
        'retrieves the drive stats and creates
        'the stat details before displaying.
        
         With frmChildDrvInfo
            .DriveToGet currDrive
            .GetDriveStats
            .Show
         End With
   
   End Select

End Sub
 Form 2 Code - frmMDIChild.frm
To the MDI child form - frmChild - add the following code:

Option Explicit

Private Sub Form_Load()
     
   Dim msg As String
   msg = "Systray Tooltip && Popup Menu Demo for MDI Windows." & 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."
   
  'assign and size the label
   Label1.Move (Me.Width - Label2.Width) \ 2, (Me.Height - Label2.Height) \ 2
   Label1.Caption = msg
   
End Sub
 Form 3 Code - frmChildDrvInfo.frm
If you are recreating the drvInfo form from scratch, add the following code to frmChildDrvInfo:

Option Explicit

'this handles both partitions < 2 > gig
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()

  'Even though this is a child form, we can
  'centre this form in the MDI parent
   Me.Move (frmMDIMain.Width - Me.Width) \ 2, (frmMDIMain.Height - Me.Height) \ 2
   
  'still saves me searching all
  'over the place for the icon!
   Me.Icon = frmMDIMain.Icon

End Sub


Private Sub cmdOK_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. Save the project, then run using the Start With Full Compile option to catch any errors before they hit during subclassing. Because a reference was made to the MDI Child form's icon property, frmChild will appear in the MDI window, and its menu will have replaced the drive info menu created on the MDI parent. Once started the MID Parent 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, even though the menu has actually been replaced by the frmChild menu. Making a selection will invoke frmChildDrvInfo displaying the drive's statistics. Selecting Close Tray Icon will remove the icon from the tray.

If you were to issue an Unload frmMDIMain 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. For code that will use either of the two APIs based on their presence in kernel32, see the method employed in GetDiskFreeSpaceEx: Detailed Drive Info

Microsoft recommends obtaining the user's version of Windows using GetVersionEx prior to calling the free space APIs.


 
 

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