Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
%UseWebBrowser = 1 ' // Use the WebBrowser control
#Include Once "CWindow.inc" ' // CWindow class
Enum Equates Singular
IDC_WebBrowser = 5000
IDM_One
IDM_Two
IDM_Exit
End Enum
Global hDlg, hContext, hBrowser As Dword
Function PBMain
Local pWindow As IWindow, pWBEvents As DWebBrowserEvents2Impl
Dialog New Pixels, 0, "WebBrowser", , , 600, 400, %WS_OverlappedWindow To hDlg
pWindow = Class "CWindow"
pWBEvents = Class "CDWebBrowserEvents2"
hBrowser = pWindow.AddWebBrowserControl(hDlg, %IDC_WEBBROWSER, "http://www.powerbasic.com", pWBEvents, 0, 0, 600,400)
Dialog Show Modal hDlg, Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local x,y As Long
Select Case Cb.Msg
Case %WM_InitDialog
CreateContextMenu
Case %WM_Command
Select Case Cb.Ctl
Case %IDM_One : ? "One"
Case %IDM_Two : ? "Two"
Case %IDM_Exit : Dialog End hDlg
End Select
End Select
End Function
Sub CreateContextMenu
Menu New PopUp To hContext
Menu Add String, hContext, "One", %IDM_One, %MF_Enabled
Menu Add String, hContext, "Two", %IDM_Two, %MF_Enabled
Menu Add String, hContext, "Exit", %IDM_Exit, %MF_Enabled
End Sub
Class CDWebBrowserEvents2 As Event
Interface DWebBrowserEvents2Impl $IID_DWebBrowserEvents2 As Event
Inherit IDispatch
Method DocumentComplete <259> (ByVal pDisp As IDispatch, ByRef vURL As Variant)
Local pIWebBrowser2 As IWebBrowser2
Local pIHTMLDocument2 As IHTMLDocument2
Local pICustomDoc As ICustomDoc
Local pDocHostUIHandler As IDocHostUIHandler2Impl
pIWebBrowser2 = pDisp
pIHTMLDocument2 = pIWebBrowser2.Document
pICustomDoc = pIHTMLDocument2
pDocHostUIHandler = Class "CDocHostUIHandler2"
pICustomDoc.SetUIHandler(pDocHostUIHandler)
End Method
End Interface
End Class
Class CDocHostUIHandler2 As Common ' // Use AS COMMON to avoid removal of methods
Interface IDocHostUIHandler2Impl $IID_IDocHostUIHandler2
Inherit IUnknown
Method ShowContextMenu (ByVal dwID As Dword, ByRef ppt As Point, ByVal pcmdtReserved As IUnknown, ByVal pdispReserved As IDispatch) As Long
TrackPopupMenu hContext, %TPM_LeftAlign, ppt.x, ppt.y, 0, hDlg, ByVal 0
Method = %S_Ok
End Method
Method GetHostInfo (ByRef pInfo As DOCHOSTUIINFO) As Long
If VarPtr(pInfo) Then
pInfo.cbSize = SizeOf(DOCHOSTUIINFO)
pInfo.dwFlags = %DOCHOSTUIFLAG_NO3DBORDER Or %DOCHOSTUIFLAG_THEME
pInfo.dwDoubleClick = %DOCHOSTUIDBLCLK_DEFAULT
pInfo.pchHostCss = %NULL
pInfo.pchHostNS = %NULL
End If
Method = %S_Ok
End Method
Method ShowUI (ByVal dwID As Dword, ByVal pActiveObject As IOleInPlaceActiveObject, ByVal pCommandTarget As IOleCommandTarget _
, ByVal pFrame As IOleInPlaceFrame, ByVal pDoc As IOleInPlaceUIWindow) As Long : End Method
Method HideUI () As Long : End Method
Method UpdateUI () As Long : End Method
Method EnableModeless (ByVal fEnable As Long) As Long : End Method
Method OnDocWindowActivate (ByVal fActivate As Long) : End Method
Method OnFrameWindowActivate (ByVal fActivate As Long) As Long : End Method
Method ResizeBorder (ByRef prcBorder As RECT, ByVal pUIWindow As IOleInPlaceUIWindow, ByVal fRameWindow As Long) As Long : End Method
Method TranslateAccelerator (ByRef lpMsg As tagMSG, ByRef pguidCmdGroup As Guid, ByVal nCmdID As Dword) As Long
Method = %S_False
End Method
Method GetOptionKeyPath (ByRef pchKey As Dword,ByVal dw_ As Dword) As Long
pchKey = %NULL
End Method
Method GetDropTarget (ByVal pDropTarget As IDropTarget, ByRef ppDropTarget As IDropTarget) As Long
ppDropTarget = Nothing
Method = %E_NotImpl
End Method
Method GetExternal (ByRef ppDispatch As IDispatch) As Long
ppDispatch = Nothing
Method = %S_False
End Method
Method TranslateUrl (ByVal dwTranslate As Dword, ByRef pchURLIn As WStringZ, ByRef ppchURLOut As WStringZ) As Long
ppchURLOut = ""
Method = %S_False
End Method
Method FilterDataObject (ByVal pDO As IDataObject, ByRef ppDORet As IDataObject) As Long
ppDORet = Nothing
Method = %S_False
End Method
Method GetOverrideKeyPath (ByRef pchKey As Dword, ByVal dw_ As Dword) As Long
pchKey = %NULL
End Method
End Interface
End Class
'Note: Unused methods of the DWebBrowserEvents2Impl events interface can be removed,
'since it is a dispatch interface and methods are called by the hidden implementation
'of the Invoke method that first checks if a method with the correct identifier exist,
'but the IDocHostUIHandler2Impl interface inherits from IUnknown and are called directly
'by address, so you can't remove any of them or the wrong one will be called.
'gbs_01348
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm