Text Box控件鼠标右键菜单用自己的替代控件自带问题

Question

自己做了一个右键,但发现原来控件自带的还是会跳出来,想替换原来控件的右键,该怎么办?
谢谢!

Answer 1

Option Explicit
Public OldWindowProc As Long ' 保存默认的窗口函数的地址
Public Const WM_CONTEXTMENU = &H7B' 当右击文本框时，产生这条消息Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
Private 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 Function SubClass_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
' 如果消息不是WM_CONTEXTMENU，就调用默认的窗口函数处理
 If Msg <> WM_CONTEXTMENU Then
   SubClass_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
   Exit Function
 End If
 SubClass_WndMessage = True
End Function-----------------------------------------------------------------------
窗体的代码:
Option Explicit
Private Const GWL_WNDPROC = (-4)
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 1 Then Exit Sub
   OldWindowProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)' 取得窗口函数的地址
   ' 用SubClass_WndMessage代替窗口函数处理消息
   Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage)
End SubPrivate Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then Exit Sub
  ' 恢复窗口的默认函数
  Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWindowProc)
End Sub

Answer 2

或者
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
         If Button = 2 Then
            Text1.Enabled = False
            Me.PopupMenu AAA '自定义菜单.
         End If
         Text1.Enabled = True
End Sub

Answer 3

http://community.csdn.net/Expert/topic/2810/2810828.xml?temp=.5829584

Answer 4

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
         If Button = 2 Then
            Text1.Enabled = False
            Me.PopupMenu AAA '自定义菜单.
         End If
         Text1.Enabled = True
End Sub就这个看得懂,不过好象不行呢

Answer 5

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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 LongPrivate Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Function TextWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lpOldProc As Long
    lpOldProc = GetProp(hwnd, strTextProp)
    If lpOldProc <> 0 Then
        Select Case uMsg
            Case WM_RBUTTONUP
            Case Else
                TextWndProc = CallWindowProc(lpOldProc, hwnd, uMsg, wParam, lParam)
        End Select
    End If
End Function'屏蔽原来的右键菜单
Public Function DisabledTextRBtn(ByVal hwnd As Long) As Long
    Dim lpOldProc As Long
    lpOldProc = GetProp(hwnd, strTextProp)
    If lpOldProc = 0 Then
        SetProp hwnd, strTextProp, GetWindowLong(hwnd, GWL_WNDPROC)
        SetWindowLong hwnd, GWL_WNDPROC, AddressOf TextWndProc
    End If
End Function'恢复原来的右键菜单
Public Function RestoreTextRBtn(ByVal hwnd As Long) As Long
    Dim lpOldProc As Long
    lpOldProc = GetProp(hwnd, strTextProp)
    If lpOldProc <> 0 Then
        SetWindowLong hwnd, GWL_WNDPROC, lpOldProc
        RemoveProp hwnd, strTextProp
    End If
End FunctionSample: DisabledTextRBtn Text1.hwnd
        RestoreTextRBtn Text1.hwnd

Answer 6

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        Text1.Enabled = False
        Text1.Enabled = True
        PopupMenu popMenuName
    End If
End Sub