PureBasic Forums - English

Code: Select all

EnableExplicit

XIncludeFile "COMatePLUS.pbi"

Declare WebEventProc(obj.COMateObject, evtName.s, paramCount)

Structure BrowserWindow
  id.i
  web.i
  com.COMateObject
EndStructure

Global Quit.b, NewList BrowserWindows.BrowserWindow()

Procedure OnWindowSized()
  Protected *dat
  *dat = GetWindowData(EventWindow())
  ChangeCurrentElement(BrowserWindows(), *dat)
  ResizeGadget(BrowserWindows()\web, #PB_Ignore, #PB_Ignore, WindowWidth(BrowserWindows()\id) - 20, WindowHeight(BrowserWindows()\id) - 20)
EndProcedure

Procedure OnWindowClosed()
  Protected *dat
  *dat = GetWindowData(EventWindow())
  ChangeCurrentElement(BrowserWindows(), *dat)
  BrowserWindows()\com\Release()
  CloseWindow(BrowserWindows()\id)
  DeleteElement(BrowserWindows())
  If ListSize(BrowserWindows()) = 0
    Quit = #True
  EndIf
EndProcedure

Procedure OpenBrowserWindow(url.s)
  Protected iid.IID
  AddElement(BrowserWindows())
  BrowserWindows()\id = OpenWindow(#PB_Any, 0, 0, 640, 480, url, #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SystemMenu)
  BrowserWindows()\web = WebGadget(#PB_Any, 10, 10, 620, 460, url)
  BrowserWindows()\com = COMate_WrapCOMObject(GetWindowLongPtr_(GadgetID(BrowserWindows()\web), #GWL_USERDATA)) 
  If COMate_GetIIDFromName("DWebBrowserEvents2", @iid.IID) = #S_OK
    BrowserWindows()\com\SetEventHandler(#COMate_CatchAllEvents, @WebEventProc(), 0, iid)
  EndIf
  SetWindowData(BrowserWindows()\id, @BrowserWindows())
  BindEvent(#PB_Event_SizeWindow, @OnWindowSized(), BrowserWindows()\id)
  BindEvent(#PB_Event_CloseWindow, @OnWindowClosed(), BrowserWindows()\id)
EndProcedure

OpenBrowserWindow("https://www.purebasic.com")

Repeat : WaitWindowEvent() : Until Quit = #True

Procedure WebEventProc(obj.COMateObject, evtName.s, paramCount)
  Protected *ptrBool.WORD
  Select evtName
    Case "NewWindow3"
      OpenBrowserWindow(obj\GetStringEventParam(5))
      If obj\IsEventParamPassedByRef(2, @*ptrBool)
        *ptrBool\w = #VARIANT_TRUE
      EndIf
  EndSelect
EndProcedure