Prev: Hex to Dec and vice versa
Next: anyone use iGrid form 10tec
From: Mike Williams on 23 Sep 2009 06:22
"Eduardo" <mm(a)mm.com> wrote in message news:h9btj9$stb$1(a)aioe.org...

> It was hard to find a solution. Seemingly there is a bug with
> the Body.ScrollTop property. It works fine with some pages
> and it doesn't work with other pages. I found the Body.setExpression
> method that is for scripting, and the ScrollTo method not exposed in the
> COM interface. So,
> Body.ScrollTop = Value
> become
> iBody.setExpression "ScrollTo", "ScrollTo _
> (0, " & Value & ")" , "vbScript"
> Here is the full code again: ,snip>

That's looking good now, Eduardo. Very nice code (although personally I'd
change the TextBox validation stuff and get rid of the various +4 magic
numbers). Very nice code though, and those are just little "code in work"
things.

There is one thing that does need attention though and that's the incorrect
size of the returned bitmap. On my system when I set the max bitmap size to
15000 and load a web page that I know is not much more than 12000 pixels in
height I get a returned bitmap that is 16379 pixels high (4 pixels less than
the maximum permitted height of a VB Control) with the bottom 4000 or so
pixels being just blank background. That's because the WebBrowser Control is
of a undetermined width at the time the code reads the iBody.ScrollHeight,
resulting in a returned height value of about 31000 pixels in my own test
case (because the WebBrowser Control on my Form is not initially very wide
and it is therefore returning the height required by the web page at the
WebBrowser's initial starting width).

Moving the setting of the WebBrowser.Width to above the line that checks the
value of iBody.ScrollHeight (instead of where it currently is below it)
fixes that problem though, and the code then correctly returns a bitmap of
the correct height. You might like to make that alteration and then check it
out to ensure that it works okay at your end. Anyway, as you've said in your
other post, this is obviously already more than sufficient for the OP so any
more work on it is not really important at the moment and can go on the back
burner for a while ;-)

Mike



From: Eduardo on 23 Sep 2009 13:20
Mike Williams escribi�:

> (although personally
> I'd change the TextBox validation stuff

It was not a validation intended for the real world, but just a quick
validation for this test program.

> and get rid of the various +4
> magic numbers).

OK. I'll replace them with GetSystemMetrics(SM_CXEDGE) and
GetSystemMetrics(SM_CYEDGE).

> There is one thing that does need attention though and that's the
> incorrect size of the returned bitmap. On my system when I set the max
> bitmap size to 15000 and load a web page that I know is not much more
> than 12000 pixels in height I get a returned bitmap that is 16379 pixels
> high (4 pixels less than the maximum permitted height of a VB Control)
> with the bottom 4000 or so pixels being just blank background. That's
> because the WebBrowser Control is of a undetermined width at the time
> the code reads the iBody.ScrollHeight, resulting in a returned height
> value of about 31000 pixels in my own test case (because the WebBrowser
> Control on my Form is not initially very wide and it is therefore
> returning the height required by the web page at the WebBrowser's
> initial starting width).
>
> Moving the setting of the WebBrowser.Width to above the line that checks
> the value of iBody.ScrollHeight (instead of where it currently is below
> it) fixes that problem though, and the code then correctly returns a
> bitmap of the correct height. You might like to make that alteration and
> then check it out to ensure that it works okay at your end. Anyway, as
> you've said in your other post, this is obviously already more than
> sufficient for the OP so any more work on it is not really important at
> the moment and can go on the back burner for a while ;-)

Ok, changed, thanks.

Full code again (without textbox validation)
Note: added the line 'WebBrowser1.Silent = True', so the WebBrowser
doesn't show error messages to the end user because of errors in the pages.

' *********************
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 Const SM_CXEDGE = 45
Private Const SM_CYEDGE = 46

Private mMaxImageHeight As Long
Private mEdgeHeight As Long
Private mEdgeWidth As Long

Private Sub Command1_Click()
WebBrowser1.Navigate "http://www.slashdot.org"
'WebBrowser1.Navigate "http://www.freevbcode.com/ShowCode.Asp?ID=1287"
'WebBrowser1.Navigate "http://www.google.com"
'WebBrowser1.Navigate "http://www.yahoo.co.uk"
Caption = "Loading page . . ."
End Sub

Private Sub Form_Load()
mEdgeHeight = GetSystemMetrics(SM_CYEDGE)
mEdgeWidth = GetSystemMetrics(SM_CXEDGE)
Picture1.BorderStyle = vbBSNone
Picture1.AutoRedraw = True
Picture1.Visible = False
Me.ScaleMode = vbTwips
Caption = "Enter desired image height and " & _
"click the button to load the page . . ."
Text1.Text = "5000"
WebBrowser1.Silent = True
End Sub

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

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(mEdgeWidth * 2, _
vbPixels, vbTwips)
Picture1.Height = Picture1.Height - ScaleY(mEdgeHeight * 2, _
vbPixels, vbTwips)
Picture1.PaintPicture iP, 0, 0, , , ScaleX(mEdgeWidth, _
vbPixels, vbTwips), ScaleY(mEdgeHeight, vbPixels, _
vbTwips), Picture1.Width, Picture1.Height

Picture1.Picture = Picture1.Image
s1 = "d:\" & nFile & ".bmp" ' or whatever is required
Caption = "Saving image file " & s1
SavePicture Picture1.Picture, s1
Set Picture1.Picture = Nothing
Picture1.Cls
Picture1.Width = Picture1.Width + ScaleX(mEdgeWidth * 2, _
vbPixels, vbTwips)
Picture1.Height = Picture1.Height + ScaleY(mEdgeHeight * 2, _
vbPixels, vbTwips)
End If
End Sub

Private Sub Text1_Change()
mMaxImageHeight = Val(Text1.Text)
If mMaxImageHeight > 16383 - (mEdgeHeight * 2) Then _
mMaxImageHeight = 16383 - (mEdgeHeight * 2)
' Min image Height allowed: 100 pixels, this is
' arbitrary and can be changed to other value
If mMaxImageHeight < 100 Then mMaxImageHeight = 100
End Sub

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

If URL = WebBrowser1.LocationURL And Len(URL) > 8 Then
Set iBody = WebBrowser1.Document.body
iScrollBarWidth = GetSystemMetrics(SM_CXVSCROLL)

iWidth = iBody.ScrollWidth
If iWidth < 800 Then iWidth = 800
' Max image width allowed: 3 screen width, this is
' arbitrary and can be changed to other value
If iWidth > Screen.Width / Screen.TwipsPerPixelX _
* 3 Then iWidth = Screen.Width / _
Screen.TwipsPerPixelX * 3
iWidth = iWidth + iScrollBarWidth + mEdgeWidth * 2

WebBrowser1.Width = ScaleX(iWidth, vbPixels, vbTwips)
Picture1.Width = WebBrowser1.Width - _
ScaleX(iScrollBarWidth, vbPixels, vbTwips)

iHeight = iBody.ScrollHeight
If iHeight < 600 Then iHeight = 600

Do Until mMaxImageHeight * iImageNumber >= iBody.ScrollHeight
If iBody.ScrollHeight > mMaxImageHeight Then
If mMaxImageHeight * (iImageNumber + 1) > _
iBody.ScrollHeight Then
WebBrowser1.Height = ScaleY(iBody.ScrollHeight - _
mMaxImageHeight * iImageNumber + mEdgeHeight _
* 2, vbPixels, vbTwips)
iBody.setExpression "ScrollTo", "ScrollTo (0, " _
& mMaxImageHeight * iImageNumber & ")", _
"vbScript"
Else
iBody.setExpression "ScrollTo", "ScrollTo (0, " _
& mMaxImageHeight * iImageNumber & ")", _
"vbScript"
WebBrowser1.Height = ScaleY(mMaxImageHeight + _
mEdgeHeight * 2, vbPixels, vbTwips)
End If
Else
WebBrowser1.Height = ScaleY(iHeight + mEdgeHeight * _
2, vbPixels, vbTwips)
End If
Picture1.Height = WebBrowser1.Height
iImageNumber = iImageNumber + 1
SaveWebBrowserPicture "webpic" & iImageNumber
Loop
Caption = "Done"
End If
End Sub
From: Eduardo on 23 Sep 2009 13:49
> Seemingly there is a bug with the Body.ScrollTop property. It works fine
> with some pages and it doesn't work with other pages.
>
> I found the Body.setExpression method that is for scripting, and the
> ScrollTo method not exposed in the COM interface.
>
> So,
>
> Body.ScrollTop = Value
>
> become
>
> iBody.setExpression "ScrollTo", "ScrollTo (0, " & Value & ")" _
> , "vbScript"

It seems that there is a full group of properties and methods not
available for the COM interface.
One of them is this ScrollTo method:
http://msdn.microsoft.com/en-us/library/ms536731%28VS.85%29.aspx

I tried to find information about when they were added, but I couldn't.

So, I don't know if this code will work on older machines, because I
don't know in what IE version they were added.
May be it requires IE 5, or IE 6...

On this machine I have installed IE 8.
From: Mike Williams on 23 Sep 2009 16:22
"Eduardo" <mm(a)mm.com> wrote in message news:h9dn39$10k$1(a)aioe.org...
>> So,
>> Body.ScrollTop = Value
>> become
>> iBody.setExpression "ScrollTo", "ScrollTo (0, " & Value & ")" _
>> , "vbScript"
> It seems that there is a full group of properties and methods not
> available for the COM interface.
> One of them is this ScrollTo method:
> http://msdn.microsoft.com/en-us/library/ms536731%28VS.85%29.aspx
> So, I don't know if this code will work on older machines, because I don't
> know in what IE version they were added.
> May be it requires IE 5, or IE 6...
> On this machine I have installed IE 8.

Are you sure that Body.ScrollTop = Value doesn't work? I know that you said
it didn't the other day, but there have been a number of changes to the code
since you removed it, and it might have been something else that was causing
the problem you were having with it? I've just tried your latest code,
changing the existing lines so that they use iBody.ScrollTop = Value, and it
seems to work fine on the various web pages I've just tried it with, using
various image heights, although I haven't spent a great deal of time testing
it yet. Does it still not work at your end on some web pages?

Mike


From: Eduardo on 23 Sep 2009 18:35
>>> Body.ScrollTop = Value
>>> become
>>> iBody.setExpression "ScrollTo", "ScrollTo (0, " & Value & ")" _
>>> , "vbScript"
>> It seems that there is a full group of properties and methods not
>> available for the COM interface.
>> One of them is this ScrollTo method:
>> http://msdn.microsoft.com/en-us/library/ms536731%28VS.85%29.aspx
>> So, I don't know if this code will work on older machines, because I
>> don't know in what IE version they were added.
>> May be it requires IE 5, or IE 6...
>> On this machine I have installed IE 8.
>
> Are you sure that Body.ScrollTop = Value doesn't work?

Very sure.

And Value = Body.ScrollTop either (it always return 0 in those pages,
even if I manually scroll the page).

For some pages it works, for other ones, it doesn't.

> I know that you
> said it didn't the other day, but there have been a number of changes to
> the code since you removed it,

The only changes were what I did today, that was to replace +/- 4 (or 2)
with the size in pixels of a 3D control edge.
WW.Silent = True, and the order of a line as you told me.

You can try Body.ScrollTop = 100 and Body.ScrollTop = 20000 or whatever,
it does not work. For example for www.slashdot.org. But for
www.freevbcode.com/ShowCode.Asp?ID=1287 it works.

If you search about this issue on Internet, you'll see that there are
several posts in different forums with people asking about this problem.

> and it might have been something else
> that was causing the problem you were having with it? I've just tried
> your latest code, changing the existing lines so that they use
> iBody.ScrollTop = Value, and it seems to work fine on the various web
> pages I've just tried it with, using various image heights, although I
> haven't spent a great deal of time testing it yet. Does it still not
> work at your end on some web pages?

Just pasting the do/loop:

' ************

Do Until mMaxImageHeight * iImageNumber >= iBody.ScrollHeight
If iBody.ScrollHeight > mMaxImageHeight Then
If mMaxImageHeight * (iImageNumber + 1) > _
iBody.ScrollHeight Then
WebBrowser1.Height = ScaleY(iBody.ScrollHeight - _
mMaxImageHeight * iImageNumber + mEdgeHeight _
* 2, vbPixels, vbTwips)
' iBody.setExpression "ScrollTo", "ScrollTo (0, " _
& mMaxImageHeight * iImageNumber & ")", _
"vbScript"
iBody.ScrollTop = mMaxImageHeight * iImageNumber
Else
' iBody.setExpression "ScrollTo", "ScrollTo (0, " _
& mMaxImageHeight * iImageNumber & ")", _
"vbScript"
iBody.ScrollTop = mMaxImageHeight * iImageNumber
WebBrowser1.Height = ScaleY(mMaxImageHeight + _
mEdgeHeight * 2, vbPixels, vbTwips)
End If
Else
WebBrowser1.Height = ScaleY(iHeight + mEdgeHeight * _
2, vbPixels, vbTwips)
End If
Picture1.Height = WebBrowser1.Height
iImageNumber = iImageNumber + 1
SaveWebBrowserPicture "webpic" & iImageNumber
Loop

' ************

It doesn't work with "http://www.slashdot.org"
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