WebBrowser1の画像をPicture1に取り込む方法

解決

ペン太 2008-09-17 23:18:53 No: 140433

VB6でWebBrowser１に目的のサイトを表示できるものを作りました。出てきたものをPicture1に写し取りビットマップで加工、保存できるようにしたいと思いますがこれは可能でしょうか。

熊谷隆史 2008-09-18 20:39:13 No: 140434

> ビットマップで加工、保存できるようにしたい

可能ですが、簡単に出来ると思われてる様な節があります。
他サイト(http://moug.net/faq/viewforum.php?f=2)
で詳細に教わったのですが、
かなり前のことなので当方は、すっかり忘れております。

WebBrowser1.DocumentからIUnknown_GetWindowで
ウィンドウハンドルを取り出して、
GetDC(GetWindowDCかも)でデバイスコンテキストハンドルを得て、

後は、「画面キャプチャ GetDC」とか「ウィンドウキャプチャ GetDC」で
Google検索すれば分かるのではと。

CreateCompatibleDC
BitBlt
CreateCompatibleBitmap
DeleteObject
ReleaseDC
DeleteDC
OleCreatePictureIndirect
SavePicture関数(APIではないです)

# スクロールさせながら、全体を取り込むことも可能です(大変ですが)。
コードを書くだけの知識は、今となっては無いのであしからず。

ペン太 2008-09-19 02:47:26 No: 140435

熊谷様、ご丁寧なお返事をありがとうございます。

>可能ですが、簡単に出来ると思われてる様な節があります。
お恥ずかしいことながらPicture1.image = WebBrowser1.Imageみたいに出来たるかもしれないと思い投稿しました。

ご教示の内容はほとんど初めて見るもので最初は絶望的に思えましたがご紹介のキーワードで探していきましたらDelphiやVBで何とかなりそうな感じのものがありいけそうな感じがしてきました。下記の「画面キャプチャソフ（トがない？）を作る」が簡単そうで参考になりました。
http://www5b.biglobe.ne.jp/~kouta_y/news/newsvb/vb12.html

画面の位置を確定すれば今回の目的で使用できそうに思えます。ここではとりあえず解決にチェックをいれさせていただきましたが分からなくなったらまた質問させていただきます。ありがとうございました。

魔界の仮面弁士 2008-09-19 04:20:58 No: 140436

OleDraw API でどうでしょう。

'--------------------
Option Explicit

Private Enum DVASPECT
   DVASPECT_CONTENT = 1
   DVASPECT_THUMBNAIL = 2
   DVASPECT_ICON = 4
   DVASPECT_DOCPRINT = 8
End Enum

Private Declare Function OleDraw Lib "ole32" ( _
    ByVal pUnk As Object, _
    ByVal dwAspect As DVASPECT, _
    ByVal hdcDraw As OLE_HANDLE, _
    ByRef lprcBounds As Long) As Long

Private Sub Command1_Click()
WebBrowser1.Navigate "http://www.yahoo.co.jp/"
End Sub

Private Sub Command2_Click()
Capture WebBrowser1, Picture1
End Sub

Private Sub Form_Load()
    ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0
    Picture1.BackColor = vbBlack
End Sub

Private Sub Capture(ByVal wb As WebBrowser, ByVal pb As PictureBox)
    Set pb.Picture = LoadPicture()
    pb.Cls

    Dim body As Object
    Set body = wb.Document.body
    body.runtimeStyle.overflowX = "hidden"
    body.runtimeStyle.overflowY = "hidden"

    Dim wTop!, wLeft!, wWidth!, wHeight As Single
    wTop = wb.Top
    wLeft = wb.Left
    wWidth = wb.Width
    wHeight = wb.Height
    wb.Move 0, 0, body.scrollWidth, body.scrollHeight

    Dim pWidth!, pHeight As Single
    pWidth = pb.Width
    pHeight = pb.Height
    pb.Move pb.Left, pb.Top, body.scrollWidth, body.scrollHeight

    Dim rect(3) As Long
    rect(2) = body.scrollWidth
    rect(3) = body.scrollHeight

    OleDraw wb.object, DVASPECT_CONTENT, pb.hDC, rect(0)
    Set Picture1.Picture = Picture1.Image

    wb.Move wLeft, wTop, wWidth, wHeight
End Sub

魔界の仮面弁士 2008-09-19 05:30:32 No: 140437

少し手を加えてみました。

「描画先の PictureBox 自体のサイズを変える」か、それとも
「描画先の PictureBox のサイズを変化させずに描画する」かを
指定できるようにしています。
（<frameset> なサイトだと、サイズを判定できませんけれども）

Option Explicit

Private Enum DVASPECT
   DVASPECT_CONTENT = 1
   DVASPECT_THUMBNAIL = 2
   DVASPECT_ICON = 4
   DVASPECT_DOCPRINT = 8
End Enum

Private Declare Function OleDraw Lib "ole32" ( _
    ByVal pUnk As Object, _
    ByVal dwAspect As DVASPECT, _
    ByVal hdcDraw As OLE_HANDLE, _
    ByRef lprcBounds As Long) As Long

Private Sub Command1_Click()
WebBrowser1.Navigate "http://www.yahoo.co.jp/"
End Sub

Private Sub Command2_Click()
Capture WebBrowser1, Picture1, True
End Sub

Private Sub Form_Load()
    ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0
    Picture1.BackColor = vbBlack
End Sub

Private Sub Capture(ByVal wb As WebBrowser, ByVal pb As PictureBox, Optional resizePictureBox As Boolean = False)
Try:
On Error GoTo Catch

Screen.MousePointer = vbHourglass
pb.Cls

    Dim document As Object
    Set document = wb.document
    Dim element As Object, style As Object
    If document.compatMode = "BackCompat" Then
        Set element = document.body
    ElseIf document.compatMode = "CSS1Compat" Then
        Set element = document.documentElement
    End If
    Set style = element.runtimeStyle
    style.BorderStyle = "none"
    style.overflowX = "hidden"
    style.overflowY = "hidden"

    Dim eWidth!, eHeight As Single
    eWidth = element.scrollWidth
    eHeight = element.scrollHeight

    Dim wTop!, wLeft!, wWidth!, wHeight As Single
    wTop = wb.Top
    wLeft = wb.Left
    wWidth = wb.Width
    wHeight = wb.Height
    wb.Move -10000, -10000, eWidth, eHeight
    wb.Visible = True
    If resizePictureBox Then
        pb.Move pb.Left, pb.Top, eWidth, eHeight
    Else
        eWidth = pb.Width
        eHeight = pb.Height
    End If

    Dim rect(3) As Long
    rect(2) = eWidth
    rect(3) = eHeight

    pb.Visible = True
    OleDraw wb.object, DVASPECT_CONTENT, pb.hDC, rect(0)
    pb.Refresh

    style.BorderStyle = ""
    style.overflowX = ""
    style.overflowY = ""

    wb.Move wLeft, wTop, wWidth, wHeight
Catch:
    If Err.Number <> 0 Then
        MsgBox "キャプチャ失敗 (エラー:" & CStr(Err.Number) & ")" & vbCrLf & Err.Description, vbExclamation
    End If
    On Error GoTo 0
Finally:
    Screen.MousePointer = vbDefault
End Sub

熊谷隆史 2008-09-23 20:13:43 No: 140438

http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi?print+200809/08090032.txt
と同じ方なら、こちらに魔界の仮面弁士さんの回答が付いてたのは
気付かれたと思うのですが。

> 画面の位置を確定すれば今回の目的で使用できそうに思えます。ここではとりあえず解決にチェックをいれさせていただきましたが分からなくなったらまた質問させていただきます。ありがとうございました。
リンク先ではGetDCやCreateCompatibleDCの引数に
0を渡してますが、
(IUnknown_GetWindowは、Dependency Walkerで序数値を調べなくはいけないのでパス)

Private Declare Function WindowFromAccessibleObject Lib "oleacc" ( _
ByVal pacc As Object , phwnd As Long) As Long

Dim h As Long
WindowFromAccessibleObject WebBrowser1.Document, h

でウィンドウハンドルは得られるので、代わりにこれを指定してください。
CreateCompatibleBitmapには、GetClientRectで。
正直、どのプロパティを、指定されてたか思い出せないので。
http://d.hatena.ne.jp/onozaty/20060803/p1

# ただ、見えてる部分しか取れませんが。