制作可以自动隐藏的弹出式菜单

关键在于对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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有