因为嵌入FLASH
FLASH控件没有.HWND所有用钓子生成EXE之后就不好使了.
请问有谁有更好的方法
希望得到回得....
QQ52061601
1.将Flash控件放入一个容器,比如PictureBox(可以把PictureBox的边框去掉),然后把PictureBox的Enabled设为False就可以禁用Flash右键,不过,也禁用了Flash动画的所有鼠标事件了。 2.如何屏蔽文本框右键菜单 使用子类技术 '窗体中代码 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) ' 用SubClass1_WndMessage代替窗口函数处理消息 Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage) End Sub
Private 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) ' 弹出自定义菜单 'PopupMenu usermenu End Sub
'模块中代码 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 SubClass1_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long If Msg <> WM_CONTEXTMENU Then SubClass1_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp) ' 如果消息不是WM_CONTEXTMENU,就调用默认的窗口函数处理 Exit Function End If SubClass1_WndMessage = True End Function
Flash控件没有Hwnd属性,但是可以通过别的途径取得 ' 窗体模块 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Dim Handle As Long ' 窗口句柄 Private Sub Form_Load() Dim ParentHandle As Long ' 父窗口句柄 ParentHandle = FindWindow("ThunderFormDC", "Form1") ' 获得父窗口句柄 Handle = FindWindowEx(ParentHandle, 0&, "MacromediaFlashPlayerActiveX", vbNullString) ' 获得窗口句柄 ret = SetWindowLong(Handle, GWL_WNDPROC, AddressOf WindowProc) End Sub
Private Sub Form_Unload(Cancel As Integer) SetWindowLong Handle, GWL_WNDPROC, ret End Sub ' 标准模块 Option Explicit 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private 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, ByVal lprc As Any) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Public Const GWL_WNDPROC = (-4) Private Const TPM_LEFTALIGN = &H0& Private Const WM_RBUTTONDOWN = &H204 Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public ret As Long ' SetWindowLong 的回调函数, 利用 Msg 拦截消息 Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = WM_RBUTTONDOWN Then Dim pos As POINTAPI, hMenu As Long GetCursorPos pos hMenu = GetSubMenu(GetMenu(Form1.hwnd), 0) TrackPopupMenu hMenu, TPM_LEFTALIGN, pos.x, pos.y, ByVal 0&, hwnd, ByVal 0& Exit Function End If WindowProc = CallWindowProc(ret, hwnd, Msg, wParam, lParam) End Function
[此贴子已经被作者于2005-4-16 19:34:23编辑过]