update
parent
41975484fb
commit
6a65a33992
|
|
@ -0,0 +1,233 @@
|
|||
Attribute VB_Name = "Tray_Tools"
|
||||
'#######################################模块说明#########################################
|
||||
|
||||
'名称:托盘工具
|
||||
|
||||
'功能:实现VB托盘和托盘气泡添加，修改，删除等功能
|
||||
|
||||
'最后更新日期:2014年7月10日
|
||||
|
||||
'创建人:蒋天蓓
|
||||
|
||||
'单位:上海市定海水电工程安装有限公司
|
||||
|
||||
''====================================模块使用说明=======================================
|
||||
'****************************************************
|
||||
'添加托盘：Tray_Add (窗体句柄 As Long, 图标句柄 As Long, 提示语 As String), _
|
||||
[气泡开关 As Boolean = False(默认关)](可选), _
|
||||
[气泡标题 As String](可选), _
|
||||
[气泡内容 As String](可选), _
|
||||
[气泡图标 As NIIF_InFoType](可选), _
|
||||
[气泡显示时间 As Long](可选))
|
||||
|
||||
'修改托盘：Tray_Change (窗体句柄 As Long, 图标句柄 As Long, 提示语 As String), _
|
||||
[气泡开关 As Boolean = False(默认关)](可选), _
|
||||
[气泡标题 As String](可选), _
|
||||
[气泡内容 As String](可选), _
|
||||
[气泡图标 As NIIF_InFoType](可选), _
|
||||
[气泡显示时间 As Long](可选))
|
||||
|
||||
'删除托盘：Tray_Del()
|
||||
'****************************************************
|
||||
'托盘菜单：Tray_Menu (Frm As Form, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
'#######################################模块说明#########################################
|
||||
Option Explicit
|
||||
'''========================托盘图标============================
|
||||
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
|
||||
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
|
||||
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
|
||||
Private Const WM_MOUSEMOVING = &H200 '在图标上移动鼠标
|
||||
Private Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
|
||||
Private Const WM_LBUTTONUP = &H202 '鼠标左键释放
|
||||
Private Const WM_LBUTTONDBLCLK = &H203 '双击鼠标左键
|
||||
Private Const WM_RBUTTONDOWN = &H204 '鼠标右键按下
|
||||
Private Const WM_RBUTTONUP = &H205 '鼠标右键释放
|
||||
Private Const WM_RBUTTONDBLCLK = &H206 '双击鼠标右键
|
||||
Private Const WM_MBUTTONDOWN = &H207 '鼠标右键按下
|
||||
Private Const WM_MBUTTONUP = &H208 '鼠标右键释放
|
||||
Private Const WM_MBUTTONDBLCLK = &H209 '双击鼠标右键
|
||||
Private Const WM_SETHOTKEY = &H32 '响应您定义的热键
|
||||
Private Const WM_USER = &H400
|
||||
Private Const WM_NOTIFYICON = WM_USER + 1 ' 自定义消息
|
||||
Private Const GWL_WNDPROC = (-4) ' 关于气球提示的自定义消息, 2000下不产生这些消息
|
||||
Private Const NIN_BALLOONSHOW = (WM_USER + &H2) ' 当 Balloon Tips 弹出时执行
|
||||
Private Const NIN_BALLOONHIDE = (WM_USER + &H3) ' 当 Balloon Tips 消失时执行（如 SysTrayIcon 被删除），' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息
|
||||
Private Const NIN_BALLOONTIMEOUT = (WM_USER + &H4) ' 当 Balloon Tips 的 TimeOut 时间到时执行
|
||||
Private Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。
|
||||
' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮,
|
||||
' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。
|
||||
Private 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 ' 气球提示文本
|
||||
uTimeoutOrVersion As Long ' 气球提示消失时间或版本
|
||||
' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000)
|
||||
' uVersion - 版本(0 for V4, 3 for V5)
|
||||
szInfoTitle As String * 64 ' 气球提示标题
|
||||
dwInfoFlags As Long ' 气球提示图标
|
||||
End Type ' dwState to NOTIFYICONDATA structure
|
||||
Private Const NIS_HIDDEN = &H1 ' 隐藏图标
|
||||
Private Const NIS_SHAREDICON = &H2 ' 共享图标' dwInfoFlags to NOTIFIICONDATA structure
|
||||
Public Enum NIIF_InFoType
|
||||
NIIF_NONE = &H0 ' 无图标
|
||||
NIIF_INFO = &H1 ' "消息"图标
|
||||
NIIF_WARNING = &H2 ' "警告"图标
|
||||
NIIF_ERROR = &H3 ' "错误"图标
|
||||
End Enum ' uFlags to NOTIFYICONDATA structure
|
||||
Private Const NIF_MESSAGE As Long = &H1
|
||||
Private Const NIF_ICON As Long = &H2
|
||||
Private Const NIF_TIP As Long = &H4
|
||||
Private Const NIF_STATE As Long = &H8
|
||||
Private Const NIF_INFO As Long = &H10 ' dwMessage to Shell_NotifyIcon
|
||||
Private Const NIM_ADD As Long = &H0
|
||||
Private Const NIM_MODIFY As Long = &H1
|
||||
Private Const NIM_DELETE As Long = &H2
|
||||
Private Const NIM_SETFOCUS As Long = &H3
|
||||
Private Const lngNIM_SETVERSION As Long = &H4
|
||||
Private Tray As NOTIFYICONDATA
|
||||
Public OldWndProc As Long
|
||||
|
||||
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
|
||||
"RegisterWindowMessageA" (ByVal lpString As String) As Long
|
||||
|
||||
Private Const RASDIALEVENT = "RasDialEvent"
|
||||
Private Const WM_RASDIALEVENT = &HCCCD&
|
||||
Public m_RasMessage As Long
|
||||
|
||||
''''========================托盘图标============================
|
||||
Public Sub Tray_Add(ByVal hwnd As Long, ByVal Icon As Long, ByVal Tip As String, _
|
||||
Optional ByVal bTipInfo As Boolean = False, _
|
||||
Optional ByVal TipInfoTitle As String = vbNullString, _
|
||||
Optional ByVal TipInfo As String = vbNullString, _
|
||||
Optional ByVal TipInfoType As NIIF_InFoType = NIIF_INFO, _
|
||||
Optional ByVal TipInfoDaily As Long = 1000)
|
||||
With Tray
|
||||
.cbSize = Len(Tray)
|
||||
.uId = 0
|
||||
.hwnd = hwnd '托盘句柄
|
||||
.hIcon = Icon
|
||||
.szTip = Tip & vbNullChar '鼠标移动到托盘时显示内容
|
||||
.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
|
||||
.uCallBackMessage = WM_NOTIFYICON
|
||||
.dwState = 0
|
||||
.dwStateMask = 0
|
||||
If bTipInfo Then .uFlags = .uFlags Or NIF_INFO Or NIF_STATE
|
||||
.szInfoTitle = TipInfoTitle & vbNullChar '气泡标题
|
||||
.szInfo = TipInfo & vbNullChar '气泡内容
|
||||
.dwInfoFlags = TipInfoType '气泡图标
|
||||
.uTimeoutOrVersion = TipInfoDaily '气泡延时时间
|
||||
End With
|
||||
If OldWndProc = 0 Then
|
||||
OldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf TrayWndProc)
|
||||
Shell_NotifyIcon NIM_ADD, Tray
|
||||
Else
|
||||
Shell_NotifyIcon NIM_MODIFY, Tray
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub Tray_Change(ByVal hwnd As Long, _
|
||||
Optional ByVal Icon As Long = 0, _
|
||||
Optional ByVal Tip As String = "", _
|
||||
Optional ByVal bTipInfo As Boolean = False, _
|
||||
Optional ByVal TipInfoTitle As String = vbNullChar, _
|
||||
Optional ByVal TipInfo As String = vbNullChar, _
|
||||
Optional ByVal TipInfoType As NIIF_InFoType = NIIF_NONE, _
|
||||
Optional ByVal TipInfoDaily As Long = 0)
|
||||
With Tray
|
||||
If Icon <> 0 Then .hIcon = Icon
|
||||
If Tip <> "" Then .szTip = Tip & vbNullChar: .uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
|
||||
If bTipInfo Then .uFlags = .uFlags Or NIF_INFO Or NIF_STATE
|
||||
.szInfoTitle = TipInfoTitle & vbNullChar
|
||||
.szInfo = TipInfo & vbNullChar
|
||||
.dwInfoFlags = TipInfoType
|
||||
.uTimeoutOrVersion = TipInfoDaily
|
||||
End With
|
||||
Shell_NotifyIcon NIM_MODIFY, Tray
|
||||
End Sub
|
||||
|
||||
|
||||
Public Sub Tray_Del()
|
||||
If OldWndProc <> 0 Then SetWindowLong Tray.hwnd, GWL_WNDPROC, OldWndProc
|
||||
OldWndProc = 0
|
||||
Shell_NotifyIcon NIM_DELETE, Tray
|
||||
End Sub
|
||||
|
||||
''**************************************************************************
|
||||
''*******窗口过程拦截函数'OldWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf TrayWndProc)
|
||||
''**************************************************************************
|
||||
'Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
|
||||
'Private Const WM_MOUSEMOVING = &H200 '在图标上移动鼠标
|
||||
'Private Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
|
||||
'Private Const WM_LBUTTONUP = &H202 '鼠标左键释放
|
||||
'Private Const WM_LBUTTONDBLCLK = &H203 '双击鼠标左键
|
||||
'Private Const WM_RBUTTONDOWN = &H204 '鼠标右键按下
|
||||
'Private Const WM_RBUTTONUP = &H205 '鼠标右键释放
|
||||
'Private Const WM_RBUTTONDBLCLK = &H206 '双击鼠标右键
|
||||
'Private Const WM_MBUTTONDOWN = &H207 '鼠标右键按下
|
||||
'Private Const WM_MBUTTONUP = &H208 '鼠标右键释放
|
||||
'Private Const WM_MBUTTONDBLCLK = &H209 '双击鼠标右键
|
||||
'Private Const WM_SETHOTKEY = &H32 '响应您定义的热键
|
||||
'Private Const WM_USER = &H400
|
||||
'Private Const WM_NOTIFYICON = WM_USER + 1 ' 自定义消息
|
||||
'Private Const GWL_WNDPROC = (-4) ' 关于气球提示的自定义消息, 2000下不产生这些消息
|
||||
'Private Const NIN_BALLOONSHOW = (WM_USER + &H2) ' 当 Balloon Tips 弹出时执行
|
||||
'Private Const NIN_BALLOONHIDE = (WM_USER + &H3) ' 当 Balloon Tips 消失时执行（如 SysTrayIcon 被删除），' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息
|
||||
'Private Const NIN_BALLOONTIMEOUT = (WM_USER + &H4) ' 当 Balloon Tips 的 TimeOut 时间到时执行
|
||||
'Private Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。
|
||||
''*******窗口过程拦截*********************************************************
|
||||
'Public Function TrayWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
|
||||
' ' 拦截 WM_NOTIFYICON 消息
|
||||
' If Msg = WM_NOTIFYICON Then
|
||||
' Select Case lParam
|
||||
'
|
||||
' Case WM_LBUTTONUP
|
||||
' Debug.Print "左键单击"
|
||||
'
|
||||
' Case WM_LBUTTONDBLCLK
|
||||
' Debug.Print "左键双击"
|
||||
'
|
||||
' Case WM_RBUTTONUP
|
||||
' Debug.Print "右键单击"
|
||||
'
|
||||
' Case WM_RBUTTONDBLCLK
|
||||
' Debug.Print "右键双击"
|
||||
'
|
||||
' Case WM_MBUTTONUP
|
||||
' Debug.Print "中键单击"
|
||||
'
|
||||
' Case WM_MBUTTONDBLCLK
|
||||
' Debug.Print "中键双击"
|
||||
'
|
||||
' Case NIN_BALLOONSHOW
|
||||
' Debug.Print "显示气球提示"
|
||||
'
|
||||
' Case NIN_BALLOONHIDE
|
||||
' Debug.Print "删除托盘图标"
|
||||
'
|
||||
' Case NIN_BALLOONTIMEOUT
|
||||
' Debug.Print "气球提示消失"
|
||||
'
|
||||
' Case NIN_BALLOONUSERCLICK
|
||||
' Debug.Print "单击气球提示"
|
||||
'
|
||||
' Case WM_MOUSEMOVING
|
||||
' Debug.Print "鼠标移动"
|
||||
'
|
||||
' Case Else
|
||||
' Debug.Print lParam
|
||||
'
|
||||
' End Select
|
||||
' End If
|
||||
' TrayWndProc = CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam)'将消息发回原来的窗体
|
||||
'End Function
|
||||
''**************************************************************************
|
||||
''*******窗口过程拦截*******************************************************
|
||||
''**************************************************************************
|
||||
|
||||
Loading…
Reference in New Issue