Possible Bug with WebGadget Scrolling

[akj]

Sometimes GetGadgetAttribute(#webGadget, #PB_Web_ScrollY) seems to report the vertical scroll Y position as zero when it is not and sometimes SetGadgetAttribute(#webGadget, #PB_Web_ScrollY, <posn>) fails to set the scroll position. These problems may also occur with horizontal scrolling but I have not tested to see.

If you run the program below and carefully watch the DEBUG window, you will see how the scroll Y position for some websites increases monotonically whilst for others it is always reported as zero. The website http://www.3dgw.com also seems to have problems with setting the scroll position in addition to retrieving it.

The situation is far worse if the #PB_Web_Mozilla flag is used with WebGadget() as scrolling does not then seem to work at all programatically.

Here is a demo that regularly changes the scroll position and then attempts to retrieve and display it:

Code: Select all

; Ensure the DEBUG window is visible.  It will display Y values
; Notice that for some websites the scroll Y position is wrongly reported

DataSection
  Data.s "www.purebasic.com" ; OK
  Data.s "uk.ask.com" ; Problem with get scroll Y posn
  Data.s "www.purebasic.com" ; OK
  Data.s "www.3dgw.com"  ; Problem with set/get scroll Y posn
  Data.s "www.purebasic.com" ; OK
  Data.s "www.five.tv"  ; Problem with get scroll Y posn
  Data.s "" ; End
EndDataSection

Enumeration
  #winMain
  #webGadget
EndEnumeration

Global url$, timer

Procedure Tick()
; Inovked each time the timer ticks
; Changes web gadget Y scroll position and then reports it
Static counter = 0
counter + 1
If counter%4 = 0
  Read.s url$: If url$="": End: EndIf
  SetGadgetText(#webGadget, url$)
EndIf
SetGadgetAttribute(#webGadget, #PB_Web_ScrollY, counter*20)
Debug GetGadgetAttribute(#webGadget, #PB_Web_ScrollY)
EndProcedure

; Main program
OpenWindow(#winMain, 0, 0, 600, 500, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Read.s url$
WebGadget(#webGadget, 10, 10, 580, 480, url$)
Delay(4000)
timer = SetTimer_(0, 0, 4000, @Tick()) ; Tick every 4 seconds
Repeat: Until WaitWindowEvent() = #PB_Event_CloseWindow
KillTimer_(0, timer)
End

[Fred]

This feature seems to be broken on new ActiveX, so I don't know if we can continue to support it.

[Korolev Michael]

Oh my god.

[IdeasVacuum]

... Strange. SetGadgetAttribute() works perfectly well to scroll Y, but GetGadgetAttribute() does not return the Y position, so you can't test to see if the scroll limit has been reached. That is a disaster

Work-around to get the web page size, originally coded by Kiffi (I only need the page height but Kiffi's code collects the width too)

Code: Select all

Enumeration
#Win
#Cont
#Web
#BtnScroll
#BtnLink
#StrLink
#Txt
EndEnumeration

Procedure.i GetPageHgt()
;#----------------------
Protected  WebBrowser.IWebBrowser2
Protected   pDocument.IHTMLDocument2
Protected  pDocument3.IHTMLDocument3
Protected    pElement.IHTMLElement
Protected   pElement2.IHTMLElement2
Protected   pDispatch.iDispatch
Protected pViewObject.IViewObject2

Protected iBodyH.i
Protected iBodyW.i
Protected iRootH.i
Protected iRootW.i
Protected iW.i
Protected iH.i = 0
Protected iRes.i

      WebBrowser = GetWindowLongPtr_(GadgetID(#Web), #GWL_USERDATA)

         iRes = WebBrowser\get_document(@pDispatch)
      If iRes = #S_OK

           If pDispatch

                   iRes = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument)
                If iRes = #S_OK

                     If pDocument

                             iRes = pDocument\get_body(@pElement)
                          If iRes = #S_OK

                               If pElement

                                       iRes = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                                    If iRes = #S_OK

                                         If pElement2

                                                 iRes = pElement2\get_scrollHeight(@iBodyH)
                                              If iRes = #S_OK

                                                      iRes = pElement2\get_scrollWidth(@iBodyW)
                                                   If iRes = #S_OK

                                                           iRes = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3)
                                                        If iRes = #S_OK

                                                             If pDocument3

                                                                      iRes = pDocument3\get_documentElement(@pElement)
                                                                   If iRes <> #S_OK : ProcedureReturn(0) : EndIf

                                                                      iRes = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
                                                                   If iRes <> #S_OK : ProcedureReturn(0) : EndIf

                                                                      iRes = pElement2\get_scrollHeight(@iRootH)
                                                                   If iRes <> #S_OK : ProcedureReturn(0) : EndIf


                                                                      iRes = pElement2\get_scrollWidth(@iRootW)
                                                                   If iRes <> #S_OK : ProcedureReturn(0) : EndIf

                                                                                        iW = iBodyW
                                                                   If iRootW > iBodyW : iW = iRootW : EndIf

                                                                                        iH = iBodyH
                                                                   If iRootH > iBodyH : iH = iRootH : EndIf
                                                             EndIf
                                                        EndIf
                                                   EndIf
                                              EndIf
                                         EndIf
                                    EndIf
                               EndIf
                          EndIf
                     EndIf
                EndIf
           EndIf

           ProcedureReturn(iH)
      EndIf

EndProcedure

Procedure ScrollWeb()
;#-------------------
Protected iScrollInc.i = 20, iCurrentY.i = 0, iPreviousY.i = 0
Protected    iScroll.i, iScrollEnd.i = #False
Protected   iPageHgt.i = GetPageHgt()

              If(iPageHgt > 0)

                     While iScrollEnd = #False

                                 iScroll = iScroll + iScrollInc

                                 SetGadgetAttribute(#Web, #PB_Web_ScrollY, iScroll)

                               ;iCurrentY = GetGadgetAttribute(#Web, #PB_Web_ScrollY)
                               ;Debug "iCurrentY -->" + Str(iCurrentY ) + "<--"
                               ;Debug "iPreviousY-->" + Str(iPreviousY) + "<--"

                            If Not (iScroll < iPageHgt)

                                    SetGadgetText(#Txt, "Scroll End")
                                    iScrollEnd = #True : Break
                            EndIf
                     Wend
              EndIf
EndProcedure

Procedure OpenWin()
;#-----------------
Protected Web.IWebBrowser2

              If OpenWindow(#Win, 0, 0, 900, 600, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)

                          ButtonGadget(#BtnScroll,  5,  5, 150, 20, "Start Scrolling")
                          ButtonGadget(#BtnLink,  155,  5, 100, 20, "Load Page")
                          StringGadget(#StrLink,  260,  5, 500, 20, "Enter URL here")
                            TextGadget(#Txt,      765,  8, 100, 16, "")
                       ContainerGadget(#Cont,       5, 30, 890, 540)
                             WebGadget(#Web,        5,  5, 880, 530, "")
                           Web = GetWindowLongPtr_(GadgetID(#Web), #GWL_USERDATA)
                           Web\put_Silent(#True) ; Suppress JavaScript error messages.
                       CloseGadgetList()
              EndIf
EndProcedure

Procedure WaitForUser()
;#---------------------
iExit = #False

     Repeat

                 Select WaitWindowEvent(1)

                             Case #PB_Event_Gadget

                                     Select EventGadget()

                                               Case #BtnScroll: ScrollWeb()
                                               Case   #BtnLink
                                                                SetGadgetText(#Web, GetGadgetText(#StrLink))
                                                                SetGadgetText(#Txt, "")
                                     EndSelect

                             Case #PB_Event_CloseWindow: iExit = #True
                 EndSelect

     Until iExit = #True

EndProcedure

    OpenWin()
WaitForUser()
End

DataSection     ;IID_IHTMLDocument2
  IID_IHTMLDocument2:
  ;332C4425-26CB-11D0-B483-00C04FD90119
  Data.i $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19

  IID_IHTMLDocument3:
  ;3050F485-98B5-11CF-BB82-00AA00BDCE0B
  Data.i $3050F485
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

  IID_IHTMLElement2:
  ;3050f434-98b5-11cf-bb82-00aa00bdce0b
  Data.i $3050F434
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

  IID_IViewObject2:
  ;00000127-0000-0000-c000-000000000046
  Data.i $00000127
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection

[/size]

Even the above code does not work with http://www.3dgw.com but it does work with all other sites I have tested, including https

Edit: Well, just tested another https site and the code fails to get the page size So, really need scrolling to work to capture web pages as an image.