The key is that the process of moving the mouse in the menu state will generate a WM_Enteridle message, and WindowFromPoint can obtain the handle of the form of the current mouse to get the class name, with "# 32768" (menu form) Class name) Remain 1 second, send VK_ESCAPE Cancel menu status with keybd_event
But there is still a shortcoming: I can't automatically hide when the mouse is not moved. The help of the Timer control is required.
Paste the following files into Notepad and save it as a corresponding file
AutoHidePopupMenu.vbp =============================================== ===================== Type = EXEFORM = form1.frmreference = * / g {00020430-0000-0000-c000-0000000046} # 2.0 # 0 # .. /../../../..../Windows/System/stdole2.tlb#ole automationModule = module1; module1.basstartup = "form1" exename32 = "autohidepupUpMenu.exe" Command32 = "" name = " AutoHidePopupMenu "HelpContextID =" 0 "CompatibleMode =" 0 "MajorVer = 1MinorVer = 0RevisionVer = 0AutoIncrementVer = 0ServerSupportFiles = 0VersionCompanyName =" zyl910 "CompilationType 0OptimizationType = 0FavorPentiumPro (tm) = 0CodeViewDebugInfo = 0NoAliasing = 0BoundsCheck = 0OverflowCheck = 0FlPointCheck = 0FDIVCheck = 0UnroundedFP = = 0startMode = 0UNATTENDED = 0Retained = 0threadperObject = 0maxNumberurityReads = 1
Form1.frm ================================================= ===================== Version 5.00BEGIN VB.FORM FORM1 BORDERSTYLE = 1 'Fixed Single Caption = "AutoHidePopupment = 330 ClientTop = 330 ClientWidth = 4710 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 3225 ScaleWidth = 4710 StartUpPosition = 3' default window Begin VB.Timer Timer1 Interval = 1000 Left = 2580 Top = 360 End Begin VB.Label LblNow AutoSize = -1 'True Caption = "LblNow" Height = 180 Left = 1410 TabIndex = 1 Top = 210 Width = 540 End Begin VB.Label LblClick AutoSize = -1 'True Caption = "right click" BeginProperty Font Name = "Arial" Size = 26.25 Charset = 134 weight = 400 underline = 0 'false italic = 0' false strikethRough = 0 'false endproperty height = 525 left = 720 TabINDEX =
0 Top = 1200 Width = 3150 End Begin VB.Menu mnuPopup Caption = "Popup" Visible = 0 'False Begin VB.Menu mnuItem1 Caption = "Item & 1" End Begin VB.Menu mnuItem2 Caption = "Item & 2" End Begin VB.Menu mnuItem3 Caption = "Item & 3" End EndEndAttribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Sub Form_Load () 'MsgBox ClassName (Me.hWnd) LblNow.Caption = Now Hook Me.hWnd End Sub
Private Sub Form_Mouseup (Button As Integer, Shift As Integer, x as single, y as single) lblclick_mouseup button, shift, x, y end sub
Private Sub Form_Unload (Cancel AS Integer) UnHook Me.hwnd End Sub
Private Sub LblClick_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button And vbKeyRButton Then 'ShowMsg = True PopupMenu mnuPopup' ShowMsg = False End If End Sub
Private sub timer1_timer () lblnow.caption = now 'Even if you do not move your mouse, the menu will automatically hide if Chktime Ten Chkexit End if End Sub
Module1.bas ================================================= ===================== attribute vb_name = "Module1" Option Explicit '## API ################# ################# == Hardware and system functions ==================== ========= Public Declare Function getCursorpos lib "user32" (LPPOINT AS POINTAPI) AS Longpublic Declare Function GettickCount LIB "Kernel32" () AS Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Public Const VK_ESCAPE = & H1BPublic Const KEYEVENTF_KEYUP = & H2
TYPE POINTAPI X as long y as longend type
'== Control and message function ==============================================Droc Get the class name 'setWindowlong for the specified window Set information for the specified form. Return value: long, specify the previous value of the data. 'WindowFromPoint returns the handle of the window that contains the specified point. 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 LongPublic Declare Function GetClassNameA Lib "user32" (ByVal hWnd As Long, lpClassName As Any, ByVal nMaxCount As Long) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function WindowFromPoint Lib "user32" (Byval Xpoint As Long, Byval Ypoint As Long) AS Long '- Setwindowl ------------------------------ Public Const GWL_WNDPROC = -4
'=============================================== Public const WM_EnterIdle = & H121
'=============================================== Public meoldWndProc As long 'old form message handler address
Public showmsg as boolean
Public Oldin As Booleanpublic Oldtime As Longpublic Chktime As Boolean
Public Function ClassName (ByVal hWnd As Long) As String Dim StrData (0 To & H100) As Byte Dim Rc As Long Rc = GetClassNameA (hWnd, StrData (0), & H100) If Rc> 0 Then ClassName = StrConv (LeftB (StrData, RC), vbunicode) Else ClassName = VBnullString End If End FunctionPublic Sub Hook (Byval Hwnd As Long) MeoldWndProc = SetWindowlong (HWND, GWL_WNDPROC, Addressof WINDOP) End Sub
Public Sub UnHook (Byval Hwnd As Long) Call SetWindowlong (HWND, GWL_WNDPROC, MEOLDWNDPROC) End Sub
'Message handling Public Function WindowProc (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg Case WM_ENTERIDLE' Debug.Print "WM_ENTERIDLE" ChkExit Case Else 'If ShowMsg Then Debug. Print UMSG 'Dedicated Message WindowProc = CallWindowProc (MeoldWndProc, HWND, UMSG, WPARAM, LPARAM) End SELECT End Function
