OpenOffice.info

Code: Alles auswählen

REM  *****  BASIC  *****
REM extended context menu for illustrator graphics

Option Explicit

Global oLOTTeDocController                                        As Object
Global oLOTTeContextMenuInterceptor                               As Object
Global oLOTTeDoc                                                  As Object

rem setup event to contextmenu interceptor
Sub LOTTeRegisterContextMenuInterceptor
  oLOTTeDoc                                                       =thisComponent
  oLOTTeDocController                                             =oLOTTeDoc.CurrentController
  oLOTTeContextMenuInterceptor                                    =CreateUnoListener("LOTTeGraphic_", "com.sun.star.ui.XContextMenuInterceptor")
   
  oLOTTeDocController.registerContextMenuInterceptor(oLOTTeContextMenuInterceptor)

End Sub


rem release context menu items
Sub LOTTeReleaseContextMenuInterceptor
  On Error Resume Next
  oLOTTeDocController.releaseContextMenuInterceptor(oLOTTeContextMenuInterceptor)
   
End Sub


rem create menu entries
Function LOTTeGraphic_notifyContextMenuExecute(ContextMenuExecuteEvent As Object) As Variant
  Dim oSrcWin                                                     As Object
  Dim oExePoint                                                   As Object
  Dim oATContainer                                                As Object
  Dim oSelection                                                  As Object
  Dim oMenuItem(5)                                                As Object
  Dim PysEnCours                                                  As Object

  With ContextMenuExecuteEvent

    'contains the window where the context
    'menu has been requested
    oSrcWin                                                       =.SourceWindow

    'contains the position the context menu
    'will be executed at (css.awt.Point)
    oExePoint                                                     =.ExecutePosition
   
    'enables the access to the menu content.
    'The implementing object has to support the
    'service ActionTriggerContainer
    oATContainer                                                  =.ActionTriggerContainer
   
    'provides the current selection
    'inside the source window
    oSelection                                                    =.Selection
    
  End With

  PysEnCours                                                      =thisComponent.currentselection	
  
  ' starbasic seems to check AND bindings together
  If Not PysEnCours.supportsService("com.sun.star.drawing.ShapeCollection") Then
    LOTTeGraphic_notifyContextMenuExecute                         =com.sun.star.ui.ContextMenuInterceptorAction.IGNORED
    Exit Function
    
  End If
	   
  If inStr(PysEnCours(0).name, "LOTTe") >0 _
     And LOTTeExistsInfoShape(PysEnCours(0)) _
  Then
    Dim aImageUrls(2)                                             As String
    Dim sMimeType                                                 As String
    
    'set needed subcontainers/ sub menus
    Dim oSubContainer(0)                                          As Object
  
	REM *** add some context menu entries
	
	rem create a separator LINE|SPACE|LINEBREAK
	LOTTeSetMenuSeparator(oATContainer, "LINE")
	
	rem create a item with subcontainer
	'   call with: action trigger container object, icon text, macro to call, boolean create a submenu, optional help URL
	oSubContainer(0) =LOTTeSetMenuItem(oATContainer, "LOTTe", "macro:///LOTTeMatheGrafik.LOTTeContextMenuGraphics.LOTTeChanceGraphEquation", TRUE)
	
	  'create a item in subcontainer(0) without subcontainer
	  LOTTeSetMenuItem(oSubContainer(0), "LOTTe Sub", "macro:///LOTTeMatheGrafik.LOTTeContextMenuGraphics.LOTTeChanceGraphEquation", FALSE)
	  
	rem bound a image to menu item script URL
	'   for mime/type see LOTTeGetImageFromURL
	'   aImageUrls = three urls for SIZE_DEFAULT, SIZE_LARGE and SIZE_32 in this order
	aImageUrls =ARRAY("file:///home/frank/swapbuttonIconRed.svg", "file:///home/frank/swapbuttonIconGreen.svg", "file:///home/frank/swapbuttonIconBlue.svg")
	sMimeType  ="image/svg+xml"
	LOTTeImageManager("macro:///LOTTeMatheGrafik.LOTTeContextMenuGraphics.LOTTeChanceGraphEquation", aImageURLs, sMimeType)
	
	
	'LOTTeSetMenuItem(oATContainer, "LOTTe", "vnd.sun.star.script:LOTTeMatheGrafik.LOTTeContextMenuGraphics.LOTTeChanceGraphEquation?language=Basic&location=application")
	
	' POSSIBLE RESULTS FOR THIS FUNCTION
	' This function must result one of the following values:
	
	' com.sun.star.ui.ContextMenuInterceptorAction.IGNORED
	'   the XContextMenuInterceptor has ignored the call.
	'   The next registered XContextMenuInterceptor should be notified.
	
	' com.sun.star.ui.ContextMenuInterceptorAction.CANCELLED
	'   the context menu must not be executed.
	'   The next registered XContextMenuInterceptor should not be notified.
	
	' com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
	'   the menu has been modified and should be executed
	'   without notifying the next registered XContextMenuInterceptor.
	
	' com.sun.star.ui.ContextMenuInterceptorAction.CONTINUE_MODIFIED
	'   the menu has been modified and the next registered
	'   XContextMenuInterceptor should be notified.
	
	LOTTeGraphic_notifyContextMenuExecute                         =com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
  
  Else
    LOTTeGraphic_notifyContextMenuExecute                         =com.sun.star.ui.ContextMenuInterceptorAction.IGNORED
  
  End If

End Function

rem create a menu item
Function LOTTeSetMenuItem( oActionTriggerContainer As Object, sText As String, sCommandUrl As String, bCreateSubContainer As Boolean, Optional sHelpUrl As String) As Variant
  Dim oItem                                                       As Object
  Dim iPlace                                                      As Integer
  Dim oNewContainer                                               As Object

  iPlace                                                          =oActionTriggerContainer.Count
  oItem                                                           =oActionTriggerContainer.createInstance("com.sun.star.ui.ActionTrigger")
  oActionTriggerContainer.insertByIndex(iPlace, oItem)
  oItem                                                           =oActionTriggerContainer.getByIndex(iPlace)
  oItem.setPropertyValue("Text", sText)
  oItem.setPropertyValue("CommandURL", sCommandUrl)
  
  'create a subcontainer
  If bCreateSubContainer Then
    oNewContainer                                                 =oActionTriggerContainer.createInstance("com.sun.star.ui.ActionTriggerContainer")
    oItem.setPropertyValue("SubContainer", oNewContainer)
    
    LOTTeSetMenuItem                                              =oNewContainer
    
  End If
  
  'set help URL is given
  If Not isMissing(sHelpUrl) Then
    oItem.setPropertyValue("HelpURL", sHelpUrl)
    
  End If
  
  oActionTriggerContainer.replaceByIndex(iPlace, oItem)
  
End Function


rem create a menu separator
Sub LOTTeSetMenuSeparator( oActionTriggerContainer As Object, sType As String) As Object
  Dim oSeparator                                                  As Object
  Dim iSeparatorType                                              As Integer
  Dim iPlace                                                      As Integer
  
  Select Case lCase(sType)
    Case "line"
      iSeparatorType                                              =com.sun.star.ui.ActionTriggerSeparatorType.LINE
      
    Case "space"
      iSeparatorType                                              =com.sun.star.ui.ActionTriggerSeparatorType.SPACE
    
    Case "linebreak"
      iSeparatorType                                              =com.sun.star.ui.ActionTriggerSeparatorType.LINEBREAK
    
  End Select
  
  iPlace                                                          =oActionTriggerContainer.Count
  
  oSeparator                                                      =oActionTriggerContainer.createInstance("com.sun.star.ui.ActionTriggerSeparator")
  oActionTriggerContainer.insertByIndex(iPlace, oSeparator)
  oSeparator                                                      =oActionTriggerContainer.getByIndex(iPlace)
  oSeparator.setPropertyValue("SeparatorType", iSeparatorType)
  oActionTriggerContainer.replaceByIndex(iPlace, oSeparator)
  
End Sub

rem load a Image into the writer image manager
'   It will generate a set of images.
'   Therefor three image URLs are needed for SIZE_DEFAULT, SIZE_LARGE and SIZE_32
'   COLOR_NORMAL and COLOR_HIGHCONTRAST wasn't working for me and I don't no how to implement it.
'   For mime/type see LOTTeGetImageFromURL
Sub LOTTeImageManager(sCmdID As String, aImageURLs As Variant, sMime As String)

  Dim sDocType                                                    As String
  Dim oSupplier                                                   As Object
  Dim oModuleCfgMgr                                               As Object
  Dim oImageMgr                                                   As Object
  Dim aImages                                                     As Variant
  
  sDocType                                                        ="com.sun.star.text.TextDocument"    ' in this case the UI configuration manager for TextDocuments will be used

  'Retrieve the module configuration manager from the
  'central module configuration manager supplier
  oSupplier                                                       =CreateUnoService("com.sun.star.ui.ModuleUIConfigurationManagerSupplier")
  
  'Retrieve the module configuration manager with module identifier
  'See com.sun.star.frame.ModuleManager for more information
  oModuleCfgMgr                                                   =oSupplier.getUIConfigurationManager( sDocType )
  oImageMgr                                                       =oModuleCfgMgr.getImageManager()
  
  Dim oImageCmds(0)                                               As String
  Dim oImages(0)                                                  As Object
  Dim aImageType()                                                As Integer
  Dim oImage                                                      As Object
  Dim iType                                                       As Integer
  
  aImageType                                                      =ARRAY(0,1,2)                        ' see com::sun::star::UI::ImageType, but 4 (high contrast) wasn't working for me
  
  For Each iType In aImageType
    If Not oImageMgr.hasImage(iType, sCmdID) Then                                                      ' Check if image has already been added
      oImage                                                      =LOTTeGetImageFromURL( aImageUrls(iType), sMime ) ' Try to load the image from the file URL
      
      If Not isNull(oImage) Then                                                                       ' Insert new image into the writer image manager
        oImageCmds(0)                                             =sCmdID
        oImages(0)                                                =oImage
        oImageMgr.insertImages(iType, oImageCmds(), oImages())
      
      End If
    
    End If
    
  Next iType  

End Sub

rem load a Image to use as icon
'    for mime/type: image/bmp, image/gif, image/jpeg, image/png, image/tiff
'                   image/svg+xml, image/x-cmu-raster, image/x-emf, image/x-eps
'                   image/x-met, image/x-pict, image/x-portable-bitmap, image/x-portable-pixmap
'                   image/x-wmf, image/x-svm, image/x-xpixmap, image/x-vclgraphic
Function LOTTeGetImageFromURL( sURL As String, sMime As String )  As Variant
  Dim oMediaProperties(1)                                         As New com.sun.star.beans.PropertyValue
  Dim oGraphicProvider                                            As Object
  
  'Create graphic provider instance to load images from files.
  oGraphicProvider                                                =createUnoService("com.sun.star.graphic.GraphicProvider")
  
  'Set URL property so graphic provider is able to load the image
  oMediaProperties(0).Name                                        ="URL"
  oMediaProperties(0).Value                                       =sURL
  oMediaProperties(1).Name                                        ="MimeType"
  oMediaProperties(1).Value                                       =sMime
  
  'Retrieve the com.sun.star.graphic.XGraphic instance
  LOTTeGetImageFromURL                                            =oGraphicProvider.queryGraphic( oMediaProperties() )
  
End Function

Code: Alles auswählen

Sub imagemanager()

  Dim sDocType$ : sDocType ="com.sun.star.text.TextDocument"
  Dim sSupplier$
  Dim oSupplier
  Dim oModuleCfgMgr
  Dim oImageMgr
  Dim sCmdID
  
  sCmdID = "vnd.sun.star.script:LOTTeMatheGrafik.LOTTeContextMenuGraphics.LOTTeChanceGraphEquation?language=Basic&location=application"

  REM Retrieve the module configuration manager from the
  REM central module configuration manager supplier
  sSupplier = "com.sun.star.ui.ModuleUIConfigurationManagerSupplier"
  oSupplier = CreateUnoService(sSupplier)
  
  REM Retrieve the module configuration manager with module identifier
  REM *** See com.sun.star.frame.ModuleManager for more information
  oModuleCfgMgr = oSupplier.getUIConfigurationManager( sDocType )
  oImageMgr = oModuleCfgMgr.getImageManager()
  
  
  Dim oImageCmds(0)
  Dim oImages(0)
  Dim oImage
  
  REM *** Check if image has already been added
  If Not oImageMgr.hasImage( 0, sCmdID ) Then
    REM Try to load the image from the file URL
    oImage = GetImageFromURL( "file:///home/frank/swapIconSmall.bmp" )
    If Not isNull( oImage ) Then
      REM *** Insert new image into the Writer image manager
      oImageCmds(0) = sCmdID
      oImages(0) = oImage
      oImageMgr.insertImages( 2, oImageCmds(), oImages() )
      
    End If
     
  Else
    msgBox "Image bereits geladen.",0,"imagemanager"
  
  End If
  
  REM images in imagemanager
  Dim sImage             As String
  Dim msg                  As String
  Dim aImages            As Variant
  
  aImages = oImageMgr.getAllImageNames(2)
  
  For Each sImage In aImages
    If InStr(sImage,"LOTTe") >0 Then
      msg =msg & sImage & Chr(10)
      
    End If
  
  Next 
  
  msgbox msg,1,"Images"
  

End Sub

Function GetImageFromURL( URL as String ) as Variant
  Dim oMediaProperties(1) As New com.sun.star.beans.PropertyValue
  Dim sProvider$ : sProvider = "com.sun.star.graphic.GraphicProvider"
  Dim oGraphicProvider
  
  REM Create graphic provider instance to load images from files.
  oGraphicProvider = createUnoService( sProvider )
  
  REM Set URL property so graphic provider is able to load the image
  oMediaProperties(0).Name = "URL"
  oMediaProperties(0).Value = URL
  oMediaProperties(1).Name = "MimeType"
  oMediaProperties(1).Value = "image/bmp"
  
  REM Retrieve the com.sun.star.graphic.XGraphic instance
  GetImageFromURL = oGraphicProvider.queryGraphic( oMediaProperties() )
  
End Function