'
'* The original appears to have been written by:
'* He does not appear to have placed a copyright on it
'*
'* I've changed it so that most of it's code can be run from this module
'* I also removed some of the over verbos comments :)
'*
'* Special Note:5/26/2005, by JRP
'* I've discovered that some controls, like SSTab can steal focus
'* away from the Form_MouseMove event.
'* I've altered the module to fix the issue.
'* If you are using one of the 'problem' controls, simply
'* use that control everywhere this module asks for ctrlX.
'* See the other notes placed in this module for more info.
'*
'* Note:5/26/2005, by JRP
'* Added a fix to prevent the tray popup menu while the form is visable
'//////////////////////////////////////////////////////////////////
'//
'//WARNING: If you run this in the IDE, do NOT use the IDE-STOP
'// button to end this program. That will bypass the
'// Form_Unload event which is neccisary to restore
'// the system tray back to it's original state.
'//////////////////////////////////////////////////////////////////
Option Explicit
'//These are the two API functions we'll need to use here. The first
'//is the one that really does the work. The second function is used
'//to take action when the user clicks on the mouse icon (restores the
'//program and brings it to front of all other windows.)
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
'//UDT required by Shell_NotifyIcon API call
Private Type NOTIFYICONDATA
cbSize As Long '//size of this UDT
hWnd As Long '//handle of the app
uId As Long '//unused (set to vbNull)
uFlags As Long '//Flags needed for actions
uCallBackMessage As Long '//WM we are going to subclass
hIcon As Long '//Icon we're going to use for the systray
szTip As String * 64 '//ToolTip for the mouse_over of the icon.
End Type
'//Constants required by Shell_NotifyIcon API call:
Public Const NIM_ADD = &H0 '//Flag : "ALL NEW nid"
Public Const NIM_MODIFY = &H1 '//Flag : "ONLY MODIFYING nid"
Public Const NIM_DELETE = &H2 '//Flag : "DELETE THE CURRENT nid"
Public Const NIF_MESSAGE = &H1 '//Flag : "Message in nid is valid"
Public Const NIF_ICON = &H2 '//Flag : "Icon in nid is valid"
Public Const NIF_TIP = &H4 '//Flag : "Tip in nid is valid"
Public Const WM_MOUSEMOVE = &H200 '//This is our CallBack Message
Public Const WM_LBUTTONDOWN = &H201 '//LButton down
Public Const WM_LBUTTONUP = &H202 '//LButton up
Public Const WM_LBUTTONDBLCLK = &H203 '//LDouble-click
Public Const WM_RBUTTONDOWN = &H204 '//RButton down
Public Const WM_RBUTTONUP = &H205 '//RButton up
Public Const WM_RBUTTONDBLCLK = &H206 '//RDouble-click
Private nid As NOTIFYICONDATA '//global UDT for the systray function
Public g_bIconSwitch As Boolean
Public g_MinimizeToTray As Boolean
'!!! NOTE!!!!
'Copy these REMed subs into your main Form!!!!
'Private Sub Form_Activate()
' InitalizeTray Me.hWnd, Me.Icon, "Cool, We're in the SysTray!"
' 'NOTE!, if you're using a 'problem' control like SSTab, then use this line instead
' 'InitalizeTray SSTab1, Me.Icon, "Cool, We're in the SysTray!"
'End Sub
'
'### !!!NOTE!!! ### If you attach to a control like SSTab
' Change the name of the next sub
' Example:
' Private Sub SSTab_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
' X As Single, Y As Single)
''Purpose: This is the callback function of icon in the
'' system tray. This is where it will process
'' what the application will do when Mouse Input
'' is given to the icon.
' Dim msg As Long '//The callback value
'
' 'Prevent the popup window from opening if the
' 'form is already visable
' If Me.Visible Then Exit Sub
' If (Me.ScaleMode = vbPixels) Then
' msg = X
' Else
' msg = X / Screen.TwipsPerPixelX
' End If
'
' Select Case Msg
'' Case WM_LBUTTONUP, WM_LBUTTONDBLCLK '514 restore form window, single click
'' RestoreFromSysTray Me
' Case WM_LBUTTONDBLCLK '515 restore form window, double click
' RestoreFromSysTray Me
' Case WM_RBUTTONUP '517 display popup menu
' Result = SetForegroundWindow(Me.hwnd)
' Me.PopupMenu Me.mPopupSys
' End Select
'End Sub
'
'Private Sub Form_Resize()
''If the form is only minimized, it's icon will stay in the TaskBar
''So use this next line so that it only shows in the SysTray
' If (Me.WindowState = vbMinimized) Then Me.Hide
'End Sub
'
'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' KillTrayIcon
' Set Me = Nothing
'End Sub
'Public Sub InitalizeTray(ByRef ctrlX As Control, TrayIcon As Picture, ByRef ToolTip As String)
Public Sub InitalizeTray(ByRef hWnd As Long, TrayIcon As Picture, ByRef ToolTip As String)
'This uses the UTD to place your apps Icon in the SysTray
' the form must be fully visable.
'The Form_Activate Event is a perfect place for the call to this sub.
'NOTE: ctrlX can be your form or a control such as SSTab
With nid
.cbSize = Len(nid)
' .hWnd = ctrlX.hWnd
.hWnd = hWnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = TrayIcon
.szTip = ToolTip & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid
End Sub
Public Sub RestoreFromSysTray(frmX As Form)
'Call this sub after someone LeftClicks your tray Icon
'Or anytime you want to restore the program window
frmX.WindowState = vbNormal
Call SetForegroundWindow(frmX.hWnd)
frmX.Show
End Sub
'Public Sub ChangeToolTip(ctrlX As Control, ByRef NewTip As String)
Public Sub ChangeToolTip(ByRef hWnd As Long, ByRef NewTip As String)
'Purpose: Change the ToolTip of the System Tray Icon
'NOTE: ctrlX can be your form or a control such as SSTab
' Be sure to use the same control as you used in InitalizeTray
Dim nidNewTip As NOTIFYICONDATA '//New ToolTip nid
With nidNewTip
.cbSize = Len(nidNewTip)
' .hWnd = ctrlX.hWnd
.hWnd = hWnd
.uId = vbNull
.uFlags = NIF_TIP '//Here the Tip is the only valid "new data"
.szTip = NewTip & vbNullChar
End With
Shell_NotifyIcon NIM_MODIFY, nidNewTip
End Sub
'Public Sub AutoSwitchIcons(ctrlX As Control, Icon1 As Picture, Icon2 As Picture)
Public Sub AutoSwitchIcons(hWnd As Long, Icon1 As Picture, Icon2 As Picture)
'This lets you Swicth/flash between two Icons
'Just place the next call in you Timer sub/loop
' AutoSwitchIcons SSTab1, Me.Icon, Icon2
'NOTE: ctrlX can be your form or a control such as SSTab
' Be sure to use the same control as you used in InitalizeTray
Dim nidflash As NOTIFYICONDATA '//New "Flashing" nid
Static SwitchIcons As Boolean '//Flag to decide which icon to show
If Not g_bIconSwitch Then Exit Sub
With nidflash
'//only thing we're really changing from
'//the original structure is the icon.
'//Hence the NIF_ICON flag.
.cbSize = Len(nidflash)
.hWnd = hWnd
.uId = vbNull
.uFlags = NIF_ICON
If (SwitchIcons) Then
'//we need to change it to the
'//"non-app" icon.
.hIcon = Icon2
SwitchIcons = False
Else
.hIcon = Icon1
SwitchIcons = True
End If
End With
Shell_NotifyIcon NIM_MODIFY, nidflash
End Sub
'Public Sub ChangeIcon(ctrlX As Control, NewIcon As Picture)
Public Sub ChangeIcon(hWnd As Long, NewIcon As Picture)
'This let's you change the icon to whatwere you may want
'NOTE:
' You can also use it to make sure you have the original Icon
' after useing AutoSwitchIcons by using the next call:
' ChangeIcon Me, Me.Icon
'NOTE: ctrlX can be your form or a control such as SSTab
' Be sure to use the same control as you used in InitalizeTray
Dim nidChangeIcon As NOTIFYICONDATA '//New "Flashing" nid
With nidChangeIcon
'//We're only changing the Icon
'//Hence the NIF_ICON flag.
.cbSize = Len(nidChangeIcon)
.hWnd = hWnd
.uId = vbNull
.uFlags = NIF_ICON
.hIcon = NewIcon
End With
Shell_NotifyIcon NIM_MODIFY, nidChangeIcon
End Sub
Public Sub KillTrayIcon()
'Call this from you Form's Unload event, before: Set ME = Nothing
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Reply With Quote
Originally Posted by timeshifter
