Windows XP的托盘使用,绝对厚道.
模块:
Option Explicit
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_NOTIFYICON = WM_USER + 1
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_INFO = &H10
Public Const NIF_STATE = &H8
Public Const NIF_MESSAGE = &H1
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIM_SETFOCUS As Long = &H3
Public Const NIM_SETVERSION As Long = &H4
Public Const NIS_HIDDEN = &H1 ' 隐藏图标
Public Const NIS_SHAREDICON = &H2 ' 共享图标
Public Const NIIF_NONE = &H0 ' 无图标
Public Const NIIF_INFO = &H1 ' 消息图标
Public Const NIIF_WARNING = &H2 ' 警告图标
Public Const NIIF_ERROR = &H3 ' 错误图标
Public Const NIN_BALLOONUSERCLICK = (WM_USER + &H5)
Public Type NOTIFYICONDATA
cbSize As Long ' 结构大小(字节)
hwnd As Long ' 处理消息的窗口的句柄
uId As Long ' 唯一的标识符
uFlags As Long ' Flags
uCallBackMessage As Long ' 处理消息的窗口接收的消息
hIcon As Long ' 托盘图标句柄
szTip As String * 128 ' Tooltip 提示文本
dwState As Long ' 托盘图标状态
dwStateMask As Long ' 状态掩码
szInfo As String * 256 ' 气球提示文本
' 气球提示消失时间(单位:ms, 10000 -- 30000)
uTimeoutOrVersion As Long ' 版本(0 for V4, 3 for V5)
szInfoTitle As String * 64 ' 气球提示标题
dwInfoFlags As Long ' 气球提示图标
End Type
Public TheData As NOTIFYICONDATA
Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If msg = TRAY_CALLBACK Then
If lParam = WM_LBUTTONUP Then '点击左键
'添加代码
Exit Function
ElseIf lParam = WM_RBUTTONUP Then '点击右键
'添加代码
Exit Function
ElseIf lParam = NIN_BALLOONUSERCLICK Then '点击气球
'添加代码
Exit Function
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
End Function
Public Sub AddToTray(Frm As Form, mnu As Menu) '添加图标
Set TheForm = Frm
Set TheMenu = mnu
OldWindowProc = SetWindowLong(Frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
With TheData
.uId = 0
.hwnd = Frm.hwnd
.cbSize = Len(TheData)
.hIcon = Frm.Icon.Handle
.uFlags = NIF_ICON
.uCallBackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
Public Sub RemoveFromTray() '移除图标
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc
End Sub
Public Sub SetTrayTip(tip As String) '添加提示
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
Public Sub SetTrayIcon(pic As Picture) '更换图标
With TheData
.hIcon = pic.Handle
.uFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
Public Sub SetTrayBalloon(NIIFIcon As Long, Info As String, Title As String) '添加气球提示
With TheData
.uId = 0
.cbSize = Len(TheData)
.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE
.uCallBackMessage = TRAY_CALLBACK
.dwState = 0
.dwStateMask = 0
.szInfoTitle = Info & vbNullChar
.szInfo = Title & vbNullChar
.dwInfoFlags = NIIFIcon
.uTimeoutOrVersion = 10000
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
窗体:自己引用.
