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 = 500
IDM_One
IDM_Two
IDM_Exit
End Enum
Global hDlg, hContext 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"
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
Select Case Cb.Msg
Case %WM_InitDialog
CreateContextMenu
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
Local P As Point
GetCursorPos P
TrackPopupMenu hContext, %TPM_LeftAlign, P.x, P.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
'gbs_01310
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm