WebBrowserでスクロールイベントを発生させるには？

解決

---

WindowsXpPro（SP2）VisualBasic．NET2003  Framework1.1
上記の環境なのですが、AxWebBrowserでＷＥＢページを表示した際に
ページの垂直スクロールバー動かした時にイベントを発生させたいのですが、
どのような方法でやればよいでしょうか？

インターネット上にリストボックスのスクロールバーを操作した時に
イベントが出るようにするソースコードがあったので、
それを下のように変更してみたのですが、２行と２３行にエラーの下線が
付いてしまいました。
ListBoxなどをWebBrowserなどに変更しただけなのですが、
この先が分からないため、良い方法がありましたらご教示いただきたいです。
よろしくお願い致します。

01 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
02 MyWebBrowser1.Name = "MyWebBrowser1"
03 MyWebBrowser1.Size = New Size(500, 500)
04 MyWebBrowser1.Location = New Point(0, 0)
05 Me.Controls.Add(MyWebBrowser1)
06 End Sub

07 Private WithEvents MyWebBrowser1 As AxSHDocVw.AxWebBrowser

08 Private Class MyWebBrowser
09 Inherits AxSHDocVw.AxWebBrowser

10 Public Event Scroll()
11 Protected Overrides Sub WndProc(ByRef m As Message)
12 Const WM_VSCROLL As Integer = &H115I
13 If m.Msg = WM_VSCROLL Then
14 RaiseEvent Scroll()
15 End If
16 MyBase.WndProc(m)
17 End Sub

18 Protected Overrides Sub OnMouseWheel(ByVal e As MouseEventArgs)
19 If e.Delta <> 0 Then
20 RaiseEvent Scroll()
21 End If
22 End Sub

23 Protected Overrides Sub OnSelectedIndexChanged(ByVal e As EventArgs)
24 RaiseEvent Scroll()
25 End Sub

26 End Class

編集 削除

---

上記で記述ミスや訂正がございます。

23行〜25行はリストボックスの時の残りで今回は関係ないようです。

07行は
Private WithEvents MyWebBrowser1 As New MyWebBrowser
このように訂正しました。

02行を削除しました。

下記のイベントプロシージャを追加しました。

26 Private Sub MyWebBrowser1_Scroll() Handles MyWebBrowser1.Scroll
27 Stop
28 End Sub


このように変更た上で、どこかのページを表示して動作確認をしたら、
垂直スクロールイベントの発生について下記のような動作をすることがわかりました。

・マウスボタンでスライドさせても発生しない。
・キーボードの↑↓、PageUp、PageDownキーでは発生しない。
・マウスのスクロールホイールでは、上限、下限になった時に発生する。
・マウスのスクロールホイールでページの上限、下限に達しない位置での
  スクロールでは発生しない。
・スクロールホイールで上限、下限に触れた時に発生した状態で、
  スクロールホイールを上下に動かすと発生するが、キーボードで動かしても発生しない。

なんだかよく分からない動作なのですが、とにかくスライドさせた時に
補足したいのですが、良い方法がありましたら教えて頂きたいです。

編集 削除

---

こんな感じでどうでしょうか。手抜きコードですけれども。

'-----
Imports System.Runtime.InteropServices
Imports System.ComponentModel

Public Class Form1
    Inherits System.Windows.Forms.Form

'** Windows フォーム デザイナで生成されたコード **

    Private WithEvents _onscroll As EventClass
    Private WithEvents _onmousewheel As EventClass
    Private document As Object = Nothing

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        AxWebBrowser1.Navigate2("http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi?print+200805/08050024.txt")
    End Sub

    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        ReleaseDocument()
    End Sub

    Private Sub ReleaseDocument()
        If Not document Is Nothing AndAlso Marshal.IsComObject(document) Then
            Marshal.ReleaseComObject(document)
        End If
    End Sub

    Private Sub AxWebBrowser1_DocumentComplete(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_DocumentCompleteEvent) Handles AxWebBrowser1.DocumentComplete
        _onscroll = New EventClass
        _onmousewheel = New EventClass
        ReleaseDocument()
        document = AxWebBrowser1.Document
        With document.body
            .onscroll = _onscroll
            .onmousewheel = _onmousewheel
        End With
    End Sub

    Private Sub _onscroll_OnEvent() Handles _onscroll.OnEvent
        ListBox1.Items.Insert(0, "onscroll : " & Now.ToString("yyyy-MM-dd hh:mm:ss.ffff"))
    End Sub

    Private Sub _onmousewheel_OnEvent() Handles _onmousewheel.OnEvent
        Dim win As Object = document.parentWindow
        Dim eventObj As Object = win.event
        ListBox1.Items.Insert(0, "onmousewheel : " & CStr(eventObj.wheelDelta))
        If Not eventObj Is Nothing AndAlso Marshal.IsComObject(eventObj) Then
            Marshal.ReleaseComObject(eventObj)
        End If
        If Not win Is Nothing AndAlso Marshal.IsComObject(win) Then
            Marshal.ReleaseComObject(win)
        End If
    End Sub
End Class

Public Class EventClass
    Public Event OnEvent()

    <DispId(0), Obsolete("", True), Browsable(False), EditorBrowsable(EditorBrowsableState.Never)> _
    Public Sub CallbackMethod()
        RaiseEvent OnEvent()
    End Sub
End Class

編集 削除

---

魔界の仮面弁士様ありがとうございます！
すごいです。完璧に希望通りの動作で
それ以上に細かな判断が出来るような感じですね。
早速どうなってるのか勉強しながら使わせて頂きたいと思います。
ずっと不便だった部分がこれで解決できます。
本当にありがとうございました。

編集 削除

---

しまった。DocumentComplete イベントの処理で、
body オブジェクトの解放処理を書くのを忘れていた…。

一応修正。

==================================================
Sub Sub AxWebBrowser1_DocumentComplete の修正。
--------------------------------------------------
《修正前》
> With document.body
>    .onscroll = _onscroll
>    .onmousewheel = _onmousewheel
> End With
--------------------------------------------------
《修正後》
Dim body As Object = Nothing
Try
  body = document.body
  body.onscroll = _onscroll
  body.onmousewheel = _onmousewheel
Finally
  If Not body Is Nothing Then
    If Marshal.IsComObject(body) Then
      Marshal.ReleaseComObject(body)
    End If
    body = Nothing
  End If
End Try


==================================================
EventClass クラスの修正。
--------------------------------------------------
《修正前》
> Public Class EventClass
--------------------------------------------------
《修正後》
<ComVisible(True)> Public Class EventClass


==================================================
Sub ReleaseDocument の修正。
--------------------------------------------------
《修正前》
> If Not document Is Nothing AndAlso Marshal.IsComObject(document) Then
>     Marshal.ReleaseComObject(document)
> End If
--------------------------------------------------
《修正後》
If Not document Is Nothing Then
  If Marshal.IsComObject(document) Then
    Marshal.ReleaseComObject(document)
  End If
  document = Nothing
End If


==================================================
Sub _onmousewheel_OnEvent の修正。
--------------------------------------------------
《修正前》
> If Not eventObj Is Nothing AndAlso Marshal.IsComObject(eventObj) Then
>     Marshal.ReleaseComObject(eventObj)
> End If
> If Not win Is Nothing AndAlso Marshal.IsComObject(win) Then
>     Marshal.ReleaseComObject(win)
> End If
--------------------------------------------------
《修正後》
If Not eventObj Is Nothing Then
  If Marshal.IsComObject(eventObj) Then
    Marshal.ReleaseComObject(eventObj)
  End If
  eventObj = Nothing
End If
If Not win Is Nothing Then
  If Marshal.IsComObject(win) Then
    Marshal.ReleaseComObject(win)
  End If
  win = Nothing
End If

編集 削除

---

魔界の仮面弁士様、修正の部分まで載せて頂いてありがとうございます。
<ComVisible(True)>このような部分とかMarshalとか
あまり見たことがないような部分が多くてすごく高度な感じがしますが
自分でも使いこなせれるようになりたいと思います。
早速昨日のものに修正箇所を入れ替えてみたいとおもいます。
詳しくご教示下さいまして本当にありがとうございますした。

編集 削除

---

お世話になっております。
たびたび申し訳ございません。

魔界の仮面弁士様に教えて頂いたコードを組み込んで使用させて頂いているのですが、
一部のページでスクロールのイベントが発生しない場合があることが分かりまして、
教えて頂いたコードを見たり、色々別のページを表示してみたりしているのですが、
発生しない原因を自分では見つけ出すことができませんでした。

イベントが発生しないことが分かったページは下の２つで、
http://jp.youtube.com/
http://www.nicovideo.jp/
この他はヤフーで適当な言葉で検索をして、手当たり次第にページを
表示して確認したのですが、イベントが発生しないページは見つからなかったのですが、
イベントが発生しない原因について教えてきたいです。

WEBページの構造の違いとかかとも思うのですが、上記２サイトのトップページが
それほど特殊のような感じもしないのですが、ヒントのようなものでも良いですので、
何か教えて頂けたら幸いです。
よろしくお願い致します。

編集 削除

---

> 発生しない原因を自分では見つけ出すことができませんでした。

IE の 後方互換モードとの差異ですね。
これでどうかな。IE6 で動作確認。IE7 や IE8beta では未検証。


Private Sub AxWebBrowser1_DocumentComplete(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_DocumentCompleteEvent) Handles AxWebBrowser1.DocumentComplete
    _onscroll = New EventClass
    _onmousewheel = New EventClass
    ReleaseDocument()
    document = AxWebBrowser1.Document
    Dim element As Object = Nothing
    Try
      If document.compatMode = "BackCompat" Then
        element = document.body
      Else
        element = document.documentElement
      End If
      element.onscroll = _onscroll
      element.onmousewheel = _onmousewheel
    Finally
      If Not element Is Nothing Then
        If Marshal.IsComObject(element) Then
          Marshal.ReleaseComObject(element)
        End If
        element = Nothing
      End If
    End Try
End Sub

編集 削除

---

魔界の仮面弁士様
再びのご回答ありがとうございます。
教えて頂いたコードをそのままで両サイトとも完璧にイベントが
発生するようになりました！

原因がIEの関係だったとは当方には全く見当も付かず
後方互換モードという言葉も初耳でした。

魔界の仮面弁士様のおかげでどうしても実現できなかった動作を
追加することができました。
とても便利になります。
本当にありがとうございました。

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する