wizards/Package_access2base.mk | 1
wizards/source/access2base/Application.xba | 64 ++--
wizards/source/access2base/Collect.xba | 9
wizards/source/access2base/CommandBar.xba | 134 +++++++++
wizards/source/access2base/CommandBarControl.xba | 332 +++++++++++++++++++++++
wizards/source/access2base/Dialog.xba | 2
wizards/source/access2base/DoCmd.xba | 17 -
wizards/source/access2base/Form.xba | 2
wizards/source/access2base/L10N.xba | 4
wizards/source/access2base/OptionGroup.xba | 4
wizards/source/access2base/PropertiesGet.xba | 47 ++-
wizards/source/access2base/PropertiesSet.xba | 20 +
wizards/source/access2base/Recordset.xba | 2
wizards/source/access2base/SubForm.xba | 2
wizards/source/access2base/TempVar.xba | 2
wizards/source/access2base/Utils.xba | 44 ++-
wizards/source/access2base/acConstants.xba | 4
wizards/source/access2base/script.xlb | 1
18 files changed, 631 insertions(+), 60 deletions(-)
New commits:
commit c36353d844f05e1de6a0c31cb6bf102887dc114a
Author: Jean-Pierre Ledure <j...@ledure.be>
Date: Sun Jan 4 15:25:25 2015 +0100
Access2Base - New CommandBarControl class
Main functionalities:
- show/hide toolbar elements
- modify tooltip
- get/set internal command
- execute internal command
Change-Id: Ice830009f9eabc199727c7d4b54ebf524b026d40
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk
index 522ca03..3a60e10 100644
--- a/wizards/Package_access2base.mk
+++ b/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 \
diff --git a/wizards/source/access2base/Application.xba
b/wizards/source/access2base/Application.xba
index 304d6db..c542e22 100644
--- a/wizards/source/access2base/Application.xba
+++ b/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
diff --git a/wizards/source/access2base/Collect.xba
b/wizards/source/access2base/Collect.xba
index 9039584..cafda77 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/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
diff --git a/wizards/source/access2base/CommandBar.xba
b/wizards/source/access2base/CommandBar.xba
index c8510a9..95e27cf 100644
--- a/wizards/source/access2base/CommandBar.xba
+++ b/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
@@ -125,6 +235,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
-----------------------------------------------------------------------------------------------------------------------
diff --git a/wizards/source/access2base/CommandBarControl.xba
b/wizards/source/access2base/CommandBarControl.xba
new file mode 100644
index 0000000..e47ebe8
--- /dev/null
+++ b/wizards/source/access2base/CommandBarControl.xba
@@ -0,0 +1,332 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN"
"module.dtd">
+<script:module xmlns:script="http://openoffice.org/2000/script";
script:name="CommandBarControl" script:language="StarBasic">REM
=======================================================================================================================
+REM === The Access2Base library is a
part of the LibreOffice project.
===
+REM === Full documentation is available
on http://www.access2base.com
===
+REM
=======================================================================================================================
+
+Option Compatible
+Option ClassModule
+
+Option Explicit
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS ROOT FIELDS
---
+REM
-----------------------------------------------------------------------------------------------------------------------
+
+Private _Type As String '
Must be COMMANDBARCONTROL
+Private _InternalIndex As Integer ' Index
in toolbar including separators
+Private _Index As Integer '
Index in collection, starting at 1 !!
+Private _ControlType As Integer ' 1 of
the msoControl* constants
+Private _ParentCommandBarName As String
+Private _ParentCommandBar As Object '
com.sun.star.ui.XUIElement
+Private _ParentBuiltin As Boolean
+Private _Element As Variant
+Private _BeginGroup As Boolean
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS
---
+REM
-----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+ _Type = OBJCOMMANDBARCONTROL
+ _Index = -1
+ _ParentCommandBarName = ""
+ Set _ParentCommandBar = Nothing
+ _ParentBuiltin = False
+ _Element = Array()
+ _BeginGroup = False
+End Sub ' Constructor
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ On Local Error Resume Next
+ Call Class_Initialize()
+End Sub ' Destructor
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Sub Dispose()
+ Call Class_Terminate()
+End Sub ' Explicit destructor
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES
---
+REM
-----------------------------------------------------------------------------------------------------------------------
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get BeginGroup() As Boolean
+ BeginGroup = _PropertyGet("BeginGroup")
+End Property ' BeginGroup (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get Builtin() As Boolean
+ Builtin = _PropertyGet("Builtin")
+End Property ' Builtin (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get Caption() As Variant
+ Caption = _PropertyGet("Caption")
+End Property ' Caption (get)
+
+Property Let Caption(ByVal pvValue As Variant)
+ Call _PropertySet("Caption", pvValue)
+End Property ' Caption (set)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get Index() As Integer
+ Index = _PropertyGet("Index")
+End Property ' Index (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get ObjectType() As String
+ ObjectType = _PropertyGet("ObjectType")
+End Property ' ObjectType (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get OnAction() As Variant
+ OnAction = _PropertyGet("OnAction")
+End Property ' OnAction (get)
+
+Property Let OnAction(ByVal pvValue As Variant)
+ Call _PropertySet("OnAction", pvValue)
+End Property ' OnAction (set)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get Parent() As Object
+ Parent = _PropertyGet("Parent")
+End Property ' Parent (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
+' Return
+' a Collection object if pvIndex absent
+' a Property object otherwise
+
+Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+ vPropertiesList = _PropertiesList()
+ sObject = Utils._PCase(_Type)
+ If IsMissing(pvIndex) Then
+ vProperty = PropertiesGet._Properties(sObject, _Name,
vPropertiesList)
+ Else
+ vProperty = PropertiesGet._Properties(sObject, _Name,
vPropertiesList, pvIndex)
+ vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
+ End If
+
+Exit_Function:
+ Set Properties = vProperty
+ Exit Function
+End Function ' Properties
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get TooltipText() As Variant
+ TooltipText = _PropertyGet("TooltipText")
+End Property ' TooltipText (get)
+
+Property Let TooltipText(ByVal pvValue As Variant)
+ Call _PropertySet("TooltipText", pvValue)
+End Property ' TooltipText (set)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function pType() As Integer
+ pType = _PropertyGet("Type")
+End Function ' Type (get)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Property Get Visible() As Variant
+ Visible = _PropertyGet("Visible")
+End Property ' Visible (get)
+
+Property Let Visible(ByVal pvValue As Variant)
+ Call _PropertySet("Visible", pvValue)
+End Property ' Visible (set)
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS
---
+REM
-----------------------------------------------------------------------------------------------------------------------
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function Execute()
+' Execute the command stored in a toolbar button
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "CommandBarControl.Execute"
+ Utils._SetCalledSub(cstThisSub)
+
+Dim sExecute As String
+ Execute = False
+ sExecute = _GetPropertyValue(_Element, "CommandURL",
"")
+
+ Select Case True
+ Case sExecute = ""
+ Case _IsLeft(sExecute, ".uno:")
+ Execute = DoCmd.RunCommand(sExecute)
+ Case _IsLeft(sExecute, "vnd.sun.star.script:")
+ Execute = Utils._RunScript(sExecute, Array(Nothing))
+ Case Else
+ End Select
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ Reset = False
+ GoTo Exit_Function
+End Function ' Execute V1.3.0
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
+' Return property value of psProperty property name
+
+ Utils._SetCalledSub("CommandBarControl.getProperty")
+ If IsMissing(pvProperty) Then Call _TraceArguments()
+ getProperty = _PropertyGet(pvProperty)
+ Utils._ResetCalledSub("CommandBar.getProperty")
+
+End Function ' getProperty
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
+' Return True if object has a valid property called pvProperty
(case-insensitive comparison !)
+
+ If IsMissing(pvProperty) Then hasProperty =
PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty =
PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
+ Exit Function
+
+End Function ' hasProperty
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS
---
+REM
-----------------------------------------------------------------------------------------------------------------------
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertiesList() As Variant
+ _PropertiesList = Array("BeginGroup", "Builtin",
"Caption", "Index" _
+ ,
"ObjectType", "OnAction", "Parent" _
+ ,
"TooltipText", "Type", "Visible" _
+ )
+End Function ' _PropertiesList
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertyGet(ByVal psProperty As String) As Variant
+' Return property value of the psProperty property name
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Dim cstThisSub As String
+ cstThisSub = "CommandBarControl.get" & psProperty
+ Utils._SetCalledSub(cstThisSub)
+ _PropertyGet = Null
+
+Dim oLayout As Object, iElementIndex As Integer
+Dim sValue As String
+Const cstUnoPrefix = ".uno:"
+
+ Select Case UCase(psProperty)
+ Case UCase("BeginGroup")
+ _PropertyGet = _BeginGroup
+ Case UCase("Builtin")
+ sValue = _GetPropertyValue(_Element,
"CommandURL", "")
+ _PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) )
+ Case UCase("Caption")
+ _PropertyGet = _GetPropertyValue(_Element,
"Label", "")
+ Case UCase("Index")
+ _PropertyGet = _Index
+ Case UCase("ObjectType")
+ _PropertyGet = _Type
+ Case UCase("OnAction")
+ _PropertyGet = _GetPropertyValue(_Element,
"CommandURL", "")
+ Case UCase("Parent")
+ Set _PropertyGet =
Application.CommandBars(_ParentCommandBarName)
+ Case UCase("TooltipText")
+ sValue = _GetPropertyValue(_Element,
"Tooltip", "")
+ If sValue <> "" Then
_PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element,
"Label", "")
+ Case UCase("Type")
+ _PropertyGet = msoControlButton
+ Case UCase("Visible")
+ _PropertyGet = _GetPropertyValue(_Element,
"IsVisible", "")
+ Case Else
+ Goto Trace_Error
+ End Select
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Trace_Error:
+ TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1,
psProperty)
+ _PropertyGet = Nothing
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
+ _PropertyGet = Nothing
+ GoTo Exit_Function
+End Function ' _PropertyGet
+
+REM
-----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As
Variant) As Boolean
+' Return True if property setting OK
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Dim cstThisSub As String
+ cstThisSub = "CommandBarControl.set" & psProperty
+ Utils._SetCalledSub(cstThisSub)
+ _PropertySet = True
+Dim iArgNr As Integer
+Dim oSettings As Object, sValue As String
+
+
+ Select Case UCase(_A2B_.CalledSub)
+ Case UCase("setProperty")
: iArgNr = 3
+ Case UCase("CommandBar.setProperty") : iArgNr
= 2
+ Case UCase(cstThisSub) :
iArgNr = 1
+ End Select
+
+ If Not hasProperty(psProperty) Then Goto Trace_Error
+ If _ParentBuiltin Then Goto Trace_Error ' Modifications
of individual controls forbidden for builtin toolbars (design choice)
+
+Const cstUnoPrefix = ".uno:"
+Const cstScript = "vnd.sun.star.script:"
+
+ Set oSettings = _ParentCommandBar.getSettings(True)
+ Select Case UCase(psProperty)
+ Case UCase("OnAction")
+ If Not Utils._CheckArgument(pvValue, iArgNr,
_AddNumeric(vbString), , False) Then Goto Trace_Error_Value
+ Select Case VarType(pvValue)
+ Case vbString
+ If _IsLeft(pvValue, cstUnoPrefix) Then
+ sValue = pvValue
+ ElseIf _IsLeft(pvValue, cstScript) Then
+ sValue = pvValue
+ Else
+ sValue =
DoCmd.RunCommand(pvValue, True)
+ End If
+ Case Else '
Numeric
+ sValue = DoCmd.RunCommand(pvValue, True)
+ End Select
+ _SetPropertyValue(_Element, "CommandURL",
sValue)
+ Case UCase("TooltipText")
+ If Not Utils._CheckArgument(pvValue, iArgNr, vbString,
, False) Then Goto Trace_Error_Value
+ _SetPropertyValue(_Element, "Tooltip",
pvValue)
+ Case UCase("Visible")
+ If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean,
, False) Then Goto Trace_Error_Value
+ _SetPropertyValue(_Element, "IsVisible",
pvValue)
+ Case Else
+ Goto Trace_Error
+ End Select
+ oSettings.replaceByIndex(_InternalIndex, _Element)
+ _ParentCommandBar.setSettings(oSettings)
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Trace_Error:
+ TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
+ _PropertySet = False
+ Goto Exit_Function
+Trace_Error_Value:
+ TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1,
Array(pvValue, psProperty))
+ _PropertySet = False
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ _PropertySet = False
+ GoTo Exit_Function
+End Function ' _PropertySet
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/Dialog.xba
b/wizards/source/access2base/Dialog.xba
index 01f1973..9d633cd 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/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")
diff --git a/wizards/source/access2base/DoCmd.xba
b/wizards/source/access2base/DoCmd.xba
index cb40f22..a93973d 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/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:
diff --git a/wizards/source/access2base/Form.xba
b/wizards/source/access2base/Form.xba
index 6b7a69a..bf0ab31 100644
--- a/wizards/source/access2base/Form.xba
+++ b/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")
diff --git a/wizards/source/access2base/L10N.xba
b/wizards/source/access2base/L10N.xba
index 691be2a..4034b0a 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/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"
diff --git a/wizards/source/access2base/OptionGroup.xba
b/wizards/source/access2base/OptionGroup.xba
index 1fe5230..a1177ae 100644
--- a/wizards/source/access2base/OptionGroup.xba
+++ b/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
diff --git a/wizards/source/access2base/PropertiesGet.xba
b/wizards/source/access2base/PropertiesGet.xba
index 4b3c455..a0c702f 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -38,6 +38,12 @@ Public Function getBackColor(Optional pvObject As Variant)
As Variant
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")
getBOF = PropertiesGet._getProperty(pvObject, "BOF")
@@ -68,6 +74,12 @@ Public Function getBorderStyle(Optional pvObject As Variant)
As Variant
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")
getButtonLeft = PropertiesGet._getProperty(pvObject,
"ButtonLeft")
@@ -675,6 +687,12 @@ Public Function getTextAlign(Optional pvObject As Variant)
As Variant
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")
getTripleState = PropertiesGet._getProperty(pvObject,
"TripleState")
@@ -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
diff --git a/wizards/source/access2base/PropertiesSet.xba
b/wizards/source/access2base/PropertiesSet.xba
index b88a5d2..cb48068 100644
--- a/wizards/source/access2base/PropertiesSet.xba
+++ b/wizards/source/access2base/PropertiesSet.xba
@@ -188,6 +188,12 @@ Public Function setMultiSelect(Optional pvObject As
Variant, ByVal Optional pvVa
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")
setOptionValue = PropertiesSet._setProperty(pvObject,
"OptionValue", pvValue)
@@ -310,6 +316,12 @@ Public Function setTextAlign(Optional pvObject As Variant,
ByVal Optional pvValu
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")
setTripleState = PropertiesSet._setProperty(pvObject,
"TripleState", pvValue)
@@ -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
diff --git a/wizards/source/access2base/Recordset.xba
b/wizards/source/access2base/Recordset.xba
index 4a9c833..d97a0d1 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/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
diff --git a/wizards/source/access2base/SubForm.xba
b/wizards/source/access2base/SubForm.xba
index a28f251..98af111 100644
--- a/wizards/source/access2base/SubForm.xba
+++ b/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
diff --git a/wizards/source/access2base/TempVar.xba
b/wizards/source/access2base/TempVar.xba
index f3230ed..2d7ed2b 100644
--- a/wizards/source/access2base/TempVar.xba
+++ b/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
diff --git a/wizards/source/access2base/Utils.xba
b/wizards/source/access2base/Utils.xba
index 12f1eac..256ff85 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -426,6 +426,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 ?
' is the _Type item = one of the proposed
pvTypes ?
@@ -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
diff --git a/wizards/source/access2base/acConstants.xba
b/wizards/source/access2base/acConstants.xba
index f0d1e95..7c456ca 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/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
diff --git a/wizards/source/access2base/script.xlb
b/wizards/source/access2base/script.xlb
index c707c55..67000bc 100644
--- a/wizards/source/access2base/script.xlb
+++ b/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
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
http://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
