关键在于对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
文章整理:西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!



