Kaydet (Commit) c36353d8 authored tarafından Jean-Pierre Ledure's avatar Jean-Pierre Ledure

Access2Base - New CommandBarControl class

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

Change-Id: Ice830009f9eabc199727c7d4b54ebf524b026d40
üst 4eed16d8
......@@ -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 \
......
......@@ -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
......
......@@ -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
......
......@@ -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 -----------------------------------------------------------------------------------------------------------------------
......
<?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 &apos; Must be COMMANDBARCONTROL
Private _InternalIndex As Integer &apos; Index in toolbar including separators
Private _Index As Integer &apos; Index in collection, starting at 1 !!
Private _ControlType As Integer &apos; 1 of the msoControl* constants
Private _ParentCommandBarName As String
Private _ParentCommandBar As Object &apos; 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 = &quot;&quot;
Set _ParentCommandBar = Nothing
_ParentBuiltin = False
_Element = Array()
_BeginGroup = False
End Sub &apos; Constructor
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
On Local Error Resume Next
Call Class_Initialize()
End Sub &apos; Destructor
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
Call Class_Terminate()
End Sub &apos; Explicit destructor
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Property Get BeginGroup() As Boolean
BeginGroup = _PropertyGet(&quot;BeginGroup&quot;)
End Property &apos; BeginGroup (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Builtin() As Boolean
Builtin = _PropertyGet(&quot;Builtin&quot;)
End Property &apos; Builtin (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Caption() As Variant
Caption = _PropertyGet(&quot;Caption&quot;)
End Property &apos; Caption (get)
Property Let Caption(ByVal pvValue As Variant)
Call _PropertySet(&quot;Caption&quot;, pvValue)
End Property &apos; Caption (set)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Index() As Integer
Index = _PropertyGet(&quot;Index&quot;)
End Property &apos; Index (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
ObjectType = _PropertyGet(&quot;ObjectType&quot;)
End Property &apos; ObjectType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get OnAction() As Variant
OnAction = _PropertyGet(&quot;OnAction&quot;)
End Property &apos; OnAction (get)
Property Let OnAction(ByVal pvValue As Variant)
Call _PropertySet(&quot;OnAction&quot;, pvValue)
End Property &apos; OnAction (set)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Parent() As Object
Parent = _PropertyGet(&quot;Parent&quot;)
End Property &apos; Parent (get)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos; Return
&apos; a Collection object if pvIndex absent
&apos; 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 &apos; Properties
REM -----------------------------------------------------------------------------------------------------------------------
Property Get TooltipText() As Variant
TooltipText = _PropertyGet(&quot;TooltipText&quot;)
End Property &apos; TooltipText (get)
Property Let TooltipText(ByVal pvValue As Variant)
Call _PropertySet(&quot;TooltipText&quot;, pvValue)
End Property &apos; TooltipText (set)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function pType() As Integer
pType = _PropertyGet(&quot;Type&quot;)
End Function &apos; Type (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Visible() As Variant
Visible = _PropertyGet(&quot;Visible&quot;)
End Property &apos; Visible (get)
Property Let Visible(ByVal pvValue As Variant)
Call _PropertySet(&quot;Visible&quot;, pvValue)
End Property &apos; Visible (set)
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Execute()
&apos; Execute the command stored in a toolbar button
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = &quot;CommandBarControl.Execute&quot;
Utils._SetCalledSub(cstThisSub)
Dim sExecute As String
Execute = False
sExecute = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
Select Case True
Case sExecute = &quot;&quot;
Case _IsLeft(sExecute, &quot;.uno:&quot;)
Execute = DoCmd.RunCommand(sExecute)
Case _IsLeft(sExecute, &quot;vnd.sun.star.script:&quot;)
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 &apos; Execute V1.3.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
&apos; Return property value of psProperty property name
Utils._SetCalledSub(&quot;CommandBarControl.getProperty&quot;)
If IsMissing(pvProperty) Then Call _TraceArguments()
getProperty = _PropertyGet(pvProperty)
Utils._ResetCalledSub(&quot;CommandBar.getProperty&quot;)
End Function &apos; getProperty
REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
&apos; 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 &apos; hasProperty
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
_PropertiesList = Array(&quot;BeginGroup&quot;, &quot;Builtin&quot;, &quot;Caption&quot;, &quot;Index&quot; _
, &quot;ObjectType&quot;, &quot;OnAction&quot;, &quot;Parent&quot; _
, &quot;TooltipText&quot;, &quot;Type&quot;, &quot;Visible&quot; _
)
End Function &apos; _PropertiesList
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
&apos; Return property value of the psProperty property name
If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
cstThisSub = &quot;CommandBarControl.get&quot; &amp; psProperty
Utils._SetCalledSub(cstThisSub)
_PropertyGet = Null
Dim oLayout As Object, iElementIndex As Integer
Dim sValue As String
Const cstUnoPrefix = &quot;.uno:&quot;
Select Case UCase(psProperty)
Case UCase(&quot;BeginGroup&quot;)
_PropertyGet = _BeginGroup
Case UCase(&quot;Builtin&quot;)
sValue = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
_PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) )
Case UCase(&quot;Caption&quot;)
_PropertyGet = _GetPropertyValue(_Element, &quot;Label&quot;, &quot;&quot;)
Case UCase(&quot;Index&quot;)
_PropertyGet = _Index
Case UCase(&quot;ObjectType&quot;)
_PropertyGet = _Type
Case UCase(&quot;OnAction&quot;)
_PropertyGet = _GetPropertyValue(_Element, &quot;CommandURL&quot;, &quot;&quot;)
Case UCase(&quot;Parent&quot;)
Set _PropertyGet = Application.CommandBars(_ParentCommandBarName)
Case UCase(&quot;TooltipText&quot;)
sValue = _GetPropertyValue(_Element, &quot;Tooltip&quot;, &quot;&quot;)
If sValue &lt;&gt; &quot;&quot; Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, &quot;Label&quot;, &quot;&quot;)
Case UCase(&quot;Type&quot;)
_PropertyGet = msoControlButton
Case UCase(&quot;Visible&quot;)
_PropertyGet = _GetPropertyValue(_Element, &quot;IsVisible&quot;, &quot;&quot;)
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 &apos; _PropertyGet
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
&apos; Return True if property setting OK
If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
cstThisSub = &quot;CommandBarControl.set&quot; &amp; psProperty
Utils._SetCalledSub(cstThisSub)
_PropertySet = True
Dim iArgNr As Integer
Dim oSettings As Object, sValue As String
Select Case UCase(_A2B_.CalledSub)
Case UCase(&quot;setProperty&quot;) : iArgNr = 3
Case UCase(&quot;CommandBar.setProperty&quot;) : iArgNr = 2
Case UCase(cstThisSub) : iArgNr = 1
End Select
If Not hasProperty(psProperty) Then Goto Trace_Error
If _ParentBuiltin Then Goto Trace_Error &apos; Modifications of individual controls forbidden for builtin toolbars (design choice)
Const cstUnoPrefix = &quot;.uno:&quot;
Const cstScript = &quot;vnd.sun.star.script:&quot;
Set oSettings = _ParentCommandBar.getSettings(True)
Select Case UCase(psProperty)
Case UCase(&quot;OnAction&quot;)
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 &apos; Numeric
sValue = DoCmd.RunCommand(pvValue, True)
End Select
_SetPropertyValue(_Element, &quot;CommandURL&quot;, sValue)
Case UCase(&quot;TooltipText&quot;)
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
_SetPropertyValue(_Element, &quot;Tooltip&quot;, pvValue)
Case UCase(&quot;Visible&quot;)
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
_SetPropertyValue(_Element, &quot;IsVisible&quot;, 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 &apos; _PropertySet
</script:module>
\ No newline at end of file
......@@ -616,7 +616,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
&apos;Execute
Dim iArgNr As Integer
If Len(_A2B_.CalledSub) &gt; 7 And Left(_A2B_.CalledSub, 7) = &quot;Dialog.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;Dialog.&quot;) Then iArgNr = 1 Else iArgNr = 2
If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
Select Case UCase(psProperty)
Case UCase(&quot;Caption&quot;)
......
......@@ -1398,8 +1398,9 @@ Error_Sub:
End Sub &apos; 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
&apos; Execute command via DispatchHelper
&apos; 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 &apos; Avoid any abort
Const cstThisSub = &quot;RunCommand&quot;
......@@ -1408,16 +1409,17 @@ Const cstThisSub = &quot;RunCommand&quot;
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 = &quot;.uno:&quot;
If VarType(pvCommand) = vbString Then
sOOCommand = pvCommand
iVBACommand = -1
If Len(sOOCommand) &gt; 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 = &quot;&quot;
......@@ -1604,10 +1606,9 @@ Const cstUnoPrefix = &quot;.uno:&quot;
sDispatch = pvCommand
End Select
Call _DispatchCommand(cstUnoPrefix &amp; sDispatch)
If pbReturnCommand Then RunCommand = cstUnoPrefix &amp; sDispatch Else Call _DispatchCommand(cstUnoPrefix &amp; sDispatch)
Exit_Function:
RunCommand = True
Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_Function:
......
......@@ -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) &gt; 5 And Left(_A2B_.CalledSub, 5) = &quot;Form.&quot; Then iArgNr = 1 Else iArgNr = 2
If _Isleft(_A2B_.CalledSub, &quot;Form.&quot;) Then iArgNr = 1 Else iArgNr = 2
If Not IsLoaded Then Goto Trace_Error_Form
Select Case UCase(psProperty)
Case UCase(&quot;AllowAdditions&quot;)
......
......@@ -88,6 +88,7 @@ Dim sLocal As String
Case &quot;FIELD&quot; : sLocal = &quot;Field&quot;
Case &quot;TEMPVAR&quot; : sLocal = &quot;Temporary variable&quot;
Case &quot;COMAMANDBAR&quot; : sLocal = &quot;Command bar&quot;
Case &quot;COMMANDBARCONTROL&quot; : sLocal = &quot;Command bar control&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;Error #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;occurred&quot;
......@@ -194,8 +195,9 @@ Dim sLocal As String
Case &quot;REPORT&quot; : sLocal = &quot;Rapport&quot;
Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot;
Case &quot;FIELD&quot; : sLocal = &quot;Champ&quot;
Case &quot;COMAMANDBAR&quot; : sLocal = &quot;Barre de commande&quot;
Case &quot;TEMPVAR&quot; : sLocal = &quot;Variable temporaire&quot;
Case &quot;COMAMANDBAR&quot; : sLocal = &quot;Barre de commande&quot;
Case &quot;COMMANDBARCONTROL&quot; : sLocal = &quot;Elément de barre de commande&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;L&apos;erreur #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;s&apos;est produite&quot;
......
......@@ -124,7 +124,7 @@ Dim ocControl As Variant, iArgNr As Integer, i As Integer
Goto Exit_Function
End If
If Len(_A2B_.CalledSub) &gt; 12 And Left(_A2B_.CalledSub, 12) = &quot;OptionGroup.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;OptionGroup.&quot;) Then iArgNr = 1 Else iArgNr = 2
If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
If pvIndex &lt; 0 Or pvIndex &gt; _Count - 1 Then Goto Trace_Error_Index
......@@ -266,7 +266,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
&apos;Execute
Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
If Len(_A2B_.CalledSub) &gt; 12 And Left(_A2B_.CalledSub, 12) = &quot;OptionGroup.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;OptionGroup.&quot;) Then iArgNr = 1 Else iArgNr = 2
Select Case UCase(psProperty)
Case UCase(&quot;Value&quot;)
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
......
......@@ -37,6 +37,12 @@ Public Function getBackColor(Optional pvObject As Variant) As Variant
getBackColor = PropertiesGet._getProperty(pvObject, &quot;BackColor&quot;)
End Function &apos; getBackColor
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getBeginGroup(Optional pvObject As Variant) As Variant
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getBeginGroup&quot;)
getBeginGroup = PropertiesGet._getProperty(pvObject, &quot;BeginGroup&quot;)
End Function &apos; getBeginGroup
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getBOF(Optional pvObject As Variant) As Variant
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getBOF&quot;)
......@@ -67,6 +73,12 @@ Public Function getBorderStyle(Optional pvObject As Variant) As Variant
getBorderStyle = PropertiesGet._getProperty(pvObject, &quot;BorderStyle&quot;)
End Function &apos; getBorderStyle
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getBuiltin(Optional pvObject As Variant) As Boolean
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getBuiltin&quot;)
getBuiltin = PropertiesGet._getProperty(pvObject, &quot;Builtin&quot;)
End Function &apos; getBuiltin
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getButtonLeft(Optional pvObject As Variant) As Boolean
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getButtonLeft&quot;)
......@@ -674,6 +686,12 @@ Public Function getTextAlign(Optional pvObject As Variant) As Variant
getTextAlign = PropertiesGet._getProperty(pvObject, &quot;TextAlign&quot;)
End Function &apos; getTextAlign
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getTooltipText(Optional pvObject As Variant) As Variant
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getTooltipText&quot;)
getTooltipText = PropertiesGet._getProperty(pvObject, &quot;TooltipText&quot;)
End Function &apos; getTooltipText
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getTripleState(Optional pvObject As Variant) As Variant
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments(&quot;getTripleState&quot;)
......@@ -762,6 +780,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
Case UCase(&quot;BackColor&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.BackColor
Case UCase(&quot;BeginGroup&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
_getProperty = pvItem.BeginGroup
Case UCase(&quot;BOF&quot;)
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(&quot;BorderStyle&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.BorderStyle
Case UCase(&quot;Builtin&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
_getProperty = pvItem.Builtin
Case UCase(&quot;ButtonLeft&quot;)
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(&quot;Caption&quot;)
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(&quot;ClickCount&quot;)
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(&quot;Height&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
_getProperty = pvItem.Height
Case UCase(&quot;Index&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
_getProperty = pvItem.Index
Case UCase(&quot;IsLoaded&quot;)
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(&quot;Name&quot;)
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(&quot;ObjectType&quot;)
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(&quot;OnAction&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
_getProperty = pvItem.OnAction
Case UCase(&quot;OpenArgs&quot;)
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(&quot;Parent&quot;)
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(&quot;Recommendation&quot;)
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(&quot;TextAlign&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.TextAlign
Case UCase(&quot;TooltipText&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
_getProperty = pvItem.TooltipText
Case UCase(&quot;TripleState&quot;)
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(&quot;Visible&quot;)
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(&quot;Width&quot;)
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
......
......@@ -187,6 +187,12 @@ Public Function setMultiSelect(Optional pvObject As Variant, ByVal Optional pvVa
setMultiSelect = PropertiesSet._setProperty(pvObject, &quot;MultiSelect&quot;, pvValue)
End Function &apos; 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(&quot;setOnAction&quot;)
setOnAction = PropertiesSet._setProperty(pvObject, &quot;OnAction&quot;, pvValue)
End Function &apos; 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(&quot;setOptionValue&quot;)
......@@ -309,6 +315,12 @@ Public Function setTextAlign(Optional pvObject As Variant, ByVal Optional pvValu
setTextAlign = PropertiesSet._setProperty(pvObject, &quot;TextAlign&quot;, pvValue)
End Function &apos; 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(&quot;setTooltipText&quot;)
setTooltipText = PropertiesSet._setProperty(pvObject, &quot;TooltipText&quot;, pvValue)
End Function &apos; 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(&quot;setTripleState&quot;)
......@@ -477,6 +489,9 @@ Dim ocButton As Variant, iRadioIndex As Integer
Case UCase(&quot;MultiSelect&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
pvItem.MultiSelect = pvValue
Case UCase(&quot;OnAction&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
pvItem.OnAction = pvValue
Case UCase(&quot;OptionValue&quot;)
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(&quot;TextAlign&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
pvItem.TextAlign = pvValue
Case UCase(&quot;TooltipText&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
pvItem.TooltipText = pvValue
Case UCase(&quot;TripleState&quot;)
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(&quot;Visible&quot;)
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(&quot;Width&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
......
......@@ -1072,7 +1072,7 @@ Dim cstThisSub As String
Dim iArgNr As Integer
Dim oObject As Object
If Len(_A2B_.CalledSub) &gt; 10 And Left(_A2B_.CalledSub, 10) = &quot;Recordset.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;Recordset.&quot;) Then iArgNr = 1 Else iArgNr = 2
Select Case UCase(psProperty)
Case UCase(&quot;AbsolutePosition&quot;)
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
......
......@@ -501,7 +501,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
&apos;Execute
Dim iArgNr As Integer
If Len(_A2B_.CalledSub) &gt; 8 And Left(_A2B_.CalledSub, 5) = &quot;SubForm.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;SubForm.&quot;) Then iArgNr = 1 Else iArgNr = 2
Select Case UCase(psProperty)
Case UCase(&quot;AllowAdditions&quot;)
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
......
......@@ -163,7 +163,7 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
&apos;Execute
Dim iArgNr As Integer
If Len(_A2B_.CalledSub) &gt; 8 And Left(_A2B_.CalledSub, 8) = &quot;TempVar.&quot; Then iArgNr = 1 Else iArgNr = 2
If _IsLeft(_A2B_.CalledSub, &quot;TempVar.&quot;) Then iArgNr = 1 Else iArgNr = 2
Select Case UCase(psProperty)
Case UCase(&quot;Value&quot;)
_Value = pvValue
......
......@@ -425,6 +425,19 @@ Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object
End Function &apos; InspectPropertyType V1.0.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsLeft(psString As String, psLeft As String) As Boolean
&apos; Return True if left part of psString = psLeft
Dim iLength As Integer
iLength = Len(psLeft)
_IsLeft = False
If Len(psString) &gt;= 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
&apos; Test pvObject: does it exist ?
......@@ -496,6 +509,10 @@ Dim oDoc As Object, oForms As Variant
End If
Case OBJOPTIONGROUP
bPseudoExists = ( .Count &gt; 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 &apos; PCase V0.9.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _ResetCalledSub(ByVal psSub As String) As String
Public Sub _ResetCalledSub(ByVal psSub As String)
&apos; Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
&apos; Used to trace routine in/outs and to clarify error messages
If IsEmpty(_A2B_) Then Call Application._RootInit() &apos; Only is Utils module recompiled
......@@ -578,7 +595,30 @@ Public Sub _ResetCalledSub(ByVal psSub As String) As String
End Sub &apos; ResetCalledSub
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _SetCalledSub(ByVal psSub As String) As String
Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
&apos; 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)
&apos; Called in top of each public function.
&apos; Used to trace routine in/outs and to clarify error messages
If IsEmpty(_A2B_) Then Call Application._RootInit() &apos; First use of Access2Base in current LibO/AOO session
......
......@@ -357,4 +357,8 @@ Global Const msoBarTypeMenuBar = 1 &apos; Menu bar
Global Const msoBarTypePopup = 2 &apos; Shortcut menu
Global Const msoBarTypeStatusBar = 11 &apos; Status bar
Global Const msoBarTypeFloater = 12 &apos; Floating window
Global Const msoControlButton = 1 &apos; Command button
Global Const msoControlPopup = 10 &apos; Popup, submenu
</script:module>
\ No newline at end of file
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment