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
'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
attachmenui=getmenui(MenuToAttachTo)
attachitemid= getMenuid(attachmenui,MenuButtonToAttachTo)
menus(attachmenui).menu.setPopupMenu(attachitemid,.menu)
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)
menuid=.menu.execute(window,aRect,com.sun.star.awt.PopupMenuDirection.EXECUTE_DEFAULT)
for j = 0 to nomenus -1
with menus(j)
if ((menuid >=.idstart) and (menuid <= .idend)) then
showmenu=striptilde(.menu.getitemText(menuid))
menuname = .menuname
exit for
end if
end with
next
end with
exit for
end if
next
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
.enableItem(id,benable)
if ismissing(hideDisabledEntries) =false then
.hideDisabledEntries(hideDisabledEntries)
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
next
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
next
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 *
'separator_
'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
opopup.insertSeparator(i)
ELSE
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
STS(I)=TRIM(STS(I))
if instr(1,sts(i),"|" ) =0 then
.insertItem(c, sts(i),flags, i)
'.setCommand(c, sts(i))
else
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
next
CreateMenuFromString=c
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
else
StripTilde=st
end if
End function
test code to put in another module:
Code: Select all
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
'CALLS FROM CONTROL EVENT SUCH AS MOUSEPRESS
'res = mm.showmenu(oEvt.source.getcontext.Peer, menuname, oEvt.x + oEvt.source.getpossize.x, oEvt.y + oEvt.source.getpossize.y)
'OR
'res = mm.showmenuOevt(oEvt,menuname)
End function