|This article is based on Visual Basic 6. Find other Visual Basic 6 articles.|
- 1 To make System Tray Icon and Popup Menu
- 2 To Fix Popup Menu not closing problem
- 3 Showing 'Balloon' Tips
To make System Tray Icon and Popup Menu
Step one: Declare necessary items
This step is really easy - copy and paste. There isn't anything to do here, but is required to be exact (to my knowledge) so as to run.
Option Explicit 'User-defined variable to pass to the Shell_NotiyIcon function 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 'Constants for the Shell_NotifyIcon function Private Const NIM_ADD = &H0 Private Const NIM_MODIFY = &H1 Private Const NIM_DELETE = &H2 Private Const WM_MOUSEMOVE = &H200 Private Const NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 'Declare the API function call Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _ (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Dim nid As NOTIFYICONDATA
Step two: Create add icon procedure
In this step, we're creating the add icon procedure as a separate procedure so that we can:
- Specify a tooltip on-the-fly
- Call the add icon procedure from where ever we choose
Important points to note are the hWnd property, the uCallBackMessage property and the hIcon property.
The hWnd property links the icon to a specific form - where this procedure in a module the code would need to be changed to reference an actual form (Me keyword only works in forms as a reference to the form that the code in contained in).
The uCallBackMessage property lets the system know when the mouse moves over the icon start checking for interaction - I never really played with this to see what else could be done, but there are possibly other ways of checking for interaction.
The hIcon property provides a means to change the icon on the system tray at runtime, but the previous icon must be removed to show the new one.
Public Sub AddIcon(ByVal ToolTip As String) On Error GoTo ErrorHandler 'Add icon to system tray With nid .cbSize = Len(nid) .hWnd = Me.hWnd .uId = vbNull .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uCallBackMessage = WM_MOUSEMOVE .hIcon = Me.Icon .szTip = ToolTip & vbNullChar End With Call Shell_NotifyIcon(NIM_ADD, nid) Exit Sub ErrorHandler: 'Display error message Screen.MousePointer = vbDefault MsgBox Err.Description, vbInformation, App.ProductName & " - " & Me.Caption End Sub
Step three: Add code to add icon and remove icon from the system tray
Very straight-forward. Because we've created an add icon procedure, it's one line to add the icon (and modify the tooltip) and one line to remove it.
Private Sub Form_Load() Call AddIcon("This would be a tooltip...") End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 'Remove icon from system tray Call Shell_NotifyIcon(NIM_DELETE, nid) End Sub
Step four: Interact with system tray icon
The real magic begins! Below I've a select case to check what the user does on the icon - here we see that if the user releases the left mouse button over the icon, the form is either minimised and hidden or restored and shown depending on the current windowstate.
Why hide or show the form?
Hiding the form removes the icon on the taskbar (between start button on left and Clock on right) so that only the system tray icon is visible.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim msg As Long On Error GoTo ErrorHandler 'Respond to user interaction msg = X / Screen.TwipsPerPixelX Select Case msg Case WM_LBUTTONDBLCLK 'nothing Case WM_LBUTTONDOWN 'nothing Case WM_LBUTTONUP If Me.WindowState = vbMinimized Then Me.WindowState = vbNormal Me.Show Else Me.WindowState = vbMinimized Me.Hide End If Case WM_RBUTTONDBLCLK 'nothing Case WM_RBUTTONDOWN 'nothing Case WM_RBUTTONUP 'nothing End Select Exit Sub ErrorHandler: 'Display error message Screen.MousePointer = vbDefault MsgBox Err.Description, vbInformation, App.ProductName & " - " & Me.Caption End Sub
Making further use of the system tray icon is usually via a popup-menu - here's how to do that! After creating a menu with the following structure:
File -Option1 -Option2 ---------- -Exit
I can use the popup-menu function to have the options appear where the mouse is. By adding the following code to the Form_MouseMove event. Doing so means a popup-menu appears when the user right-clicks on the system tray icon.
Case WM_RBUTTONUP Call PopupMenu(mnuFile, vbPopupMenuRightAlign)
Here, if you've any experience working with menus you'll know that it's very straight-forward: depending on the index of the menu clicked, do a specific bit of code (see below).
Private Sub mnuFileArray_Click(Index As Integer) Select Case Index Case 0 'Option 1 MsgBox "You've clicked on option1 - good for you!", _ vbInformation, App.ProductName & Me.Caption Case 1 'Option 2 MsgBox "You've clicked on option2 - great!", _ vbInformation, App.ProductName & Me.Caption Case 4 'Option 1 Unload Me End End Select End Sub
To Fix Popup Menu not closing problem
Problem: To close the popup menu when clicked anywhere outside the menu.
Solution: You must set the current window as the "foreground window"
Do the following...
In general declaration insert the following:
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Before you can display your menu you have put in these lines of code....
Dim hProcess As Long GetWindowThreadProcessId hwnd, hProcess AppActivate hProcess
Now, call you menu. For example, my code followed was:
Showing 'Balloon' Tips
In order to show the nice little 'balloon' tips that you often see programs creating in Windows, you have to use the NOTIFYICONDATAW structure (whereas usually you would be using the NOTIFYICONDATAA structure, signifying ANSI rather than Unicode).
Here's the code:
Public Type NOTIFYICONDATAW cbSize As Long ' 4 hwnd As Long ' 8 uid As Long ' 12 uFlags As Long ' 16 uCallbackMessage As Long ' 20 hIcon As Long ' 24 szTip(0 To 255) As Byte ' 280 dwState As Long ' 284 dwStateMask As Long ' 288 szInfo(0 To 511) As Byte ' 800 uTimeOutOrVersion As Long ' 804 szInfoTitle(0 To 127) As Byte ' 932 dwInfoFlags As Long ' 936 guidItem As Long ' 940 End Type Public Declare Function Shell_NotifyIconW Lib "shell32.dll" (ByVal dwMessage As Long, ByRef lpData As NOTIFYICONDATAW) As Long Public Enum eBalloonIconTypes NIIF_NONE = 0 NIIF_INFO = 1 NIIF_WARNING = 2 NIIF_ERROR = 3 NIIF_NOSOUND = &H10 End Enum Public Sub ShowBalloonTip(ByVal sMessage As String, Optional ByVal sTitle As String, Optional ByVal eIcon As eBalloonIconTypes, Optional ByVal lTimeOutMs = 30000) Dim nidW As NOTIFYICONDATAW With nidW .cbSize = 936 stringToArray sMessage, .szInfo, 512 stringToArray sTitle, .szInfoTitle, 128 .uTimeOutOrVersion = lTimeOutMs .dwInfoFlags = eIcon .uFlags = NIF_INFO .hwnd = Me.hWnd Shell_NotifyIconW NIM_MODIFY, nidW End With End Sub
Note: VB gets the "wrong" size for NOTIFYICONDATAW when using the Len() function as you normally would to pass the size of a structure to an API. It return 940 instead of 936, causing the call to fail. This is the reason why the literal value is used there for nidW.cbSize.