diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2019-08-20 11:56:42 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2019-08-20 12:01:40 +0200 |
commit | fd2a8fc9651037263069aa5f0f97c205d8fc4a1c (patch) | |
tree | 41d370c402b7aaf46b9ab9f4331f0aac11c01ff9 /wizards | |
parent | 20c6d7f6e64efa7597fdd5712514a85264bb7215 (diff) |
Access2Base - Move getObject, getValue and setValue
Functions moved from module PropertiesGet to Application
No effect in Basic
Compliant with Python rules where module/class name is mandatory
Change-Id: I970825590cbce86a9178bd750ffdb23ce87ae282
Diffstat (limited to 'wizards')
-rw-r--r-- | wizards/source/access2base/Application.xba | 117 | ||||
-rw-r--r-- | wizards/source/access2base/PropertiesGet.xba | 99 | ||||
-rw-r--r-- | wizards/source/access2base/PropertiesSet.xba | 18 | ||||
-rw-r--r-- | wizards/source/access2base/Python.xba | 12 |
4 files changed, 123 insertions, 123 deletions
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba index b59ff96b2e30..f821cf270519 100644 --- a/wizards/source/access2base/Application.xba +++ b/wizards/source/access2base/Application.xba @@ -1071,6 +1071,105 @@ Error_Function: End Function ' Forms V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- +Public Function getObject(Optional pvShortcut As Variant) As Variant +' Return the object described by pvShortcut ignoring its final property +' Example: "Forms!myForm!myControl.myProperty" => Controls(Forms("myForm"), "myControl")) + +Const cstEXCLAMATION = "!" +Const cstDOT = "." + + If _ErrorHandler() Then On Local Error Goto Error_Function +Const cstThisSub = "getObject" + Utils._SetCalledSub(cstThisSub) + If IsMissing(pvShortcut) Then Call _TraceArguments() + If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function + +Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String +Dim sComponents() As String, sSubComponents() As String, sDialog As String +Dim oDoc As Object + Set vCurrentObject = Nothing + sComponents = Split(Trim(pvShortcut), cstEXCLAMATION) + If UBound(sComponents) = 0 Then Goto Trace_Error + If Not Utils._InList(UCase(sComponents(0)), Array("FORMS", "DIALOGS", "TEMPVARS")) Then Goto Trace_Error + If sComponents(1) = "0" Or Left(sComponents(1), 2) = "0." Then + Set oDoc = _A2B_.CurrentDocument() + If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error + End If + + sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT) + sComponents(UBound(sComponents)) = sSubComponents(0) ' Ignore final property, if any + + Set vCurrentObject = New Collect + Set vCurrentObject._This = vCurrentObject + Select Case UCase(sComponents(0)) + Case "FORMS" : vCurrentObject._CollType = COLLFORMS + Case "DIALOGS" : vCurrentObject._CollType = COLLALLDIALOGS + Case "TEMPVARS" : vCurrentObject._CollType = COLLTEMPVARS + End Select + For iCurrentIndex = 1 To UBound(sComponents) ' Start parsing ... + sSubComponents = Split(sComponents(iCurrentIndex), cstDOT) + sComponents(iCurrentIndex) = Utils._Trim(sSubComponents(0)) + Select Case UBound(sSubComponents) + Case 0 + sCurrentProperty = "" + Case 1 + sCurrentProperty = sSubComponents(1) + Case Else + Goto Trace_Error + End Select + Select Case vCurrentObject._Type + Case OBJCOLLECTION + Select Case vCurrentObject._CollType + Case COLLFORMS + vCurrentObject = Application.AllForms(sComponents(iCurrentIndex)) + Case COLLALLDIALOGS + sDialog = UCase(sComponents(iCurrentIndex)) + vCurrentObject = Application.AllDialogs(sDialog) + If Not vCurrentObject.IsLoaded Then Goto Trace_Error + Set vCurrentObject.UnoDialog = _A2B_.Dialogs.Item(sDialog) + Case COLLTEMPVARS + If UBound(sComponents) > 1 Then Goto Trace_Error + vCurrentObject = Application.TempVars(sComponents(1)) + 'Case Else + End Select + Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG + vCurrentObject = vCurrentObject.Controls(sComponents(iCurrentIndex)) + End Select + If sCurrentProperty <> "" Then vCurrentObject = vCurrentObject.getProperty(sCurrentProperty) + Next iCurrentIndex + + Set getObject = vCurrentObject + +Exit_Function: + Utils._ResetCalledSub(cstThisSub) + Exit Function +Trace_Error: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut)) + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, cstThisSub, Erl) + GoTo Exit_Function +End Function ' getObject V0.9.5 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function getValue(Optional pvObject As Variant) As Variant +' getValue also interprets shortcut strings !! +Dim vItem As Variant, sProperty As String + If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getValue") + If VarType(pvObject) = vbString Then + Utils._SetCalledSub("getValue") + Set vItem = getObject(pvObject) + sProperty = Utils._FinalProperty(pvObject) + If sProperty = "" Then sProperty = "Value" ' Default value if final property in shortcut is absent + getValue = vItem.getProperty(sproperty) + Utils._ResetCalledSub("getValue") + Else + Set vItem = pvObject + getValue = vItem.getProperty("Value") + End If +End Function ' getValue + +REM ----------------------------------------------------------------------------------------------------------------------- Function HtmlEncode(ByVal pvString As Variant, ByVal Optional pvLength As Variant) As String ' Converts a string to an HTML-encoded string. @@ -1379,6 +1478,24 @@ Public Function ProductCode() End Function ' ProductCode V0.9.1 REM ----------------------------------------------------------------------------------------------------------------------- +Public Function setValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean +' setValue also interprets shortcut strings !! +Dim vItem As Variant, sProperty As String + If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setValue") + If VarType(pvObject) = vbString Then + Utils._SetCalledSub("setValue") + Set vItem = getObject(pvObject) + sProperty = Utils._FinalProperty(pvObject) + If sProperty = "" Then sProperty = "Value" + setValue = vItem.setProperty(sProperty, pvValue) + Utils._ResetCalledSub("setValue") + Else + Set vItem = pvObject + setValue = vItem.setProperty("Value", pvValue) + End If +End Function ' setValue + +REM ----------------------------------------------------------------------------------------------------------------------- Public Function SysCmd(Optional pvAction As Variant _ , Optional pvText As Variant _ , Optional pvValue As Variant _ diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba index 3ada734ee766..332eaaa2e5c2 100644 --- a/wizards/source/access2base/PropertiesGet.xba +++ b/wizards/source/access2base/PropertiesGet.xba @@ -399,87 +399,6 @@ Public Function getName(Optional pvObject As Variant) As String End Function ' getName REM ----------------------------------------------------------------------------------------------------------------------- -Public Function getObject(Optional pvShortcut As Variant) As Variant -' Return the object described by pvShortcut ignoring its final property -' Example: "Forms!myForm!myControl.myProperty" => Controls(Forms("myForm"), "myControl")) - -Const cstEXCLAMATION = "!" -Const cstDOT = "." - - If _ErrorHandler() Then On Local Error Goto Error_Function -Const cstThisSub = "getObject" - Utils._SetCalledSub(cstThisSub) - If IsMissing(pvShortcut) Then Call _TraceArguments() - If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function - -Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String -Dim sComponents() As String, sSubComponents() As String, sDialog As String -Dim oDoc As Object - Set vCurrentObject = Nothing - sComponents = Split(Trim(pvShortcut), cstEXCLAMATION) - If UBound(sComponents) = 0 Then Goto Trace_Error - If Not Utils._InList(UCase(sComponents(0)), Array("FORMS", "DIALOGS", "TEMPVARS")) Then Goto Trace_Error - If sComponents(1) = "0" Or Left(sComponents(1), 2) = "0." Then - Set oDoc = _A2B_.CurrentDocument() - If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error - End If - - sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT) - sComponents(UBound(sComponents)) = sSubComponents(0) ' Ignore final property, if any - - Set vCurrentObject = New Collect - Set vCurrentObject._This = vCurrentObject - Select Case UCase(sComponents(0)) - Case "FORMS" : vCurrentObject._CollType = COLLFORMS - Case "DIALOGS" : vCurrentObject._CollType = COLLALLDIALOGS - Case "TEMPVARS" : vCurrentObject._CollType = COLLTEMPVARS - End Select - For iCurrentIndex = 1 To UBound(sComponents) ' Start parsing ... - sSubComponents = Split(sComponents(iCurrentIndex), cstDOT) - sComponents(iCurrentIndex) = Utils._Trim(sSubComponents(0)) - Select Case UBound(sSubComponents) - Case 0 - sCurrentProperty = "" - Case 1 - sCurrentProperty = sSubComponents(1) - Case Else - Goto Trace_Error - End Select - Select Case vCurrentObject._Type - Case OBJCOLLECTION - Select Case vCurrentObject._CollType - Case COLLFORMS - vCurrentObject = Application.AllForms(sComponents(iCurrentIndex)) - Case COLLALLDIALOGS - sDialog = UCase(sComponents(iCurrentIndex)) - vCurrentObject = Application.AllDialogs(sDialog) - If Not vCurrentObject.IsLoaded Then Goto Trace_Error - Set vCurrentObject.UnoDialog = _A2B_.Dialogs.Item(sDialog) - Case COLLTEMPVARS - If UBound(sComponents) > 1 Then Goto Trace_Error - vCurrentObject = Application.TempVars(sComponents(1)) - 'Case Else - End Select - Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG - vCurrentObject = vCurrentObject.Controls(sComponents(iCurrentIndex)) - End Select - If sCurrentProperty <> "" Then vCurrentObject = vCurrentObject.getProperty(sCurrentProperty) - Next iCurrentIndex - - Set getObject = vCurrentObject - -Exit_Function: - Utils._ResetCalledSub(cstThisSub) - Exit Function -Trace_Error: - TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut)) - Goto Exit_Function -Error_Function: - TraceError(TRACEABORT, Err, cstThisSub, Erl) - GoTo Exit_Function -End Function ' getObject V0.9.5 - -REM ----------------------------------------------------------------------------------------------------------------------- Public Function getObjectType(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getObjectType") getObjectType = PropertiesGet._getProperty(pvObject, "ObjectType") @@ -707,24 +626,6 @@ Public Function getTypeName(Optional pvObject As Variant) As Variant End Function ' getTypeName REM ----------------------------------------------------------------------------------------------------------------------- -Public Function getValue(Optional pvObject As Variant) As Variant -' getValue also interprets shortcut strings !! -Dim vItem As Variant, sProperty As String - If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getValue") - If VarType(pvObject) = vbString Then - Utils._SetCalledSub("getValue") - Set vItem = getObject(pvObject) - sProperty = Utils._FinalProperty(pvObject) - If sProperty = "" Then sProperty = "Value" ' Default value if final property in shortcut is absent - getValue = vItem.getProperty(sproperty) - Utils._ResetCalledSub("getValue") - Else - Set vItem = pvObject - getValue = vItem.getProperty("Value") - End If -End Function ' getValue - -REM ----------------------------------------------------------------------------------------------------------------------- Public Function getVisible(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getVisible") getVisible = PropertiesGet._getProperty(pvObject, "Visible") diff --git a/wizards/source/access2base/PropertiesSet.xba b/wizards/source/access2base/PropertiesSet.xba index 668bc58fc652..100806beaddb 100644 --- a/wizards/source/access2base/PropertiesSet.xba +++ b/wizards/source/access2base/PropertiesSet.xba @@ -329,24 +329,6 @@ Public Function setTripleState(Optional pvObject As Variant, ByVal Optional pvVa End Function ' setTripleState REM ----------------------------------------------------------------------------------------------------------------------- -Public Function setValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean -' setValue also interprets shortcut strings !! -Dim vItem As Variant, sProperty As String - If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setValue") - If VarType(pvObject) = vbString Then - Utils._SetCalledSub("setValue") - Set vItem = getObject(pvObject) - sProperty = Utils._FinalProperty(pvObject) - If sProperty = "" Then sProperty = "Value" - setValue = vItem.setProperty(sProperty, pvValue) - Utils._ResetCalledSub("setValue") - Else - Set vItem = pvObject - setValue = vItem.setProperty("Value", pvValue) - End If -End Function ' setValue - -REM ----------------------------------------------------------------------------------------------------------------------- Public Function setVisible(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean ' Only for open forms and controls If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setVisible") diff --git a/wizards/source/access2base/Python.xba b/wizards/source/access2base/Python.xba index e1d2aad803a4..45144ec7c8d3 100644 --- a/wizards/source/access2base/Python.xba +++ b/wizards/source/access2base/Python.xba @@ -78,7 +78,7 @@ Public Function PythonWrapper(ByVal pvCallType As Variant _ , ByVal pvScript As Variant _ , ParamArray pvArgs() As Variant _ ) As Variant -' Called from Python to apply +' Called from Python to apply ' - on object with entry pvObject in PythonCache ' Conventionally: -1 = Application ' -2 = DoCmd @@ -103,7 +103,7 @@ Const cstScalar = 0, cstObject = 1, cstNull = 2, cstUNO = 3 'Conventional special values Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++" -'https://support.office.com/en-us/article/callbyname-function-49ce9475-c315-4f13-8d35-e98cfe98729a +'https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13-8d35-e98cfe98729a 'Determines the pvCallType Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16 @@ -160,12 +160,12 @@ Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16 Case "DVar" : vReturn = Application.DVar(vArgs(0), vArgs(1), vArgs(2)) Case "DVarP" : vReturn = Application.DVarP(vArgs(0), vArgs(1), vArgs(2)) Case "Forms" : If iNbArgs < 0 Then vReturn = Application.Forms() Else vReturn = Application.Forms(vArgs(0)) - Case "getObject" : vReturn = PropertiesGet.getObject(vArgs(0)) - Case "getValue" : vReturn = PropertiesGet.getValue(vArgs(0)) + Case "getObject" : vReturn = Application.getObject(vArgs(0)) + Case "getValue" : vReturn = Application.getValue(vArgs(0)) Case "HtmlEncode" : vReturn = Application.HtmlEncode(vArgs(0), vArgs(1)) Case "OpenDatabase" : vReturn = Application.OpenDatabase(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "ProductCode" : vReturn = Application.ProductCode() - Case "setValue" : vReturn = PropertiesGet.setValue(vArgs(0), vArgs(1)) + Case "setValue" : vReturn = Application.setValue(vArgs(0), vArgs(1)) Case "SysCmd" : vReturn = Application.SysCmd(vArgs(0), vArgs(1), vARgs(2)) Case "TempVars" : If iNbArgs < 0 Then vReturn = Application.TempVars() Else vReturn = Application.TempVars(vArgs(0)) Case "Version" : vReturn = Application.Version() @@ -604,4 +604,4 @@ Dim vValue As Variant End Function -</script:module> +</script:module>
\ No newline at end of file |