Prev: Hex to Dec and vice versa
Next: anyone use iGrid form 10tec
From: Eduardo on 21 Sep 2009 14:52
Eduardo escribi�:

> Look, the DownloadComplete event

DocumentComplete
From: Eduardo on 21 Sep 2009 14:53
Eduardo escribi�:

> I mean, if you check the bmp file saved before the third
> DownloadComplete event, you'll see an empty image.

DocumentComplete, DocumentComplete, DocumentComplete
From: Shotgun Thom on 22 Sep 2009 00:00

Hi Mike:

Truly great code! Thank you.

I noticed you arbitrarily set the width and height of the capture. You
set the height to twice that of the Screen Height.

This results in some images that are too long or too short. Is it
possible to read the URL's page height/width and set the webbrowswer
control based on those numbers?

> WebBrowser1.Width = Screen.Width
> WebBrowser1.Height = Screen.Height * 2

Thanks,

Tom
From: Mike Williams on 22 Sep 2009 02:47
"Eduardo" <mm(a)mm.com> wrote in message news:h98for$4t9$1(a)aioe.org...

> Hi, I have set the Picture as Visible = False and the command
> button also as Visible = False (or even removed it), so the only
> visible control left in the form was the Webbrowser, and the
> routine for saving still worked fine if I call it from the
> DocumentComplete . . .
> . . . but it does not work if I call it from the Form's Click...
> I don't understand what is going on with it.

As I mentioned in a recent post, when you are using this code to create a
bitmap of a currently displayed web page from code other than in the
WebBrowser DocumentComplete event then it fails to work if the WebBrowser
Control has the focus at the time you attempt to do so. If your code is in
the Form Click event (and if the WebBrowser has the focus at the time you
click the Form) then it will fail to work. The Form Click event fires okay,
and the code in it runs, but the Form Click itself does not steal the focus
(because Form clicks generally don't) and under such conditions the code in
it fails to work because the WebBrowser fails to respond to the WM_PAINT and
WM_PRINT messages. It will work okay from a Command Button Click event
though (as opposed to a Form Click event) because the Command Button takes
the focus as soon as you click it, allowing the "save as bitmap" code in it
to work properly because the WebBrowser no longer has the focus when the
code actually executes. I don't know why the WebBrowser fails to respond to
the messages when it has the focus under such conditions, it's just
something I noticed while testing the code.

The failure of the code in a Form Click event (when the WebBrowser has the
focus) isn't a major problem in itself because you would not normally run
such code from the Form's click event, but the main problem is that the code
would also fail to work if you ran it from a KeyDown event whilst the
WebBrowser has the focus (perhaps a Form keydown using KeyPreview, which is
common when coding things such as "Press F6 to save the web page as a
bitmap"). You can fix the problem though simply by adding an extra line near
the start of the "create bitmap of web page" code so that it checks whether
the WebBrowser currently has the focus and if so it sets the focus to some
other control, which might as well be the PictureBox you are using to hold
the bitmap (as long as it is not invisible and is just positioned off the
Form). Then at the end of the routine (although this is not necessary in
terms of making the code work) you can add a few lines to set the focus back
to the WebBrowser if the PictureBox currently has the focus, so that the
focus does not disappear from anything the user might have been doing in the
web page when he pressed your "save this page as a bitmap" hotkey or
whatever. Something like the following:

Mike

Private Sub SaveWebPageAsBitmap(BmpFile As String)
Dim myWindow As Long, childWindow As Long
Dim myClass As String, clsName As String * 256
Dim s1 As String, retVal As Long
If Me.ActiveControl.Name = "WebBrowser1" Then
Picture1.SetFocus
DoEvents ' just belt and braces ;-)
End If
myClass = "Shell Embedding"
childWindow = GetWindow(Me.hwnd, GW_CHILD)
Do
retVal = GetClassName(childWindow, clsName, 256)
If Left$(clsName, Len(myClass)) = myClass Then
myWindow = childWindow
Exit Do
End If
childWindow = GetWindow(childWindow, GW_HWNDNEXT)
Loop While childWindow <> 0
If myWindow <> 0 Then
SendMessage myWindow, WM_PAINT, Picture1.hDC, 0
SendMessage myWindow, WM_PRINT, Picture1.hDC, _
PRF_CHILDREN + PRF_CLIENT + PRF_OWNED
SavePicture Picture1.Image, BmpFile
End If
If Me.ActiveControl.Name = "Picture1" Then
WebBrowser1.SetFocus
End If
End Sub




From: Eduardo on 22 Sep 2009 05:06
I've been playing with the code...

> then it fails to work if the
> WebBrowser Control has the focus

It happens with some pages, so I had to leave the command button.

Here is my last code, that saves the page with its actual size:

(I've found that there is a limit for control sizes, the max height is
16383 pixels. The result is that too long pages are cut.)

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) _
As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CHILDREN = &H10&
Private Const PRF_CLIENT = &H4&
Private Const PRF_OWNED = &H20&
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const SM_CXVSCROLL = 2

Private Sub Form_Load()
Picture1.BorderStyle = vbBSNone
Picture1.AutoRedraw = True
Picture1.Visible = False
Me.ScaleMode = vbTwips
WebBrowser1.Navigate "http://www.yahoo.co.uk"
Caption = "Loading page . . ."
End Sub

Private Sub SaveWebBrowserPicture()
Dim myWindow As Long, childWindow As Long
Dim myClass As String, clsName As String * 256
Dim s1 As String
Dim iP As IPicture

Command1.SetFocus
myClass = "Shell Embedding"
childWindow = GetWindow(Me.hwnd, GW_CHILD)
Do
GetClassName childWindow, clsName, 256
If Left$(clsName, Len(myClass)) = myClass Then
myWindow = childWindow
Exit Do
End If
childWindow = GetWindow(childWindow, GW_HWNDNEXT)
Loop While childWindow <> 0
If myWindow <> 0 Then
SendMessage myWindow, WM_PAINT, Picture1.hDC, 0
SendMessage myWindow, WM_PRINT, Picture1.hDC, _
PRF_CHILDREN + PRF_CLIENT + PRF_OWNED

Set iP = Picture1.Image
Picture1.Cls
Picture1.Width = Picture1.Width - ScaleX(4, vbPixels, vbTwips)
Picture1.Height = Picture1.Height - ScaleY(4, vbPixels, vbTwips)
Picture1.PaintPicture iP, 0, 0, , , ScaleX(2, vbPixels, vbTwips), _
ScaleY(2, vbPixels, vbTwips)

Picture1.Picture = Picture1.Image
s1 = "d:\webpic1.bmp" ' or whatever is required
SavePicture Picture1.Picture, s1
Caption = "Web page saved as " & s1
End If
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As _
Object, URL As Variant)
Dim iWidth As Long
Dim iHeight As Long

If URL = WebBrowser1.LocationURL Then
iWidth = WebBrowser1.Document.Body.scrollWidth
If iWidth < 800 Then iWidth = 800
iWidth = iWidth + GetSystemMetrics(SM_CXVSCROLL) + 4
iHeight = WebBrowser1.Document.Body.scrollHeight
If iHeight < 600 Then iHeight = 600
iHeight = iHeight + 4

WebBrowser1.Move 0, 0, ScaleX(iWidth, vbPixels, _
vbTwips), ScaleY(iHeight, vbPixels, vbTwips)
Picture1.Move 0, 0, WebBrowser1.Width - _
ScaleX(GetSystemMetrics(SM_CXVSCROLL), _
vbPixels, vbTwips), WebBrowser1.Height

SaveWebBrowserPicture
End If
End Sub

First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4 5 6 7 8
Prev: Hex to Dec and vice versa
Next: anyone use iGrid form 10tec