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
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
Private Sub Form_Load()
WebBrowser.Navigate "(withheld)"
App.TaskVisible = False
Call AddIcon("This would be a tooltip...")
End Sub
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
Call PopupMenu(mnuFile, vbPopupMenuRightAlign)
End Select
Exit Sub
ErrorHandler: 'Display error message
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbInformation, App.ProductName & " - " & Me.Caption
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
Private Sub mnuFileArray_Click(Index As Integer)
Select Case Index
Case 0 'Normal
Me.WindowState = vbNormal
Case 1 'Minimized
Me.WindowState = vbMinimized
Case 4 'Exit
Unload Me
End
End Select
End Sub
Private Sub cmdHome_Click()
WebBrowser.Navigate "(withheld)"
End Sub
Private Sub cmdArchive_Click()
WebBrowser.Navigate "(withheld)"
End Sub
Private Sub cmdPost_Click()
WebBrowser.Navigate "(withheld)"
End Sub
Private Sub cmdProfile_Click()
WebBrowser.Navigate "(withheld)"
End Sub
Private Sub cmdExit_Click()
Unload frmBrowser
End Sub
Private Sub cmdMini_Click()
frmSysTrayIcon.WindowState = vbMinimized
End Sub
Private Sub cmdLogOut_Click()
WebBrowser.Navigate "(withheld)"
End Sub
