窗体托盘设置，鼠标左键接收不到窗口的句柄
本帖最后由 bcrun 于 2013-06-13 16:45:15 编辑
Option Explicit鼠标
'模块代码
Public Enum bFlag
NIIF_NONE = &H0
NIIF_INFO = &H1
NIIF_WARNING = &H2
NIIF_ERROR = &H3
NIIF_GUID = &H5
NIIF_ICON_MASK = &HF
NIIF_NOSOUND = &H10 '关闭提示音标志
End Enum
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal nd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal nd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long
Private Type NOTIFYICONDATA
cbSize As Long '结构的长度
nd As Long '消息接收窗口的句柄[hwnd现改为nd]
uID As Long '图标的标识
uFlags As Long '设置参数
uCallbackMessage As Long '回调消息的值
hIcon As Long '图标句柄
szTip As String * 128 '提示字符串
dwState As Long
dwStateMask As Long
szInfo As String * 256 '气泡内容
uTimeoutAndVersion As Long
szInfoTitle As String * 64 '气泡标题
dwInfoFlags As Long '气泡样式
End Type
Private Const GWL_WNDPROC = (-4)
Private Const GWL_USERDATA = (-21)
Private Const DBT_DEVICEARRIVAL As Long = &H8000&
Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
Private Const DBT_DEVTYP_VOLUME As Long = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_USER = &H400
Private Const WM_NOTIFYICON = WM_USER + &H100
Private Const WM_NCLBUTTONDBLCLK = &HA3
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_MOUSEMOVE As Long = &H200
Private Const WM_DEVICECHANGE As Long = &H219
Private Const NIN_BALLOONSHOW = (WM_USER + 2) '当气泡提示显示后外壳发送此消息
Private Const NIN_BALLOONHIDE = (WM_USER + 3) '当气泡提示消失时（比如通知栏图标被删除）外壳发送此消息，但气泡提示由于超时而消失不会产生此消息
Private Const NIN_BALLOONTIMEOUT = (WM_USER + 4) '当气泡提示由于超时而消失时外壳发送此消息
Private Const NIN_BALLOONUSERCLICK = (WM_USER + 5) '当用户点击鼠标时（点击气泡提示和通知栏图标均可）外壳发送此消息
Private Const TRAY_CALLBACK = (WM_USER + 1001&)
Private lDefProc As Long
Private NTID As NOTIFYICONDATA
Private nd As Long '[hwnd现改为nd]
Function IconProc(ByVal nd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lngMsg As Long
'On Error Resume Next
'当 Windows 外壳程序 Explorer 重建时，重建系统托盘区图标。
lngMsg = RegisterWindowMessage("TaskbarCreated")
If uMsg = lngMsg Then
DelIcon nd
'Call AddIcon(hwnd, 程序主窗体.Image5.Picture, "最小化中") 'XXXXXXXXXXXXX“程序主窗体”不存在，导致崩溃
Call AddIcon(nd, Form1.Image1.Picture, "最小化中")
Exit Function
End If
' '当单击系统托盘区图标时，显示窗体，删除系统托盘区图标。
If uMsg = TRAY_CALLBACK Then
Select Case lParam
Case WM_LBUTTONUP
Form1.Visible = True
'程序主窗体.Show XXXXXXXXXXXXXXXXXXXXXX“程序主窗体”不存在，导致崩溃
Form1.Show 'XXXXXXXXXXXXXXXXXXXXXXXX
Call DelIcon(nd)
Case WM_RBUTTONUP
MsgBox "点击鼠标右键，可用一些代码弹出菜单", vbExclamation
Case WM_LBUTTONDBLCLK
MsgBox "双击鼠标左键", vbExclamation
End Select
End If
IconProc = CallWindowProc(lDefProc, nd, uMsg, wParam, lParam)
End Function
'添加托盘区图标。lWnd 为窗体句柄，hIcon 为图标的句柄，strTip 为鼠标指向托盘区图标时显示的文本。
Function AddIcon(ByVal lWnd As Long, ByVal hIcon As Long, ByVal strTip As String) As Long
nd = lWnd
lDefProc = SetWindowLong(lWnd, GWL_WNDPROC, AddressOf IconProc)
With NTID
.cbSize = Len(NTID)
.nd = lWnd
.uID = vbNull
.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE
.uCallbackMessage = TRAY_CALLBACK
.hIcon = hIcon
.szTip = strTip & vbNullChar
End With
AddIcon = Shell_NotifyIcon(NIM_ADD, NTID)
End Function
'删除托盘区图标，lWnd 为窗体的句柄
Function DelIcon(ByVal lWnd As Long) As Long
NTID.uFlags = 0
DelIcon = Shell_NotifyIcon(NIM_DELETE, NTID)
SetWindowLong lWnd, GWL_WNDPROC, lDefProc
End Function
'更改托盘区图标，如果在窗体中用 Timer 控件等不断更改图标时，托盘区图标就会动起来。
Function SetIcon(ByVal hIcon As Long) As Long
With NTID
.hIcon = hIcon
.uFlags = NIF_ICON
End With
SetIcon = Shell_NotifyIcon(NIM_MODIFY, NTID)
End Function
'更改鼠标指向托盘区图标时显示的文字。
Function SetTip(ByVal strTip As String)
With NTID
.szTip = strTip & vbNullChar
.uFlags = NIF_TIP
End With
SetTip = Shell_NotifyIcon(NIM_MODIFY, NTID)
End Function
'弹出气泡通知。
Public Sub PopupBalloon(ByVal lWnd As Long, ByVal Prompt As String, ByVal Title As String, Optional ByVal bFlag As bFlag)
With NTID
.cbSize = Len(NTID)
.nd = lWnd
.uID = vbNull
.uFlags = NIF_INFO
.dwInfoFlags = bFlag
.szInfoTitle = Title & vbNullChar
.szInfo = Prompt & vbNullChar
End With
Shell_NotifyIcon NIM_MODIFY, NTID
End Sub
'按钮代码
Private Sub Command1_Click()
' Dim nd
' Dim Application
Dim Cancel As Integer
Dim CloseMode As Integer
If CloseMode = vbFormControlMenu Then
Cancel = 1
Form1.Visible = False
Me.Hide
Call AddIcon(nd, Image1.Picture, "最小化中,点击鼠标左键回复智能窗口") '[hwnd改为nd]
PopupBalloon nd, "程序已被最小化", "最小化", NIIF_INFO '[hwnd改为nd]
End If
End Sub
