zfbj 发表于 2003-12-11 16:22:00

[讨论]关于在VBA中创建快捷菜单的问题

下面的语句能在用户单击鼠标右键时弹出一个快捷菜单，但是位置不正确。
窗体中的代码：
Option Explicit

Private Const LOGPIXELSX = 88      'Logical pixels/inch in X
Private Const LOGPIXELSY = 90      'Logical pixels/inch in Y
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim hPopupMenu As Long
    Dim lResult As Long
    Dim xScale As Double
    Dim yScale As Double
   
    xScale = GetDeviceCaps(GetWindowDC(GetActiveWindow()), LOGPIXELSX)
    yScale = GetDeviceCaps(GetWindowDC(GetActiveWindow()), LOGPIXELSY)
   
    If Button = 1 Then Exit Sub
   
    hPopupMenu = CreatePopupMenu()
      
    lResult = AppendMenu(hPopupMenu, MF_STRING, IDM_NEW, "&File")
    lResult = AppendMenu(hPopupMenu, MF_STRING, IDM_OPEN, "&Open")
   
    lResult = TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, (Me.Left + X) * 1440 / xScale, (Me.Top + Y) * 1440 / yScale, 0&, GetActiveWindow, vbNull)
   
End Sub

标准模块中的代码：
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function AppendMenu Lib "user32" _
    Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, _
                        ByVal lpNewItem As Any) As Long
Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, _
                                                    ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, _
                                                    ByVal hwnd As Long, lprc As Any) As Long    ' 最后一个参数类型改为Any(从RECT)
' Flags for TrackPopupMenu
Public Const TPM_CENTERALIGN = &H4&
Public Const TPM_LEFTALIGN = &H0&
Public Const TPM_LEFTBUTTON = &H0&
Public Const TPM_RIGHTALIGN = &H8&
Public Const TPM_RIGHTBUTTON = &H2&

Public Const WM_COMMAND = &H111

Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Const MF_STRING = &H0&
Public Const MF_BITMAP = &H4&


Public Const IDM_NEW As Long = 1001
Public Const IDM_OPEN As Long = 1002程序代码内容程序代码内容


请几位版主和各位看一看，能否使弹出菜单显示在正确的位置上？
你也可以下载相关的程序。

mccad 发表于 2003-12-12 10:51:00

    lResult = TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, (Me.Left + X) * 100 / 75, _
                            (Me.Top + Y) * 100 / 75, 0&, GetActiveWindow, vbNull)

zfbj 发表于 2003-12-12 22:13:00

可是对于不同的显示器，这个比率应该是不固定的吧。

wyj7485 发表于 2005-6-28 10:14:00

我使用以下语句刚好合适:



lResult = TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, (Me.Left + X + 120), _<BR>                                                                                                                                                                                                                       (Me.top + Y + 40), 0&amp;, GetActiveWindow, vbNull)


换个机子好象又不行了.

wyj7485 发表于 2005-6-28 10:34:00

请问如何把我的程序与单击<b>快捷菜单上的条目联系起来呢?</b>


<b>也就是如何利用快捷菜单上的条目来处理我的程序.</b>

wyj7485 发表于 2005-6-28 18:21:00

'类加入


Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


Public Type POINTAPI<BR>x As Long<BR>y As Long<BR>End Type


'窗体加入


Dim Pt As POINTAPI<BR>                       <BR>                       GetCursorPos Pt<BR>                       lResult = TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, _<BR>                       Pt.x, Pt.y, 0, GetActiveWindow, 0&amp;)


'这样完全解决了快捷菜单跟随鼠标的问题.

木子歌 发表于 2005-7-1 11:17:00

就是呀，好好玩，不过我从来没用VBA做过菜单呢，包括屏幕菜单，改日我也做做
页: [1]
查看完整版本: [讨论]关于在VBA中创建快捷菜单的问题