PureBasic Forums - English

Code: Select all

prevPos.l = -1
If OpenWindow(0, 0, 0, 400, 400, "Auto Scrolling Web Page",  #PB_Window_SystemMenu )
 
  If CreateGadgetList(WindowID(0))
    WebGadget(0, 0, 20, WindowWidth(0), WindowHeight(0), "www.purebasic.com")
    ButtonGadget(1,0,0,170,20,"document loading...please wait")
    WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
   EndIf
 
EndIf

Repeat
  Event = WaitWindowEvent()
 
  WebObject\get_Busy(@IsBusy.l)
 
  If IsBusy
    SetGadgetText(1, "document loading")
    DisableGadget(1, 1)
  Else
    SetGadgetText(1, "scroll document")
    DisableGadget(1, 0)
  EndIf
 
  If Event = #PB_Event_Gadget And EventGadget() = 1
   
    If WebObject\get_document(@DocDispatch.IDispatch) = #S_OK
     
      If DocDispatch\QueryInterface(?IID_IHTMLDocument2, @HTMLDoc2.IHTMLDocument2) = #S_OK
        HTMLDoc2\get_body(@HTMLElement.IHTMLElement)
      Else
        MessageRequester("Error", "Error loading web object", #MB_ICONERROR)
      EndIf
     
      If HTMLElement\QueryInterface(?IID_IHTMLElement2, @myBrowser.IHTMLElement2) = #S_OK
        myBrowser\get_scrollHeight(@scrollH.l)
        myBrowser\get_scrollTop(@scrollT.l)
        scroll = #True
      Else
        MessageRequester("Error", "Error loading web object", #MB_ICONERROR)
      EndIf
   
    Else
      MessageRequester("Error", "Error loading web object", #MB_ICONERROR)
    EndIf
   
  EndIf
 
  If scroll
    Debug DocDispatch
    myBrowser\get_scrollTop(@scrollT.l)
   
    If scrollT <> scrollH And scrollT <> prevPos
      myBrowser\put_scrollTop(scrollT+1000)
      prevPos = scrollT
      Delay(10)
    Else
      scroll = #False
      DocDispatch\Release()
    EndIf
  EndIf
 
Until Event = #PB_Event_CloseWindow

If DocDispatch
  DocDispatch\Release()
EndIf


End

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

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