Put app icon in system tray
The following is reprinted for archival purposes from Gary Beene's Information Center, with permission from Mr. Beene himself.
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" ( ByVal dwMessage As Long , lpData As NOTIFYICONDATA) As Long
'Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias " Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'These three constants specify what you want to do
Private Const NIM_Add = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MOUSEMOVE = &H200
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
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 IconData As NOTIFYICONDATA
Sub ShowApp()
Me .WindowState = vbNormal
Shell_NotifyIcon NIM_DELETE, IconData
Me .Show
End Sub
Private Sub Form_Load()
With IconData
.cbSize = Len(IconData) ' The length of the NOTIFYICONDATA Type
.hIcon = Me .Icon ' A reference to the form's icon
.hwnd = Me .hwnd ' hWnd of the form
.szTip = "My Tooltip" & Chr (0) ' Tooltip String delimited with a Null character
.uCallbackMessage = WM_MOUSEMOVE ' The icon we're placing will send messages to the MouseMove event
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE ' It will have message handling and a tooltip
.uID = vbNull ' uID is not used by VB, so it's set to a Null value
End With
End Sub
Private Sub Form_MouseMove(Button As Integer , Shift As Integer , X As Single , Y As Single )
Dim Msg As Long
Msg = X / Screen.TwipsPerPixelX ' The message Is passed to the X value
If Msg = WM_LBUTTONDBLCLK Then ' The user has double-clicked your icon
Call Command1_Click ' Show the window
ElseIf Msg = WM_RBUTTONDOWN Then
' Right-click
' PopupMenu mnuPopup
' Popup the menu
End If
End Sub
Private Sub Form_Resize()
If Me .WindowState = 1 Then
Call Shell_NotifyIcon(NIM_Add, IconData)
Me .Hide
End If
End Sub
Private Sub Form_Unload(Cancel As Integer )
Shell_NotifyIcon NIM_DELETE, IconData
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.