OOBasic Popup menu Class

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 section is not for asking questions about writing your own macros.
Post Reply
JeJe
Volunteer
Posts: 2763
Joined: Wed Mar 09, 2016 2:40 pm

OOBasic Popup menu Class

Post by JeJe »

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


	'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

Windows 10, Openoffice 4.1.11, LibreOffice 7.4.0.3 (x64)
Post Reply