Toggle Custom Menu

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 = 5000
   IDC_ToggleMenu
   IDM_One
   IDM_Two
   IDM_Exit
End Enum
 
Global hDlg, hContext, hBrowser, CustomMenu As Dword
 
Function PBMain
   Local pWindow As IWindow, pWBEvents As DWebBrowserEvents2Impl
   Dialog New Pixels, 0, "WebBrowser", , , 600, 400, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_ToggleMenu, "Toggle Custom Menu", 10,10,150,20
   pWindow = Class "CWindow"
   pWBEvents = Class "CDWebBrowserEvents2"
   hBrowser = pWindow.AddWebBrowserControl(hDlg, %IDC_WEBBROWSER, "http://www.powerbasic.com", pWBEvents, 0, 30, 600,370)
   Dialog Show Modal hDlg, Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y As Long
   Local pWindow As IWindow, pWBEvents As DWebBrowserEvents2Impl
   Select Case Cb.Msg
      Case %WM_InitDialog
         CreateContextMenu
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_ToggleMenu
               CustomMenu = CustomMenu Xor 1
            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
         If CustomMenu Then
            TrackPopupMenu hContext, %TPM_LeftAlign, ppt.x, ppt.y, 0, hDlg, ByVal 0
            Method = %S_Ok
         Else
            Method = %S_False
         End If
      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_01335
'Date: 05-11-2013                                             

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