summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--wizards/source/access2base/Application.xba117
-rw-r--r--wizards/source/access2base/PropertiesGet.xba99
-rw-r--r--wizards/source/access2base/PropertiesSet.xba18
-rw-r--r--wizards/source/access2base/Python.xba12
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-13 17:39:53 +0000