OOBasic Popup menu Class

Creating Extension - Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This forum is not for asking questions about writing your own macros.

OOBasic Popup menu Class

Postby JeJe » Wed Sep 12, 2018 1:09 pm

A class to help make creating a popup menu with submenus more easily

Create a module with this code and call it MenuCls

Slight updates to 13 09 18: Added support for radio button, bug fixed return value when no button clicked,switched ">" "<" for ticked and unticked

Code: Select all   Expand viewCollapse view

   'Class to help easily create menus with submenus
   'Items separated by *
   'separator is _
   'icon specified by a | and the end of the URL after the caption name eg |sc_cut
   '< as the first character specifies unchecked check item
   '> as the first character specifies a checked check item
   '{  as the first character specifies an unchecked radio button
   '}  as the first character specifies a checked check item
Option Compatible
Option ClassModule
Option Explicit

private type menutype
   menu as object
   menuname as string
   idstart as long
   idend as long
   end type

   dim menus(40),nomenus as long
   dim idcounter as long
public iconURLbeginning as string

'addmenu - name for menu, string that defines menu
'optionally name of menu and menu button to attach new menu too
sub addmenu(menuname as string,menust as string,optional MenuToAttachTo, optional MenuButtonToAttachTo)
   dim m as menutype, ubmenus as long
   dim attachmenui as long, attachitemid as long

   if nomenus = 0 then
      if iconURLbeginning="" then iconURLbeginning="private:graphicrepository/res/commandimagelist/"
      idcounter =0
      redim menus(40)
   end if
   ubmenus = nomenus
   if ubmenus > 40 then exit sub 'exceeds arbitrary 40 limit
   nomenus = nomenus + 1

   set menus(ubmenus)= new menutype

   with menus(ubmenus)
      .menuname = menuname
      .menu = CreateUnoService("stardiv.vcl.PopupMenu")
      .idstart = idcounter+1
      idcounter =CreateMenuFromString( .menu,menust,idcounter +1)
      .idend = idcounter

      if ismissing (MenuToAttachTo) = false then
         attachitemid= getMenuid(attachmenui,MenuButtonToAttachTo)
      end if
   end with

end sub

'show menu from control event eg mousepressed
function showmenuOevt(Oevt,menuname as string) as string
   showmenuOevt=showmenu(oEvt.source.getcontext.Peer,menuname, oEvt.x + oEvt.source.getpossize.x, oEvt.y + oEvt.source.getpossize.y)
end function

'show menu by giving window
function showmenu(window,menuname as string,optional x as long, optional y as long) as string
   dim i as long,menuid as long,j as long
   Dim aRect As New com.sun.star.awt.Rectangle

   if ismissing(x)=false then aRect.x = x
   if ismissing(y) =false then aRect.y = y

   for i  = 0 to nomenus-1

      if menus(i).menuname = menuname then

         with menus(i)
            '            menuid=.menu.execute(oEvt.source.getcontext.Peer,aRect,com.sun.star.awt.PopupMenuDirection.EXECUTE_DEFAULT)

            for j  = 0 to nomenus -1

               with menus(j)
                  if ((menuid >=.idstart) and  (menuid <=   .idend)) then
                     menuname = .menuname
                     exit for
                  end if
               end with
         end with

         exit for
      end if
end function

'enable menu item
sub setEnabled(menuname,itemtext,benable as boolean,optional hideDisabledEntries as boolean)
   dim menui,id
   menui = getmenui(menuname)
   id = getmenuid(menui,itemtext)

   with menus(menui).menu

      if ismissing(hideDisabledEntries) =false then
      end if
   end with
end sub

'get menu index from menuname
function getmenui(menuname as string) as long
   dim i
   for i = 0 to nomenus -1
      if menus(i).menuname = menuname then
         getmenui =i
         exit for
      end if
end function

'get menu item id from menuindex and item text
function getMenuid(menui,itemtext)

   dim i, id
   with menus(menui).menu
      for i = 0 to .getItemCount
         id = .getitemid(i)
         if striptilde(.getitemtext(id)) = itemtext then
            getMenuid =  id
            exit for
         end if
   end with

end function

'creates the menu by passing a string, c = first item id
'return is the last item id
function CreateMenuFromString(oPopup,st as string, c as long)
   'split by *
   'note ~ identifies accelerator
   dim sts() as string,i,itmsts() as string,flags as long,firstchar as string
   dim isticked as boolean

   sts = split(st,"*")
   for i = 0 to ubound(sts)
      with opopup

         if trim(sts(i)) = "_"  then


firstchar =mid(sts(i),1,1)

            select case firstchar
            case "<"
               mid(sts(i),1,1) =" "
               isticked = false
               flags = 1
            case ">"
               mid(sts(i),1,1) =" "
               isticked = true
               flags =1
            case "{"
               mid(sts(i),1,1) =" "
               isticked = false
               flags = 2
            case "}"
               mid(sts(i),1,1) =" "
               isticked = true
               flags =2
            case else
               flags = 0
            end select

            if instr(1,sts(i),"|" ) =0 then
               .insertItem(c, sts(i),flags, i)
               '.setCommand(c, sts(i))
               itmsts = split(sts(i),"|")
               .insertItem(c, itmsts(0),flags, i)
               .setItemImage c,getimagefromurl(iconURLbeginning & cstr(itmsts(1)) & ".png"),false
               '.setCommand(c, itmsts(0))
            end if
            if isticked = true then .checkitem(c,true)
            c =c+1
         end if
      end with


End function

'GetImageFromURL function from "Useful Macro Information For OpenOffice" By Andrew Pitonyak
Function GetImageFromURL( URL as String ) 'as Variant
   Dim oMediaProperties(0) 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
   REM Retrieve the com.sun.star.graphic.XGraphic instance
   GetImageFromURL = oGraphicProvider.queryGraphic( oMediaProperties() )
End Function

'remove ~ from string
function StripTilde( st As String) as string
   dim lenst as long,abit as string,bbit as string, a as long
   lenst = Len(st)
   a = InStr(1, st, "~")

   If a <> 0 Then
      If a <> 1 Then abit = Left(st, a - 1)
      If a <> Len(st) Then bbit = Right(st, lenst - a)
      st = abit & bbit
      StripTilde=abit & bbit
   end if

End function

test code to put in another module:

Code: Select all   Expand viewCollapse view

Function MenuclsTest()
dim mm, menuname as string

set mm= new MenuCls

'add menu - choose menu name and pass string defining menu
mm.addmenu "contextMenu", "Default Formatting*_*Textbox*Style*_*Case/Characters*_*Cut|sc_cut*Copy|sc_copy*Paste|sc_paste*_*Insert*Autotext*Spelling*Synonyms"
'to attach new menu to existing menu add the name of the existing menu and the button caption name
mm.addmenu  "TextboxMenu","Font...*Text Color...*Backgound Color...*_*Line Spacing*_*>AutoCorrect on*<Word Completion on*>Spell as you type on","contextMenu", "Textbox"
mm.addmenu "StyleMenu","Bold|sk/sc_bold*Italic|sk/sc_italic*Underline|sc_underline*Strikethrough|bg/sc_strikeout","contextMenu", "Style" '*Shadow*Outline*_*Superscript|sc_superscript*Subscript",21
mm.addmenu "CaseMenu", "Sentence case*lowercase*UPPERCASE*Capitalise Every Word*tOGGLE cASE","contextMenu","Case/Characters"
mm.addmenu "insertMenu","Date*Time*Calculation","contextMenu","Insert"
mm.addmenu "LineSpacing", "{Single*}1.5 Lines*{Double","TextboxMenu","Line Spacing"

menuname = "contextMenu"

'show menu giving the window and a variable for the menuname
res = mm.showmenu(thiscomponent.currentcontroller.frame.getContainerWindow(),menuname)

IF res <> "" then msgbox menuname & "*" & res

'res = mm.showmenu(oEvt.source.getcontext.Peer, menuname, oEvt.x + oEvt.source.getpossize.x, oEvt.y + oEvt.source.getpossize.y)
'res = mm.showmenuOevt(oEvt,menuname)

End function

Openoffice 4.1.2
Windows 8
Posts: 513
Joined: Wed Mar 09, 2016 2:40 pm

Return to Code Snippets

Who is online

Users browsing this forum: No registered users and 2 guests