tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板) [ツリー表示へ]   [Home]
一括表示(VB.NET VB2005)
タイトルWebBrowserコントロールのカスタマイズ
記事No3020
投稿日: 2006/02/01(Wed) 02:43
投稿者YAS
[OSのVer]:Windows    [VBのVer]:VB2005
たびたびお世話になります。
VB2005にてWebBrowserコントロールのカスタマイズに挑戦しています。
まずはキーボードショートカットのカスタマイズをしようと,
hhttp://msdn2.microsoft.com/ja-
jp/system.windows.forms.webbrowser.createwebbrowsersitebase.aspx
を参考に以下の用に組んで見たのですが,機能しません。
ヘルプの言うようにしたつもりなのですが...
ご存じの方がいらっしゃいましたらご教授をお願いいたします。
Imports System.Runtime.InteropServices
Imports mshtml

Public Class Form1
    WithEvents Browser As New ExWebBrowser
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
        Me.Controls.Add(Browser)
        Browser.Navigate("hhttp://www.yahoo.co.jp")
    End Sub
End Class

Public Class ExWebBrowser
    Inherits WebBrowser

    Sub New()
        MyBase.New()
    End Sub

    Protected Overrides Function CreateWebBrowserSiteBase() As
System.Windows.Forms.WebBrowserSiteBase
        Return New ExWebBrowserSite(Me)
    End Function

    Protected Class ExWebBrowserSite
        Inherits WebBrowser.WebBrowserSite
        Implements IDocHostUIHandler

        Sub New(ByVal host As WebBrowser)
            MyBase.New(host)
        End Sub

        Public Sub EnableModeless(ByVal fEnable As Integer) Implements
IDocHostUIHandler.EnableModeless

        End Sub

        Public Function FilterDataObject(ByVal pDO As System.Windows.Forms.IDataObject) As
System.Windows.Forms.IDataObject Implements IDocHostUIHandler.FilterDataObject
            Return pDO
        End Function

        Public Function GetDropTarget(ByVal pDropTarget As
System.Windows.Forms.IDropTarget) As System.Windows.Forms.IDropTarget Implements
IDocHostUIHandler.GetDropTarget
            Return pDropTarget
        End Function

        Public Function GetExternal() As Object Implements IDocHostUIHandler.GetExternal
            Return Nothing
        End Function

        Public Sub GetHostInfo(ByRef theHostUIInfo As DOCHOSTUIINFO) Implements
IDocHostUIHandler.GetHostInfo

        End Sub

        Public Sub GetOptionKeyPath(ByRef pchKey As String, ByVal dw As Integer)
Implements IDocHostUIHandler.GetOptionKeyPath

        End Sub

        Public Sub HideUI() Implements IDocHostUIHandler.HideUI

        End Sub

        Public Sub OnDocWindowActivate(ByVal fActivate As Integer) Implements
IDocHostUIHandler.OnDocWindowActivate

        End Sub

        Public Sub OnFrameWindowActivate(ByVal fActivate As Integer) Implements
IDocHostUIHandler.OnFrameWindowActivate

        End Sub

        Public Sub ResizeBorder(ByRef prcBorder As mshtml.tagRECT, ByVal pUIWindow As
Integer, ByVal fFrameWindow As Integer) Implements IDocHostUIHandler.ResizeBorder

        End Sub

        Public Function ShowContextMenu(ByVal dwID As Integer, ByRef ppt As
mshtml.tagPOINT, ByVal pcmdtReserved As IOleCommandTarget, ByVal pdispReserved As Object)
As Integer Implements IDocHostUIHandler.ShowContextMenu

        End Function

        Public Sub ShowUI(ByVal dwID As Integer, ByRef pActiveObject As Object, ByRef
pCommandTarget As IOleCommandTarget, ByRef pFrame As Object, ByRef pDoc As Object)
Implements IDocHostUIHandler.ShowUI

        End Sub

        Public Function TranslateAccelerator(ByRef lpMsg As tagMSG, ByRef pguidCmdGroup As
System.Guid, ByVal nCmdID As Integer) As Integer Implements
IDocHostUIHandler.TranslateAccelerator
            Const WM_KEYDOWN As Integer = &H100
            Const S_FALSE As Integer = &H1
            Const S_OK As Integer = &H0
            If lpMsg.message = WM_KEYDOWN Then
                If (Control.ModifierKeys And Keys.Control) = Keys.Control Then
                    Dim keyCode As Byte = CByte(lpMsg.wParam And &HFF)
                    If keyCode = Keys.N Then
                        Debug.Print("Ctrl-Nが押された")
                        Return S_OK
                    End If
                End If
            End If
            Return S_FALSE
        End Function

        Public Function TranslateUrl(ByVal dwTranslate As Integer, ByVal pchURLIn As
Integer) As Integer Implements IDocHostUIHandler.TranslateUrl

        End Function

        Public Sub UpdateUI() Implements IDocHostUIHandler.UpdateUI

        End Sub

    End Class
End Class

<StructLayout(LayoutKind.Sequential)> _
Public Structure DOCHOSTUIINFO

    Public cbSize As Integer
    Public dwFlags As Integer
    Public dwDoubleClick As Integer
    <MarshalAs(UnmanagedType.BStr)> Public pchHostCss As String
    <MarshalAs(UnmanagedType.BStr)> Public pchHostNS As String

End Structure

<StructLayout(LayoutKind.Sequential, Pack:=4)> _
Public Structure tagMSG

    Public hwnd As IntPtr
    Public message As Integer
    Public wParam As Integer
    Public lParam As Integer
    Public time As Integer
    Public pt As tagPOINT

End Structure

<ComImport(), _
ComVisible(False), _
Guid("BD3F23C0-D43E-11CF-893B-00AA00BDCE1A"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IDocHostUIHandler

    <PreserveSig()> Function ShowContextMenu( _
        ByVal dwID As Integer, _
        ByRef ppt As tagPOINT, _
        ByVal pcmdtReserved As IOleCommandTarget, _
        <MarshalAs(UnmanagedType.IDispatch)> ByVal pdispReserved As Object _
    ) As Integer

    Sub GetHostInfo(ByRef theHostUIInfo As DOCHOSTUIINFO)

    Sub ShowUI(ByVal dwID As Integer, _
        ByRef pActiveObject As Object, _
        ByRef pCommandTarget As IOleCommandTarget, _
        ByRef pFrame As Object, _
        ByRef pDoc As Object)

    Sub HideUI()
    Sub UpdateUI()
    Sub EnableModeless(ByVal fEnable As Integer)
    Sub OnDocWindowActivate(ByVal fActivate As Integer)
    Sub OnFrameWindowActivate(ByVal fActivate As Integer)
    Sub ResizeBorder(ByRef prcBorder As tagRECT, ByVal pUIWindow As Integer, ByVal
fFrameWindow As Integer)

    <PreserveSig()> Function TranslateAccelerator( _
        ByRef lpMsg As tagMSG, _
        ByRef pguidCmdGroup As Guid, _
        ByVal nCmdID As Integer _
    ) As Integer

    Sub GetOptionKeyPath(<MarshalAs(UnmanagedType.BStr)> ByRef pchKey As String, ByVal dw
As Integer)

    Function GetDropTarget(ByVal pDropTarget As IDropTarget) As IDropTarget

    Function GetExternal() As <MarshalAs(UnmanagedType.IDispatch)> Object

    Function TranslateUrl(ByVal dwTranslate As Integer, ByVal pchURLIn As Integer) As
Integer

    Function FilterDataObject(ByVal pDO As IDataObject) As IDataObject

End Interface

<ComImport(), _
ComVisible(False), _
Guid("b722bccb-4e68-101b-a2bc-00aa00404770"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleCommandTarget

    <PreserveSig()> Function QueryStatus( _
        ByVal pguidCmdGroup As Guid, _
        ByVal cCmds As Integer, _
        <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)> ByRef prgCmds As OLECMD(), _
        ByRef CmdText As OLECMDTEXT _
    ) As Integer

    <PreserveSig()> Function Exec( _
        ByRef pguidCmdGroup As Guid, _
        ByVal nCmdId As Integer, _
        ByVal nCmdExecOpt As Integer, _
        ByRef pvaIn As Object, _
        ByRef pvaOut As Object _
    ) As Integer

End Interface

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
Public Structure OLECMDTEXT

    Public cmdtextf As Integer
    Public cwActual As Integer
    Public cwBuf As Integer
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=100)> Public rgwz As Char

End Structure

<StructLayout(LayoutKind.Sequential)> _
Public Structure OLECMD

    Public cmdID As Integer
    Public cmdf As Integer

End Structure  

[ツリー表示へ]
タイトルRe: WebBrowserコントロールのカスタマイズ
記事No3039
投稿日: 2006/02/03(Fri) 02:14
投稿者YAS
[OSのVer]:Windows    [VBのVer]:VB.NET  
自己レスです。
その後もいろいろ試しましたが,IDocHostUIHandlerインターフェイスからキーボードショートカットを
カスタマイズすることはできませんでした。
やり方を変え,WebBrowserコントロールを継承したクラスでProcessDialogKeyをオーバーライドするこ
とにしました。
Public Class ExWebBrowser
    Inherits WebBrowser

    Protected Overrides Function ProcessDialogKey( _
    ByVal keyData As System.Windows.Forms.Keys) As Boolean
        If keyData = (Keys.Control Or Keys.N) Then
            Debug.Print("Ctrl-N")
        End If
        Return True
    End Function

End Class

[ツリー表示へ]
タイトルRe^2: WebBrowserコントロールのカスタマイズ
記事No3040
投稿日: 2006/02/03(Fri) 07:36
投稿者YAS
[OSのVer]:Windows    [VBのVer]:VB.NET  
自己レス2です。
ProcessDialogKeyでうまくいったように思ったのですが,Ctrl-N以外のショートカットをカスタマイズ
できませんでした。
また,ProcessCmdKeyでもCtrl-PやCtrl-Aなどの処理をオーバーライドできませんでした。
ショートカットキーをすべて無効にするだけならWebBrowserShortcutsEnabled=Falseで可能ですが,で
きれば別の処理(例えばCtrl-Pで印刷プレビューなど)を割り当てたいのです。
引き続き何か情報がありましたらお願いいたします。

[ツリー表示へ]
タイトルRe: WebBrowserコントロールのカスタマイズ
記事No3115
投稿日: 2006/02/15(Wed) 00:14
投稿者YAS
どうしても自力解決できないので,@ITの掲示板で質問してみます。
申し訳ありません。

[ツリー表示へ]
タイトル一応解決しました
記事No3131
投稿日: 2006/02/16(Thu) 16:27
投稿者YAS
[OSのVer]:Windows XP    [VBのVer]:VB2005  
WebBrowserクラスを継承して,PreProcessMessageメソッドをオーバーライドすることで解決することが
出来ました。
WebBrowserBase.PreProcessMessageメソッドのヘルプに「独自に作成したコードから直接使用するため
のものではありません。」と書かれていたので使ってはいけないんだと思い,気づくのに時間がかかり
ました。
以下の様なコードでWebBrowserコントロールのCtrl-NやCtrl-Pを無効にすることができました。

全部自己レスで完結してしまいました。掲示板を汚して申し訳ありませんでした。

Public Class Form1

    WithEvents Browser As New ExWebBrowser

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles MyBase.Load
        Me.Browser.Dock = DockStyle.Fill
        Me.Controls.Add(Browser)
        Me.Browser.GoHome()
    End Sub

End Class

Class ExWebBrowser
    Inherits WebBrowser

    Public Overrides Function PreProcessMessage(ByRef msg As System.Windows.Forms.Message) _
    As Boolean
        Const WM_KEYDOWN As Integer = &H100
        If msg.Msg = WM_KEYDOWN Then
            Dim keyCode As Keys = CType(msg.WParam, Keys) And Keys.KeyCode
            If My.Computer.Keyboard.CtrlKeyDown Then
                Select Case keyCode
                    Case Keys.N
                        Debug.Print("Ctrl-Nが押された")
                        Return True
                    Case Keys.P
                        Debug.Print("Ctrl-Pが押された")
                        Return True
                End Select
            End If
        End If
        Return MyBase.PreProcessMessage(msg)
    End Function

End Class

[ツリー表示へ]