webbmenu.bas

这个程序演示如何控制控件的缺省弹出菜单（例如TextBox）

Attribute VB_Name = "Module1"
Option Explicit

' Webbmenu sample from BlackBeltVB.com
' http://blackbeltvb.com
'
' Written by Matt Hart
' Copyright 1999 by Matt Hart
' 
' This software is FREEWARE. You may use it as you see fit for 
' your own projects but you may not re-sell the original or the 
' source code. Do not copy this sample to a collection, such as
' a CD-ROM archive. You may link directly to the original sample
' using "http://blackbeltvb.com/blackbeltvb.htm"
' 
' No warranty express or implied, is given as to the use of this
' program. Use at your own risk.

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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 Const GWL_WNDPROC = (-4)

Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
    
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_CONTEXTMENU = &H7B
Public Const WM_RBUTTONDOWN = &H204

Public origWndProc As Long

Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case Msg
        Case WM_MOUSEACTIVATE
            Dim C As Integer
            Call CopyMemory(C, ByVal VarPtr(lParam) + 2, 2)
            If C = WM_RBUTTONDOWN Then
                Form1.PopupMenu Form1.mnuBrowser
                SendKeys "{ESC}"
            End If
        Case WM_CONTEXTMENU
            Form1.PopupMenu Form1.mnuBrowser
            SendKeys "{ESC}"
    End Select
    AppWndProc = CallWindowProc(origWndProc, hwnd, Msg, wParam, lParam)
End Function