關鍵在于對WM_ENTERIDLE消息的處理
在菜單狀態下移動鼠標會產生WM_ENTERIDLE消息
這時用TempPoint、WindowFromPoint可以取得當前鼠標所指窗體的句柄
再用GetClassName取得類名，與"#32768"（菜單窗體的類名）進行比較
再等待1秒鐘，用keybd_event發送VK_ESCAPE取消菜單狀態

但是還是有一個的缺點：無法在鼠標不移動的時候自動隱藏
這時需要Timer控件的幫忙

?

---

?

將下列文件粘貼到記事本，并保存為相應文件

AutoHidePopupMenu.vbp
====================================================================
Type=Exe
Form=Form1.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#../../../../../../WINDOWS/SYSTEM/stdole2.tlb#OLE Automation
Module=Module1; Module1.bas
Startup="Form1"
ExeName32="AutoHidePopupMenu.exe"
Command32=""
Name="AutoHidePopupMenu"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="zyl910"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

?

Form1.frm
====================================================================
VERSION 5.00
Begin VB.Form Form1
?? BorderStyle???? =?? 1? 'Fixed Single
?? Caption???????? =?? "AutoHidePopupMenu"
?? ClientHeight??? =?? 3225
?? ClientLeft????? =?? 45
?? ClientTop?????? =?? 330
?? ClientWidth???? =?? 4710
?? LinkTopic?????? =?? "Form1"
?? MaxButton?????? =?? 0?? 'False
?? ScaleHeight???? =?? 3225
?? ScaleWidth????? =?? 4710
?? StartUpPosition =?? 3? '窗口缺省
?? 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???????? =?? "點擊鼠標右鍵"
????? BeginProperty Font
???????? Name??????????? =?? "宋體"
???????? 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
?? End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private 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
???
??? '這樣即使不移動鼠標，菜單也會自動隱藏
??? If ChkTime Then
??????? ChkExit
??? End If
???
End Sub

?

Module1.bas
====================================================================
Attribute VB_Name = "Module1"
Option Explicit

'## API ########################################
'== 硬件與系統函數 =============================
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public 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 = &H1B
Public Const KEYEVENTF_KEYUP = &H2

Type POINTAPI
??? X As Long
??? Y As Long
End Type

'== 控件與消息函數 =============================
'CallWindowProc? 把消息信息傳遞給指定的窗體過程
'GetClassName??? 為指定的窗口取得類名
'SetWindowLong?? 在窗體結構中為指定的窗體設置信息。返回值：Long，指定數據的前一個值。
'WindowFromPoint 返回包含了指定點的窗口的句柄。
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 GetClassNameA Lib "user32" (ByVal hWnd As Long, lpClassName As Any, ByVal nMaxCount 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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

'-- SetWindowLong ------------------------------
Public Const GWL_WNDPROC = -4

'===============================================
Public Const WM_ENTERIDLE = &H121

'===============================================
Public MeOldWndProc As Long '舊的窗體消息處理程序地址

Public ShowMsg As Boolean

Public OldIn As Boolean
Public OldTime As Long
Public 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 Function

Public Sub Hook(ByVal hWnd As Long)
??? MeOldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
???
End Sub

Public Sub UnHook(ByVal hWnd As Long)
??? Call SetWindowLong(hWnd, GWL_WNDPROC, MeOldWndProc)
???
End Sub

'消息處理
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
???????
??????? '下級傳遞消息
??????? WindowProc = CallWindowProc(MeOldWndProc, hWnd, uMsg, wParam, lParam)
???????
??? End Select
???
End Function

Public Sub ChkExit()
??? Dim TempPoint As POINTAPI
??? Dim TemphWnd As Long
??? Dim TempBool As Boolean
???
??? GetCursorPos TempPoint
??? TemphWnd = WindowFromPoint(TempPoint.X, TempPoint.Y)
??? If TemphWnd Then
??????? TempBool = (ClassName(TemphWnd) = "#32768")
??? Else
??????? TempBool = False
??? End If
??? 'Debug.Print TempBool
???
??? If TempBool <> OldIn Then
??????? If TempBool Then
??????????? OldTime = 0
??????????? ChkTime = False
??????? Else
??????????? OldTime = GetTickCount
??????????? ChkTime = True
??????? End If
??????? OldIn = TempBool
???????
??? End If
???
??? If ChkTime Then
??????? If GetTickCount - OldTime > 1000 Then '大于1秒就退出
??????????? 'Debug.Print "Exit"
??????????? keybd_event VK_ESCAPE, 0, 0, 0
??????????? keybd_event VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0
???????????
??????????? ChkTime = False
???????????
??????? End If
???????
??? End If
???
End Sub

總結

以上是生活随笔為你收集整理的制作可以自动隐藏的弹出式菜单的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。