屏蔽webbrowser控件右键的一种方法
2005-12-24 19:14
288 查看
Option Explicit
Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes 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
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2
Private Const PM_REMOVE = &H1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Msg
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private bCancel As Boolean
Private webHwnd As Long '窗体中webbrowser控件的句柄
Private Sub ProcessMessages()
Dim Message As Msg
'loop until bCancel is set to True
Do While Not bCancel
'等待一个消息
WaitMessage
'检查webbrowser控件及其子窗口的所有消息
If PeekMessage(Message, webHwnd, 0, 0, PM_REMOVE) Then
Select Case Message.Message
'过滤掉关于右键操作的三个消息WM_RBUTTONDOWN 、WM_RBUTTONUP、WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
MsgBox "Webbrowser控件的WM_RBUTTONDOWN消息已经被屏蔽"
Case WM_RBUTTONUP
MsgBox "Webbrowser控件的WM_RBUTTONUP消息已经被屏蔽"
Case WM_RBUTTONDBLCLK
MsgBox "Webbrowser控件的WM_RBUTTONDBLCLK消息已经被屏蔽"
'对于其它消息则放行
Case Else
TranslateMessage Message
DispatchMessage Message
End Select
End If
'将控制权交还给系统,否则将陷入死循环
DoEvents
Loop
End Sub
Private Sub Form_Load()
Dim Ret As Long
bCancel = False
Show
webHwnd = FindWindowEx(Me.hwnd, 0, "Shell Embedding", vbNullString)
If webHwnd > 0 Then
'ProcessMessages
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
bCancel = True
End Sub
遗憾的是,程序有时候会发生进程阻塞,导致拦截消息失败
Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes 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
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2
Private Const PM_REMOVE = &H1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Msg
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private bCancel As Boolean
Private webHwnd As Long '窗体中webbrowser控件的句柄
Private Sub ProcessMessages()
Dim Message As Msg
'loop until bCancel is set to True
Do While Not bCancel
'等待一个消息
WaitMessage
'检查webbrowser控件及其子窗口的所有消息
If PeekMessage(Message, webHwnd, 0, 0, PM_REMOVE) Then
Select Case Message.Message
'过滤掉关于右键操作的三个消息WM_RBUTTONDOWN 、WM_RBUTTONUP、WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
MsgBox "Webbrowser控件的WM_RBUTTONDOWN消息已经被屏蔽"
Case WM_RBUTTONUP
MsgBox "Webbrowser控件的WM_RBUTTONUP消息已经被屏蔽"
Case WM_RBUTTONDBLCLK
MsgBox "Webbrowser控件的WM_RBUTTONDBLCLK消息已经被屏蔽"
'对于其它消息则放行
Case Else
TranslateMessage Message
DispatchMessage Message
End Select
End If
'将控制权交还给系统,否则将陷入死循环
DoEvents
Loop
End Sub
Private Sub Form_Load()
Dim Ret As Long
bCancel = False
Show
webHwnd = FindWindowEx(Me.hwnd, 0, "Shell Embedding", vbNullString)
If webHwnd > 0 Then
'ProcessMessages
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
bCancel = True
End Sub
遗憾的是,程序有时候会发生进程阻塞,导致拦截消息失败
相关文章推荐
- 屏蔽webbrowser控件右键的一种方法
- WebBrowser 控件中屏蔽alert,confirm脚本对话框的方法-默认点击确定或取消。
- 一种屏蔽鼠标右键的JS方法
- VB Webbrowser控件如何屏蔽右键
- webBrowser控件一招解决屏蔽右键
- 在webbrowser控件中禁用右键的方法
- WebBrowser 控件中屏蔽alert,confirm脚本对话框的方法。
- 通过消息拦截达到在Delphi控件中屏蔽原有事件处理的一种方法
- Webbrowser控件判断网页加载完毕的简单方法
- 在VC中使用WebBrowser控件的两方法
- Delphi中禁止WebBrowser右键的方法
- 屏蔽页面右键及选择文本的方法
- js 屏蔽鼠标右键脚本附破解方法
- 使用w使使用webbrowser控件,浏览页面时,点右键查看属性时程序死掉
- 一种屏蔽所有系统热键的方法
- WebBrowser控件中禁止alert,confirm等对话框的方法
- JS实现屏蔽鼠标右键的方法
- [转]Webbrowser控件判断网页加载完毕的简单方法
- flash屏蔽右键的方法
- 真正屏蔽FLASH右键方法