VB 托盘菜单问题 (在线等)
发布网友
发布时间：2023-11-25 22:00
共4个回答
热心网友
时间：2024-10-27 08:42
一、创建模块，并在模块中复制下面代码，然后保存。
'====模块代码====
Option Explicit
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
Hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type
Private Declare Function CallNextHookEx Lib "user32.dll" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByRef lParam As MOUSEHOOKSTRUCT) As Long
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" ( _
ByVal hHook As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Dim hHook As Long
Private Function GetWinClass(hwd As Long) As String
Dim retvalue As Long, TempStr As String * 254
retvalue = GetClassName(hwd, TempStr, 254)
GetWinClass = StrConv(LeftB(StrConv(TempStr, vbFromUnicode), retvalue), vbUnicode)
End Function
Public Function EnableMouseLLHook()
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, 0)
End Function
Public Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
LowLevelMouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
If (nCode < 0) Then Exit Function
Select Case wParam
Case WM_LBUTTONUP, WM_RBUTTONUP
Dim Curwindow As Long
Curwindow = WindowFromPoint(lParam.pt.x, lParam.pt.y)
Curwindow = GetParent(Curwindow)
If Curwindow<>0 Then
MsgBox Curwindow
End If
DisableMouseLLHook
End Select
End Function
Public Function DisableMouseLLHook()
hHook = UnhookWindowsHookEx(hHook)
End Function
'二、除了在Form_MouseMove作如下修改外，其他代码不变，然后运行，OK。
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
If lMsg = WM_LBUTTONUP Then Me.Visible = True
If lMsg = WM_RBUTTONUP Then
EnableMouseLLHook '监视鼠标按键动作
Me.PopupMenu sys
end if
End Sub
热心网友
时间：2024-10-27 08:43
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
If lMsg = WM_LBUTTONUP Then Me.Visible = True
If lMsg = WM_RBUTTONUP Then Me.PopupMenu sys
End Sub
lMsg 是什么东西啊？
这样写代码，右键可以正常显示菜单，奇怪了
热心网友
时间：2024-10-27 08:43
你能否表达清楚点?
热心网友
时间：2024-10-27 08:44
