diff options
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/Package_access2base.mk | 1 | ||||
| -rw-r--r-- | wizards/source/access2base/Application.xba | 64 | ||||
| -rw-r--r-- | wizards/source/access2base/Collect.xba | 9 | ||||
| -rw-r--r-- | wizards/source/access2base/CommandBar.xba | 134 | ||||
| -rw-r--r-- | wizards/source/access2base/CommandBarControl.xba | 332 | ||||
| -rw-r--r-- | wizards/source/access2base/Dialog.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/DoCmd.xba | 17 | ||||
| -rw-r--r-- | wizards/source/access2base/Form.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/L10N.xba | 4 | ||||
| -rw-r--r-- | wizards/source/access2base/OptionGroup.xba | 4 | ||||
| -rw-r--r-- | wizards/source/access2base/PropertiesGet.xba | 47 | ||||
| -rw-r--r-- | wizards/source/access2base/PropertiesSet.xba | 20 | ||||
| -rw-r--r-- | wizards/source/access2base/Recordset.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/SubForm.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/TempVar.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/Utils.xba | 44 | ||||
| -rw-r--r-- | wizards/source/access2base/acConstants.xba | 4 | ||||
| -rw-r--r-- | wizards/source/access2base/script.xlb | 1 |
18 files changed, 631 insertions, 60 deletions
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk index 522ca0371cdc..3a60e10f3479 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 304d6db12bba..c542e225d901 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 9039584b3300..cafda777c67e 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 c8510a9ff89b..95e27cf0a421 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 000000000000..e47ebe835d69 --- /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 01f19733892f..9d633cda14cb 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 cb40f2288014..a93973d476ea 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 6b7a69a90c77..bf0ab31d87f0 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 691be2a1ee11..4034b0a0f3a8 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 1fe523034419..a1177aec4399 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 4b3c4552669a..a0c702f1853e 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 b88a5d2ca8b1..cb480686842e 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 4a9c83354adb..d97a0d14a61a 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 a28f251f5901..98af11131c2f 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 f3230ed23949..2d7ed2b60a51 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 12f1eacfece7..256ff853231b 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 f0d1e9527540..7c456ca58b60 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 c707c5585d15..67000bc90bfa 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 |