VERSION 5.00
Object = "{5B033ECF-098E-11D1-A4B2-444553540000}#1.0#0"; "SUBCLASS.OCX"
Begin VB.Form frmSysTray
   BorderStyle     =   1  'Fixed Single
   Caption         =   "System Tray Demo"
   ClientHeight    =   2655
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   4335
   Icon            =   "SysTray.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2655
   ScaleWidth      =   4335
   StartUpPosition =   2  'CenterScreen
   Begin SubclassCtl.Subclass Subclass1
      Left            =   2880
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
   End
   Begin VB.Timer Timer1
      Interval        =   2000
      Left            =   3360
      Top             =   0
   End
   Begin VB.Image imgIcon
      Height          =   480
      Index           =   4
      Left            =   3840
      Picture         =   "SysTray.frx":0442
      Top             =   1920
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgIcon
      Height          =   480
      Index           =   3
      Left            =   3840
      Picture         =   "SysTray.frx":058C
      Top             =   1440
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgIcon
      Height          =   480
      Index           =   2
      Left            =   3840
      Picture         =   "SysTray.frx":06D6
      Top             =   960
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgIcon
      Height          =   480
      Index           =   1
      Left            =   3840
      Picture         =   "SysTray.frx":0820
      Top             =   480
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgIcon
      Height          =   480
      Index           =   0
      Left            =   3840
      Picture         =   "SysTray.frx":096A
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Label lblAvailVirtual
      Caption         =   "Label14"
      Height          =   255
      Left            =   2160
      TabIndex        =   13
      Top             =   2280
      Width           =   2055
   End
   Begin VB.Label lblTotalVirtual
      Caption         =   "Label13"
      Height          =   255
      Left            =   2160
      TabIndex        =   12
      Top             =   1920
      Width           =   2055
   End
   Begin VB.Label lblAvailPageFile
      Caption         =   "Label12"
      Height          =   255
      Left            =   2160
      TabIndex        =   11
      Top             =   1560
      Width           =   2055
   End
   Begin VB.Label lblTotalPageFile
      Caption         =   "Label11"
      Height          =   255
      Left            =   2160
      TabIndex        =   10
      Top             =   1200
      Width           =   2055
   End
   Begin VB.Label lblAvailPhys
      Caption         =   "Label10"
      Height          =   255
      Left            =   2160
      TabIndex        =   9
      Top             =   840
      Width           =   2055
   End
   Begin VB.Label lblTotalPhys
      Caption         =   "Label9"
      Height          =   255
      Left            =   2160
      TabIndex        =   8
      Top             =   480
      Width           =   2055
   End
   Begin VB.Label lblMemoryLoad
      Caption         =   "Label8"
      Height          =   255
      Left            =   2160
      TabIndex        =   7
      Top             =   120
      Width           =   2055
   End
   Begin VB.Label Label7
      Caption         =   "Available Virtual Memory:"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   2280
      Width           =   2055
   End
   Begin VB.Label Label6
      Caption         =   "Total Virtual Memory:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1920
      Width           =   2055
   End
   Begin VB.Label Label5
      Caption         =   "Available Swap File:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   2055
   End
   Begin VB.Label Label4
      Caption         =   "Maximum Swap File:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   1200
      Width           =   2055
   End
   Begin VB.Label Label3
      Caption         =   "Available Physical Memory:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   2055
   End
   Begin VB.Label Label2
      Caption         =   "Total Physical Memory:"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   2055
   End
   Begin VB.Label Label1
      Caption         =   "Memory Load:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2055
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileClose
         Caption         =   "&Close"
      End
      Begin VB.Menu mnuFileAbout
         Caption         =   "&About..."
      End
      Begin VB.Menu mnuFileSep10
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuPopup
      Caption         =   "Popup"
      Visible         =   0   'False
      Begin VB.Menu mnuPopupOpen
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuPopupAbout
         Caption         =   "&About..."
      End
      Begin VB.Menu mnuPopupSep10
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopupExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "frmSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'SysTray - System Tray Demo
'Copyright (c) 1997 SoftCircuits Programming (R)
'Redistributed by Permission.
'
'This program demonstrates how to display an icon on the system taskbar
'(tray notification area) under Windows 95 and later, or Windows NT 4.0 or
'later. The program first determines if it is running under one of these
'operating systems and terminates if it is not.
'
'Although you do not need a subclassing control to place an icon on the
'system taskbar, you will need one to respond to tray notification
'messages. This program uses Subclass.ocx. (Note, it is possible to
'implement a system tray icon without a subclassing control. Because
'Windows allows you to specify the value of the callback message, you can
'specify a message that Visual Basic already supports. For example, you
'can specify the WM_LBUTTONDOWN message and place code in the MouseDown
'event. However, this technique has some limitations. Visual Basic
'interprets the information that accompanies the WM_LBUTTONDOWN message
'as mouse coordinates and, depending on the form's scale mode, may modify
'data that provides information about the system tray. Also, this would
'cause a conflict if you also needed to intercept real MouseDown events.)
'
'The program is a simple one. It has 4 possible icons each indicating a
'particular level of memory usage. This icon is updated each time the
'timer control fires. If the user double-clicks the icon or selects Open
'from the context-sensitive menu, the main form is displayed which
'contains more detailed information about the current memory usage.
'
'This program may be distributed on the condition that it is
'distributed in full and unchanged, and that no fee is charged for
'such distribution with the exception of reasonable shipping and media
'charges. In addition, the code in this program may be incorporated
'into your own programs and the resulting programs may be distributed
'without payment of royalties.
'
'This example program was provided by:
' SoftCircuits Programming
' http://www.softcircuits.com
' P.O. Box 16262
' Irvine, CA 92623
Option Explicit

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_USER = &H400

Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type
   
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type

Private Declare Function ShellNotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub GlobalMemoryStatus Lib "Kernel32" (lpBuffer As MEMORYSTATUS)

Const WM_ICONNOTIFY = WM_USER + 100
Const ID_TASKBARICON = 100

'Initial form load
Private Sub Form_Load()
    Dim os As OSVERSIONINFO
    'Form is hidden initially
    Visible = False
    'Ensure valid operating system
    os.dwOSVersionInfoSize = Len(os)
    GetVersionEx os
    If os.dwMajorVersion < 4 Then
        MsgBox "This program requires Windows 95 or later, or Windows NT 4.0 or later."
        End
    End If
    'Setup Subclass
    Subclass1.hwnd = hwnd
    Subclass1.Messages(WM_ICONNOTIFY) = True
    'Setup icon notification from shell
    UpdateIcon NIM_ADD
End Sub

'Hide form
Private Sub mnuFileClose_Click()
    Visible = False
End Sub

'Show about box
Private Sub mnuFileAbout_Click()
    frmAbout.Show vbModal
End Sub

'Exit by unloading one and only form
Private Sub mnuFileExit_Click()
    Unload Me
End Sub

'Process tray notification messages
Private Sub Subclass1_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    If wParam = ID_TASKBARICON Then     'Is this for us?
        Select Case lParam
            Case WM_LBUTTONDOWN
            Case WM_LBUTTONDBLCLK
                'Display main window
                DisplayForm
            Case WM_RBUTTONDOWN
                'Display popup menu
                'Note: There is a potential problem here
                'as described in Microsoft knowledgebase
                'article Q135788. However, we were unable
                'to duplicate the documented problem here
                PopupMenu mnuPopup, , , , mnuPopupOpen
        End Select
    End If
End Sub

'Update memory status
Private Sub Timer1_Timer()
    UpdateIcon NIM_MODIFY
End Sub

'Just hide form if user presses Close button
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Me.Visible = False
        Cancel = True
    End If
End Sub

'Clean-up on unload
Private Sub Form_Unload(Cancel As Integer)
    'Remove icon from system tray
    UpdateIcon NIM_DELETE
End Sub

'Popup menu: show main form
Private Sub mnuPopupOpen_Click()
    DisplayForm
End Sub

'Popup menu: Show about box
Private Sub mnuPopupAbout_Click()
    mnuFileAbout_Click
End Sub

'Popup menu: unload program
Private Sub mnuPopupExit_Click()
    mnuFileExit_Click
End Sub

'Updates the tray icon data
Private Sub UpdateIcon(nAction As Integer)
    Dim nid As NOTIFYICONDATA
    Dim mem As MEMORYSTATUS

    'Get current memory status
    mem.dwLength = Len(mem)
    GlobalMemoryStatus mem
    'Update form if visible
    If Visible Then
        lblMemoryLoad = CStr(mem.dwMemoryLoad) & "%"
        lblTotalPhys = Format$(mem.dwTotalPhys, "#,##0") & " bytes"
        lblAvailPhys = Format$(mem.dwAvailPhys, "#,##0") & " bytes"
        lblTotalPageFile = Format$(mem.dwTotalPageFile, "#,##0") & " bytes"
        lblAvailPageFile = Format$(mem.dwAvailPageFile, "#,##0") & " bytes"
        lblTotalVirtual = Format$(mem.dwTotalVirtual, "#,##0") & " bytes"
        lblAvailVirtual = Format$(mem.dwAvailVirtual, "#,##0") & " bytes"
    End If
    'Update tray icon data
    nid.cbSize = LenB(nid)
    nid.hwnd = hwnd
    nid.uID = ID_TASKBARICON
    nid.uFlags = NIF_MESSAGE Or NIF_TIP Or NIF_ICON
    nid.uCallbackMessage = WM_ICONNOTIFY
    nid.hIcon = imgIcon(mem.dwMemoryLoad  25)
    nid.szTip = "Memory Load: " & CStr(mem.dwMemoryLoad) & "%" & Chr$(0)
    ShellNotifyIcon nAction, nid
End Sub

'Center, display and activate main form
Private Sub DisplayForm()
    If Visible = False Then
        'Display form
        Visible = True
        'Force update of memory status
        Timer1_Timer
    End If
    'This appears necessary
    SetFocus
End Sub