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

原创 2002年12月06日 09:39:00

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

visual studio 2003 中制作popup菜单的方法

由于vs2003跟vc6有很大的不同,所以在vc6中的Component Gallery在vs2003中是找不到的。 1。在资源中先添加一个菜单,起个名字叫 IDR_MENU1 2。到类视图中选中CM...
  • HOOLOO
  • HOOLOO
  • 2009年06月18日 23:09
  • 1207

创建弹出式菜单

创建弹出式菜单时,先创建一个菜单资源,然后调用LoadMenu方法加载菜单资源。 BOOL LoadMenu( LPCTSTR lpszResourceName ); BOOL LoadMenu(...
  • CSDNzhwk
  • CSDNzhwk
  • 2015年08月10日 11:39
  • 694

制作弹出式菜单

1、在资源视图中增加一个MENU资源 ,ID设置为"IDR_MENU_POPUP"。并增加一个主菜单项及其几个子菜单项。2、声明两个变量,一个为指针类型:CMenu *pMenu;CMenu m_Me...
  • leon_founder
  • leon_founder
  • 2006年08月14日 17:52
  • 902

js实现弹出式菜单

 Posted on 2006-12-15 17:02 ddr888 阅读(182) 评论(0)  编辑 收藏 引用 网摘 所属分类: javascript代码 、css+xhtml ...
  • zhihua_1983
  • zhihua_1983
  • 2007年01月20日 13:51
  • 1413

matlab uicontrol中popupmenu(弹出式菜单)用法,用于显示不同的函数

h0=figure('toolbar','none',... 'position',[200 150 450 250],... 'name','实例36'); x=0:0.5:2*pi...
  • qq_18343569
  • qq_18343569
  • 2015年07月15日 11:11
  • 1426

弹出式菜单的实现

弹出式菜单的实现    VB中在菜单设计窗口中设计的菜单是下拉式菜单。下拉式菜单是用户在任何时候都可以在顶端菜单条上选择后拉出的菜单,而弹出式菜单则是在程序界面的一定区域内点按鼠标键后出现的菜单。在某...
  • surro
  • surro
  • 2007年08月20日 18:48
  • 1188

MFC中教你怎么编写弹出式菜单

在VS2008中,不能像VC++6.0那样通过Compnents and Controls来自动添加弹出式菜单,需要手动添加。可以采用两种方式创建弹出式菜单。 一、利用现有的菜单资源创建 (1)首...
  • jiadabin
  • jiadabin
  • 2014年03月31日 18:27
  • 2050

自定义控件之仿HD qq的弹出式小菜单

今天要给大家带来一个自定义控件,这个控件在平板qq HD中有放上效果图 我就截图了我的设备上的一张图,是弹出的状态.如果收起来的时候,覆盖的半透明的白色就会消失,并且弹出来的小菜单都会收回.这就是...
  • u011692041
  • u011692041
  • 2016年01月28日 12:05
  • 1126

制作弹出式菜单按钮

 下面,我们看一下它的制作过程:一、新建一个以CButton类为基类的新类单击“Insert”→“New Class”,建立一个新类。基类设置为CButton,新类起名为CMenuButton。二、利...
  • lsm307742191
  • lsm307742191
  • 2009年03月08日 18:40
  • 655

android组件式开发(1)——可复用的弹出式菜单

组件式开发,融入android **引言** 在app中经常能看到底部弹出式菜单的应用,比如手机qq和微信中头像的选择。这一组件非常常用。所以,将这一组件进行封装后,就可以像使用android 原生...
  • a253664942
  • a253664942
  • 2015年10月03日 18:39
  • 1764
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:制作可以自动隐藏的弹出式菜单
举报原因:
原因补充:

(最多只允许输入30个字)