https://keijiban.umayadia.com/ThreadDetail.aspx?ThreadId=10049#CommentId17154
投稿者 るきお  (社会人) 投稿日時 2011/2/19 13:44:34
>VB2008で、WebBrowserControlを自作する方法をあれば教えてください
「自作」の意味によって手法が異なりますが、できます。

既存のWebBrowserコントロールに機能を追加したり、一部変更したいならば、
WebBrowserコントロールを継承したコントロールを作成します。
この場合、ブラウザの機能を１から作る必要がないのでかなり楽ができますが、追加できる機能や変更できる機能には制限があります。

完全にゼロから自作のブラウザーを作成することもできます。
その場合機能に制限はなく、どのような機能でも追加することができますが、
ブラウザのすべての機能を自作する必要があるので現実的ではありません。
ただし、限定的な用途を考えているのであれば完全に自作のブラウザーもありです。

以下はブラウザーを完全に自作する例です。
遷移したURLのテキスト要素のみを表示し、画像やスクリプト、その他レイアウト関連のタグなどはすべて無視します。
また、スクロールが面倒だったのでスクロールは実装していません。
また、エンコードがutf-8でないサイトは正常に表示できません。
(必要であれば、このレベルの機能から自分で実装していくことになります。)

Imports System.Text.RegularExpressions



Public Class Form1



    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click



        '手順１．コメントの状態のままで一度実行させてすぐ終了してください。 

        '手順２．終了後ツールボックスにCutomeBrowserが表示されるのでフォームに配置してください。 

        '手順３．以下のコメントをはずして実行して下さい。 

        'CustomBrowser1.Navigate("http://homepage1.nifty.com/rucio/main/main.htm") 



    End Sub

End Class



Public Class CustomBrowser

    Inherits Panel



    Public Sub Navigate(ByVal urlString As String)



        Dim client As New Net.WebClient

        Dim html As String = client.DownloadString(urlString)



        Render(html)



    End Sub



    Protected textContent As String

    Protected mustRefresh As Boolean

    Public Sub Render(ByVal html As String)



        '<body>～</body>を抜き出す。(簡易版。対応できない場合あり。) 

        Dim regOption = RegexOptions.IgnoreCase Or RegexOptions.Singleline

        Dim bodyContent As String = Regex.Match(html, "<body.*?>(.*?)</body>", regOption).Groups(1).Value



        'スクリプトタグを除去。(簡易版。対応できない場合多々あり。) 

        Dim primitivContent As String = Regex.Replace(bodyContent, "<script.*?>.*?</script>", "(ここにスクリプトがありました。)", regOption)



        'すべてのタグを除去して本文のみにする。(簡易版。対応できない場合あり。) 

        textContent = Regex.Replace(primitivContent, "</{0,1}\w+?.*?>", vbNewLine)



        textContent = textContent.Replace(vbTab, "")



        '改行の整理 

        textContent = textContent.Replace(vbLf, vbCr)



        Do

            Dim beforeLength As Integer = Len(textContent)

            textContent = textContent.Replace(vbCr & vbCr, vbCr)

            Dim afterLength As Integer = Len(textContent)



            If beforeLength = afterLength Then

                Exit Do

            End If

        Loop



        textContent = textContent.Replace(vbCr, vbNewLine)



        mustRefresh = True

        Me.Invalidate()





    End Sub



    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)



        MyBase.OnPaint(e)



        Dim textRect As New Rectangle(0, 0, Me.Width, Me.Height * 3)



        e.Graphics.DrawString(textContent, Me.Font, Brushes.Black, textRect)



    End Sub



End Class
0