Context Menu

Category: Jose Roca

Date: 02-16-2022

Return to Index


 
'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 IDispatchByRef 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 DwordByRef ppt As Point, ByVal pcmdtReserved As IUnknownByVal pdispReserved As IDispatchAs 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 DwordByVal 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 LongAs Long : End Method
      Method OnDocWindowActivate (ByVal fActivate As Long) : End Method
      Method OnFrameWindowActivate (ByVal fActivate As LongAs Long : End Method
      Method ResizeBorder (ByRef prcBorder As RECT, ByVal pUIWindow As IOleInPlaceUIWindow, ByVal fRameWindow As LongAs Long : End Method
 
      Method TranslateAccelerator (ByRef lpMsg As tagMSG, ByRef pguidCmdGroup As GuidByVal nCmdID As DwordAs Long
         Method = %S_False
      End Method
 
      Method GetOptionKeyPath (ByRef pchKey As Dword,ByVal dw_ As DwordAs 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 IDispatchAs Long
         ppDispatch = Nothing
         Method = %S_False
      End Method
 
      Method TranslateUrl (ByVal dwTranslate As DwordByRef pchURLIn As WStringZByRef ppchURLOut As WStringZAs 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 DwordByVal dw_ As DwordAs Long
         pchKey = %NULL
      End Method
   End Interface
End Class
 
'gbs_01310
'Date: 05-11-2013   


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm