'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

'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

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

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

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