Access2Base - New CommandBarControl class

Main functionalities:
- show/hide toolbar elements
- modify tooltip
- get/set internal command
- execute internal command

Change-Id: Ice830009f9eabc199727c7d4b54ebf524b026d40

wizards/Package_access2base.mk

@@ -25,6 +25,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
 	Application.xba \
 	Collect.xba \
 	CommandBar.xba \
+	CommandBarControl.xba \
 	Compatible.xba \
 	Control.xba \
 	Database.xba \

wizards/source/access2base/Application.xba

@@ -79,35 +79,37 @@ Global Const DBCONNECTFORM			=	2			'	Connection from a database-aware form
 Global Const DBCONNECTANY			=	3			'	Connection from any document for data access only (OpenDatabase)
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Global Const COLLALLDIALOGS 	= "ALLDIALOGS"
-Global Const COLLALLFORMS		= "ALLFORMS"
-Global Const COLLCOMMANDBARS	= "COMMANDBARS"
-Global Const COLLCONTROLS		= "CONTROLS"
-Global Const COLLFORMS			= "FORMS"
-Global Const COLLFIELDS			= "FIELDS"
-Global Const COLLPROPERTIES		= "PROPERTIES"
-Global Const COLLQUERYDEFS		= "QUERYDEFS"
-Global Const COLLRECORDSETS		= "RECORDSETS"
-Global Const COLLTABLEDEFS		= "TABLEDEFS"
-Global Const COLLTEMPVARS		= "TEMPVARS"
+Global Const COLLALLDIALOGS 		= "ALLDIALOGS"
+Global Const COLLALLFORMS			= "ALLFORMS"
+Global Const COLLCOMMANDBARS		= "COMMANDBARS"
+Global Const COLLCOMMANDBARCONTROLS	= "COMMANDBARCONTROLS"
+Global Const COLLCONTROLS			= "CONTROLS"
+Global Const COLLFORMS				= "FORMS"
+Global Const COLLFIELDS				= "FIELDS"
+Global Const COLLPROPERTIES			= "PROPERTIES"
+Global Const COLLQUERYDEFS			= "QUERYDEFS"
+Global Const COLLRECORDSETS			= "RECORDSETS"
+Global Const COLLTABLEDEFS			= "TABLEDEFS"
+Global Const COLLTEMPVARS			= "TEMPVARS"
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Global Const OBJAPPLICATION	= "APPLICATION"
-Global Const OBJCOLLECTION	= "COLLECTION"
-Global Const OBJCOMMANDBAR	= "COMMANDBAR"
-Global Const OBJCONTROL		= "CONTROL"
-Global Const OBJDATABASE	= "DATABASE"
-Global Const OBJDIALOG		= "DIALOG"
-Global Const OBJEVENT		= "EVENT"
-Global Const OBJFIELD		= "FIELD"
-Global Const OBJFORM		= "FORM"
-Global Const OBJOPTIONGROUP	= "OPTIONGROUP"
-Global Const OBJPROPERTY	= "PROPERTY"
-Global Const OBJQUERYDEF	= "QUERYDEF"
-Global Const OBJRECORDSET	= "RECORDSET"
-Global Const OBJSUBFORM		= "SUBFORM"
-Global Const OBJTABLEDEF	= "TABLEDEF"
-Global Const OBJTEMPVAR		= "TEMPVAR"
+Global Const OBJAPPLICATION			= "APPLICATION"
+Global Const OBJCOLLECTION			= "COLLECTION"
+Global Const OBJCOMMANDBAR			= "COMMANDBAR"
+Global Const OBJCOMMANDBARCONTROL	= "COMMANDBARCONTROL"
+Global Const OBJCONTROL				= "CONTROL"
+Global Const OBJDATABASE			= "DATABASE"
+Global Const OBJDIALOG				= "DIALOG"
+Global Const OBJEVENT				= "EVENT"
+Global Const OBJFIELD				= "FIELD"
+Global Const OBJFORM				= "FORM"
+Global Const OBJOPTIONGROUP			= "OPTIONGROUP"
+Global Const OBJPROPERTY			= "PROPERTY"
+Global Const OBJQUERYDEF			= "QUERYDEF"
+Global Const OBJRECORDSET			= "RECORDSET"
+Global Const OBJSUBFORM				= "SUBFORM"
+Global Const OBJTABLEDEF			= "TABLEDEF"
+Global Const OBJTEMPVAR				= "TEMPVAR"
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Global Const CTLCONTROL			= "CONTROL"		'	ClassId
@@ -471,11 +473,9 @@ Const cstCustom = "CUSTOM"
 				For i = 0 To UBound(vUIElements)
 					sToolbarFullName = _GetPropertyValue(vUIElements(i), "ResourceURL")
 					sToolbarName = Split(sToolbarFullName, "/")(2)
-					If Len(sToolbarName) > Len(cstCustom) Then
-						If Left(UCase(sToolbarName), Len(cstCustom)) = cstCustom Then
-							sToolbarName = _GetPropertyValue(vUIElements(i), "UIName")
-							iBuiltin = 2
-						End If
+					If _IsLeft(UCase(sToolbarName), UCase(cstCustom)) Then
+						sToolbarName = _GetPropertyValue(vUIElements(i), "UIName")
+						iBuiltin = 2
 					End If
 
 					iObjectsCount = iObjectsCount + 1

wizards/source/access2base/Collect.xba

@@ -62,7 +62,12 @@ Property Get Item(ByVal Optional pvItem As Variant) As Variant
 Const cstThisSub = "Collection.getItem"
 	Utils._SetCalledSub(cstThisSub)
 	If IsMissing(pvItem) Then Goto Exit_Function	'	To allow object watching in Basic IDE, do not generate error
-	If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+	Select Case _CollType
+		Case COLLCOMMANDBARCONTROLS					'	Have no name
+			If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric()) Then Goto Exit_Function
+		Case Else
+			If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+	End Select
 
 Dim vNames() As Variant, oProperty As Object
 
@@ -74,6 +79,8 @@ Dim vNames() As Variant, oProperty As Object
 			Set Item = Application.AllForms(pvItem)
 		Case COLLCOMMANDBARS
 			Set Item = Application.CommandBars(pvItem)
+		Case COLLCOMMANDBARCONTROLS
+			Set Item = Application.CommandBars(_ParentName).CommandBarControls(pvItem)
 		Case COLLCONTROLS
 			Select Case _ParentType
 				Case OBJCONTROL, OBJSUBFORM

wizards/source/access2base/CommandBar.xba

@@ -16,7 +16,7 @@ REM ----------------------------------------------------------------------------
 
 Private _Type			As String		'	Must be COMMANDBAR
 Private _Name			As String
-Private _ResourceURL		As String
+Private _ResourceURL	As String
 Private _Window			As Object		'	com.sun.star.frame.XFrame
 Private _Module			As String
 Private _Toolbar		As Object
@@ -99,12 +99,122 @@ End Property		'	Visible (get)
 
 Property Let Visible(ByVal pvValue As Variant)
 	Call _PropertySet("Visible", pvValue)
-End Property		'	Visible (get)
+End Property		'	Visible (set)
 
 REM -----------------------------------------------------------------------------------------------------------------------
 REM --- CLASS METHODS	 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CommandBarControls(Optional ByVal pvIndex As Variant) As Variant
+'	Return an object of type CommandBarControl indicated by its index
+'	Index is different from UNO index: separators do not count
+'	If no pvIndex argument, return a Collection type
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "CommandBar.CommandBarControls"
+	Utils._SetCalledSub(cstThisSub)
+
+Dim oLayout As Object, vElements() As Variant, iIndexToolbar As Integer, oToolbar As Object
+Dim i As Integer, iItemsCount As Integer, oSettings As Object, vItem() As Variant, bSeparator As Boolean
+Dim oObject As Object
+
+	Set oObject = Nothing
+	If Not IsMissing(pvIndex) Then
+		If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
+		If pvIndex < 0 Then Goto Trace_IndexError
+	End If
+
+	Select Case _BarType
+		Case msoBarTypeNormal, msoBarTypeMenuBar
+		Case Else	:	Goto Error_NotApplicable				'	Status bar not supported
+	End Select
+
+	Set oLayout = _Window.LayoutManager
+	vElements = oLayout.getElements()
+	iIndexToolbar = _FindElement(vElements())
+	If iIndexToolbar < 0 Then Goto Error_NotApplicable			'	Toolbar not visible
+	Set oToolbar = vElements(iIndexToolbar)
+
+	iItemsCount = 0
+	Set oSettings = oToolbar.getSettings(False)
+
+	bSeparator = False	
+	For i = 0 To oSettings.getCount() - 1
+		Set vItem() = oSettings.getByIndex(i)
+		If _GetPropertyValue(vItem, "Type", 1) <> 1 Then		'	Type = 1 indicates separator
+			iItemsCount = iItemsCount + 1
+			If Not IsMissing(pvIndex) Then
+				If pvIndex = iItemsCount - 1 Then
+					Set oObject = New CommandBarControl
+					With oObject
+						._ParentCommandBarName = _Name
+						._ParentCommandBar = oToolbar
+						._ParentBuiltin = ( _BarBuiltin = 1 )
+						._Element = vItem()
+						._InternalIndex = i
+						._Index = iItemsCount					'	Indexes start at 1
+						._BeginGroup = bSeparator
+					End With
+				End If
+				bSeparator = False
+			End If
+		Else
+			bSeparator = True
+		End If
+	Next i
+
+	If IsNull(oObject) Then
+		Select Case True
+			Case IsMissing(pvIndex)
+				Set oObject = New Collect
+				oObject._CollType = COLLCOMMANDBARCONTROLS
+				oObject._ParentType = OBJCOMMANDBAR
+				oObject._Count = iItemsCount
+			Case Else		'	pvIndex is numeric
+				Goto Trace_IndexError
+		End Select
+	End If
+
+Exit_Function:
+	Set CommandBarControls = oObject
+	Set oObject = Nothing
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+Trace_IndexError:
+	TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
+	Goto Exit_Function
+Error_NotApplicable:
+	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+	Goto Exit_Function
+End Function	'	CommandBarControls		V1,3,0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
+'	Alias for CommandBarControls (VBA)
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "CommandBar.Controls"
+	Utils._SetCalledSub(cstThisSub)
+
+Dim oObject As Object
+
+	If IsMissing(pvIndex) Then Set oObject = CommandBarControls() Else Set oObject = CommandBarControls(pvIndex)
+
+Exit_Function:
+	Set Controls = oObject
+	Set oObject = Nothing
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+End Function	'	Controls		V1,3,0
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
 '	Return property value of psProperty property name
 
@@ -124,6 +234,26 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 	
 End Function	'	hasProperty
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Reset() As Boolean
+'	Reset a whole command bar to its initial values
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "CommandBar.Reset"
+	Utils._SetCalledSub(cstThisSub)
+
+	_Toolbar.reload()
+
+Exit_Function:
+	Reset = True
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	Reset = False
+	GoTo Exit_Function
+End Function	'	Reset	V1.3.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 REM --- PRIVATE FUNCTIONS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------

wizards/source/access2base/Dialog.xba

@@ -616,7 +616,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 'Execute
 Dim iArgNr As Integer
 
-	If Len(_A2B_.CalledSub) > 7 And Left(_A2B_.CalledSub, 7) = "Dialog." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "Dialog.") Then iArgNr = 1 Else iArgNr = 2
 	If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
 	Select Case UCase(psProperty)
 		Case UCase("Caption")

wizards/source/access2base/DoCmd.xba

@@ -1398,8 +1398,9 @@ Error_Sub:
 End Sub				'	RunApp		V0.8.5
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function RunCommand(Optional pvCommand As Variant) As Boolean
+Public Function RunCommand(Optional pvCommand As Variant, Optional pbReturnCommand As Boolean) As Variant
 '	Execute command via DispatchHelper
+'	pbReturnCommand = internal parameter to only return the exact command string (always absent if uno prefix present in pvCommand)
 
 	If _ErrorHandler() Then On Local Error Goto Exit_Function			'	Avoid any abort
 Const cstThisSub = "RunCommand"
@@ -1408,16 +1409,17 @@ Const cstThisSub = "RunCommand"
 Dim iVBACommand As Integer, sOOCommand As String, sDispatch As String
 	If IsMissing(pvCommand) Then Call _TraceArguments()
 	If Not ( Utils._CheckArgument(pvCommand, 1, Utils._AddNumeric(vbString)) ) Then Goto Exit_Function
+	If IsMissing(pbReturnCommand) Then pbReturnCommand = False
+	
+	RunCommand = True
 	
 Const cstUnoPrefix = ".uno:"
 	If VarType(pvCommand) = vbString Then
 		sOOCommand = pvCommand
 		iVBACommand = -1
-		If Len(sOOCommand) > Len(cstUnoPrefix) Then
-			If Left(sOOCommand, Len(cstUnoPrefix)) = cstUnoPrefix Then
-				Call _DispatchCommand(sOOCommand)
-				Goto Exit_Function
-			End If
+		If _IsLeft(sOOCommand, cstUnoPrefix) Then
+			Call _DispatchCommand(sOOCommand)
+			Goto Exit_Function
 		End If
 	Else
 		sOOCommand = ""
@@ -1604,10 +1606,9 @@ Const cstUnoPrefix = ".uno:"
 			sDispatch = pvCommand
 	End Select
 	
-	Call _DispatchCommand(cstUnoPrefix & sDispatch)
+	If pbReturnCommand Then RunCommand = cstUnoPrefix & sDispatch Else Call _DispatchCommand(cstUnoPrefix & sDispatch)
 
 Exit_Function:
-	RunCommand = True
 	Utils._ResetCalledSub(cstThisSub)
 	Exit Function
 Error_Function:

wizards/source/access2base/Form.xba

@@ -787,7 +787,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 Dim iArgNr As Integer
 Dim oDatabase As Object
 
-	If Len(_A2B_.CalledSub) > 5 And Left(_A2B_.CalledSub, 5) = "Form." Then iArgNr = 1 Else iArgNr = 2
+	If _Isleft(_A2B_.CalledSub, "Form.") Then iArgNr = 1 Else iArgNr = 2
 	If Not IsLoaded Then Goto Trace_Error_Form
 	Select Case UCase(psProperty)
 		Case UCase("AllowAdditions")

wizards/source/access2base/L10N.xba

@@ -88,6 +88,7 @@ Dim sLocal As String
 				Case "FIELD"						:	sLocal = "Field"
 				Case "TEMPVAR"						:	sLocal = "Temporary variable"
 				Case "COMAMANDBAR"					:	sLocal = "Command bar"
+				Case "COMMANDBARCONTROL"			:	sLocal = "Command bar control"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "ERR#"							:	sLocal = "Error #"
 				Case "ERROCCUR"						:	sLocal = "occurred"
@@ -194,8 +195,9 @@ Dim sLocal As String
 				Case "REPORT"						:	sLocal = "Rapport"
 				Case "RECORDSET"					:	sLocal = "Recordset"
 				Case "FIELD"						:	sLocal = "Champ"
-				Case "COMAMANDBAR"					:	sLocal = "Barre de commande"
 				Case "TEMPVAR"						:	sLocal = "Variable temporaire"
+				Case "COMAMANDBAR"					:	sLocal = "Barre de commande"
+				Case "COMMANDBARCONTROL"			:	sLocal = "Elément de barre de commande"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "ERR#"							:	sLocal = "L'erreur #"
 				Case "ERROCCUR"						:	sLocal = "s'est produite"

wizards/source/access2base/OptionGroup.xba

@@ -124,7 +124,7 @@ Dim ocControl As Variant, iArgNr As Integer, i As Integer
 		Goto Exit_Function
 	End If
 	
-	If Len(_A2B_.CalledSub) > 12 And Left(_A2B_.CalledSub, 12) = "OptionGroup." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
 	If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
 	If pvIndex < 0 Or pvIndex > _Count - 1 Then Goto Trace_Error_Index
 				
@@ -266,7 +266,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 'Execute
 Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
 
-	If Len(_A2B_.CalledSub) > 12 And Left(_A2B_.CalledSub, 12) = "OptionGroup." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
 	Select Case UCase(psProperty)
 		Case UCase("Value")
 			If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value

wizards/source/access2base/PropertiesGet.xba

@@ -37,6 +37,12 @@ Public Function getBackColor(Optional pvObject As Variant) As Variant
 	getBackColor = PropertiesGet._getProperty(pvObject, "BackColor")
 End Function		'	getBackColor
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function getBeginGroup(Optional pvObject As Variant) As Variant
+	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBeginGroup")
+	getBeginGroup = PropertiesGet._getProperty(pvObject, "BeginGroup")
+End Function		'	getBeginGroup
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function getBOF(Optional pvObject As Variant) As Variant
 	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBOF")
@@ -67,6 +73,12 @@ Public Function getBorderStyle(Optional pvObject As Variant) As Variant
 	getBorderStyle = PropertiesGet._getProperty(pvObject, "BorderStyle")
 End Function		'	getBorderStyle
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function getBuiltin(Optional pvObject As Variant) As Boolean
+	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBuiltin")
+	getBuiltin = PropertiesGet._getProperty(pvObject, "Builtin")
+End Function		'	getBuiltin
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function getButtonLeft(Optional pvObject As Variant) As Boolean
 	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getButtonLeft")
@@ -674,6 +686,12 @@ Public Function getTextAlign(Optional pvObject As Variant) As Variant
 	getTextAlign = PropertiesGet._getProperty(pvObject, "TextAlign")
 End Function		'	getTextAlign
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function getTooltipText(Optional pvObject As Variant) As Variant
+	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTooltipText")
+	getTooltipText = PropertiesGet._getProperty(pvObject, "TooltipText")
+End Function		'	getTooltipText
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function getTripleState(Optional pvObject As Variant) As Variant
 	If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTripleState")
@@ -762,6 +780,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 		Case UCase("BackColor")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			_getProperty = pvItem.BackColor
+		Case UCase("BeginGroup")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			_getProperty = pvItem.BeginGroup
 		Case UCase("BOF")
 			If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function
 			_getProperty = pvItem.BOF
@@ -777,6 +798,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 		Case UCase("BorderStyle")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			_getProperty = pvItem.BorderStyle
+		Case UCase("Builtin")
+			If Not Utils._CheckArgument(pvItem, 1, Array(OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
+			_getProperty = pvItem.Builtin
 		Case UCase("ButtonLeft")
 			If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function
 			_getProperty = pvItem.ButtonLeft
@@ -790,7 +814,7 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			_getProperty = pvItem.Cancel
 		Case UCase("Caption")
-			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
+			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
 			_getProperty = pvItem.Caption
 		Case UCase("ClickCount")
 			If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function
@@ -885,6 +909,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 		Case UCase("Height")
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
 			_getProperty = pvItem.Height
+		Case UCase("Index")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			_getProperty = pvItem.Index
 		Case UCase("IsLoaded")
 			If Not Utils._CheckArgument(pvItem, 1, OBJFORM) Then Goto Exit_Function
 			_getProperty = pvItem.IsLoaded
@@ -930,14 +957,18 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 			_getProperty = pvItem.MultiSelect
 		Case UCase("Name")
 			If Not Utils._CheckArgument(pvItem, 1, _
-				Array(OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJDIALOG, OBJTABLEDEF, OBJRECORDSET, OBJFIELD, OBJTEMPVAR) _
+				Array(OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJDIALOG, OBJTABLEDEF, OBJRECORDSET, OBJFIELD, OBJTEMPVAR, OBJCOMMANDBAR) _
 				) Then Goto Exit_Function
 			_getProperty = pvItem.Name
 		Case UCase("ObjectType")
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJDATABASE, OBJCOLLECTION, OBJFORM, OBJDIALOG, OBJSUBFORM, OBJCONTROL _
-				, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY, OBJRECORDSET, OBJTABLEDEF, OBJFIELD, OBJTEMPVAR) _
+				, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY, OBJRECORDSET, OBJTABLEDEF, OBJFIELD, OBJTEMPVAR _
+				, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL) _
 				) Then Goto Exit_Function
 			_getProperty = pvItem.ObjectType
+		Case UCase("OnAction")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			_getProperty = pvItem.OnAction
 		Case UCase("OpenArgs")
 			If Not Utils._CheckArgument(pvItem, 1, OBJFORM) Then Goto Exit_Function
 			_getProperty = pvItem.OpenArgs
@@ -954,7 +985,7 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
 			_getProperty = pvItem.Page
 		Case UCase("Parent")
-			If Not Utils._CheckArgument(pvItem, 1, Array(OBJSUBFORM, OBJCONTROL)) Then Goto Exit_Function
+			If Not Utils._CheckArgument(pvItem, 1, Array(OBJSUBFORM, OBJCONTROL, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
 			_getProperty = pvItem.Parent
 		Case UCase("Recommendation")
 			If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function
@@ -1022,6 +1053,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 		Case UCase("TextAlign")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			_getProperty = pvItem.TextAlign
+		Case UCase("TooltipText")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			_getProperty = pvItem.TooltipText
 		Case UCase("TripleState")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			_getProperty = pvItem.TripleState
@@ -1032,7 +1066,7 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function
 			_getProperty = pvItem.Value
 		Case UCase("Visible")
-			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
+			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
 			_getProperty = pvItem.Visible
 		Case UCase("Width")
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
@@ -1167,7 +1201,8 @@ Dim i As Integer, j As Integer, iCount As Integer
 	Set vProperties = Nothing
 	Select Case pvObject._Type
 		Case OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJEVENT, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
-				, OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET, OBJTEMPVAR
+				, OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET, OBJTEMPVAR _
+				, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL
 			vPropertiesList = pvObject._PropertiesList()
 		Case Else
 	End Select

wizards/source/access2base/PropertiesSet.xba

@@ -187,6 +187,12 @@ Public Function setMultiSelect(Optional pvObject As Variant, ByVal Optional pvVa
 	setMultiSelect = PropertiesSet._setProperty(pvObject, "MultiSelect", pvValue)
 End Function		'	setMultiSelect
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function setOnAction(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
+	If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOnAction")
+	setOnAction = PropertiesSet._setProperty(pvObject, "OnAction", pvValue)
+End Function		'	setOnAction
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function setOptionValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
 	If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOptionValue")
@@ -309,6 +315,12 @@ Public Function setTextAlign(Optional pvObject As Variant, ByVal Optional pvValu
 	setTextAlign = PropertiesSet._setProperty(pvObject, "TextAlign", pvValue)
 End Function		'	setTextAlign
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function setTooltipText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
+	If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTooltipText")
+	setTooltipText = PropertiesSet._setProperty(pvObject, "TooltipText", pvValue)
+End Function		'	setTooltipText
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function setTripleState(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
 	If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTripleState")
@@ -477,6 +489,9 @@ Dim ocButton As Variant, iRadioIndex As Integer
 		Case UCase("MultiSelect")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			pvItem.MultiSelect = pvValue
+		Case UCase("OnAction")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			pvItem.OnAction = pvValue
 		Case UCase("OptionValue")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			pvItem.OptionValue = pvValue
@@ -528,6 +543,9 @@ Dim ocButton As Variant, iRadioIndex As Integer
 		Case UCase("TextAlign")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			pvItem.TextAlign = pvValue
+		Case UCase("TooltipText")
+			If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
+			pvItem.TooltipText = pvValue
 		Case UCase("TripleState")
 			If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
 			pvItem.TripleState = pvValue
@@ -535,7 +553,7 @@ Dim ocButton As Variant, iRadioIndex As Integer
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function
 			pvItem.Value = pvValue
 		Case UCase("Visible")
-			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
+			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
 			pvItem.Visible = pvValue
 		Case UCase("Width")
 			If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function

wizards/source/access2base/Recordset.xba

@@ -1072,7 +1072,7 @@ Dim cstThisSub As String
 Dim iArgNr As Integer
 Dim oObject As Object
 
-	If Len(_A2B_.CalledSub) > 10 And Left(_A2B_.CalledSub, 10) = "Recordset." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "Recordset.") Then iArgNr = 1 Else iArgNr = 2
 	Select Case UCase(psProperty)
 		Case UCase("AbsolutePosition")
 			If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value

wizards/source/access2base/SubForm.xba

@@ -501,7 +501,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 'Execute
 Dim iArgNr As Integer
 
-	If Len(_A2B_.CalledSub) > 8 And Left(_A2B_.CalledSub, 5) = "SubForm." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "SubForm.") Then iArgNr = 1 Else iArgNr = 2
 	Select Case UCase(psProperty)
 		Case UCase("AllowAdditions")
 			If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value

wizards/source/access2base/TempVar.xba

@@ -163,7 +163,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 'Execute
 Dim iArgNr As Integer
 
-	If Len(_A2B_.CalledSub) > 8 And Left(_A2B_.CalledSub, 8) = "TempVar." Then iArgNr = 1 Else iArgNr = 2
+	If _IsLeft(_A2B_.CalledSub, "TempVar.") Then iArgNr = 1 Else iArgNr = 2
 	Select Case UCase(psProperty)
 		Case UCase("Value")
 			_Value = pvValue

wizards/source/access2base/Utils.xba

@@ -425,6 +425,19 @@ Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object
 
 End Function	'	InspectPropertyType	V1.0.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _IsLeft(psString As String, psLeft As String) As Boolean
+'	Return True if left part of psString = psLeft
+
+Dim iLength As Integer
+	iLength = Len(psLeft)
+	_IsLeft = False
+	If Len(psString) >= iLength Then
+		If Left(psString, iLength) = psLeft Then _IsLeft = True
+	End If
+
+End Function
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
 '	Test pvObject:	does it exist ?
@@ -496,6 +509,10 @@ Dim oDoc As Object, oForms As Variant
 				End If
 			Case OBJOPTIONGROUP
 				bPseudoExists = ( .Count > 0 )
+			Case OBJCOMMANDBAR
+				bPseudoExists = ( Not IsNull(._Window) )
+			Case OBJCOMMANDBARCONTROL
+				bPseudoExists = ( Not IsNull(._ParentCommandBar) )
 			Case OBJEVENT
 				bPseudoExists = ( Not IsNull(._EventSource) )
 			Case OBJPROPERTY
@@ -569,7 +586,7 @@ Dim vSubStrings() As Variant, i As Integer, iLen As Integer
 End Function	'	PCase		V0.9.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Sub _ResetCalledSub(ByVal psSub As String) As String
+Public Sub _ResetCalledSub(ByVal psSub As String)
 '	Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
 '	Used to trace routine in/outs and to clarify error messages
 		If IsEmpty(_A2B_) Then Call Application._RootInit()	'	Only is Utils module recompiled
@@ -578,7 +595,30 @@ Public Sub _ResetCalledSub(ByVal psSub As String) As String
 End Sub			'	ResetCalledSub
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Sub _SetCalledSub(ByVal psSub As String) As String
+Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
+'	Execute a given script with pvArgs() array of arguments
+
+	On Local Error Goto Error_Function
+	_RunScript = False
+	If IsNull(ThisComponent) Then Goto Exit_Function
+
+Dim oSCriptProvider As Object, oScript As Object, vResult As Variant
+
+	Set oScriptProvider = ThisComponent.ScriptProvider()
+	Set oScript = oScriptProvider.getScript(psScript)
+	If IsMissing(pvArgs()) Then pvArgs() = Array()
+	vResult = oScript.Invoke(pvArgs(), Array(), Array())
+	_RunScript = True
+
+Exit_Function:
+	Exit Function
+Error_Function:
+	_RunScript = False
+	Goto Exit_Function
+End Function
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub _SetCalledSub(ByVal psSub As String)
 '	Called in top of each public function.
 '	Used to trace routine in/outs and to clarify error messages
 		If IsEmpty(_A2B_) Then Call Application._RootInit()	'	First use of Access2Base in current LibO/AOO session

wizards/source/access2base/acConstants.xba

@@ -357,4 +357,8 @@ Global Const msoBarTypeMenuBar = 1		'	Menu bar
 Global Const msoBarTypePopup = 2		'	Shortcut menu
 Global Const msoBarTypeStatusBar = 11	'	Status bar
 Global Const msoBarTypeFloater = 12		'	Floating window
+
+Global Const msoControlButton = 1		'	Command button
+Global Const msoControlPopup = 10		'	Popup, submenu
+
 </script:module>
\ No newline at end of file

wizards/source/access2base/script.xlb

@@ -29,4 +29,5 @@
  <library:element library:name="Root_"/>
  <library:element library:name="UtilProperty"/>
  <library:element library:name="CommandBar"/>
+ <library:element library:name="CommandBarControl"/>
 </library:library>
\ No newline at end of file