wizards/source/access2base/Application.xba | 117 +++++++++++++++++++++++++++
wizards/source/access2base/PropertiesGet.xba | 99 ----------------------
wizards/source/access2base/PropertiesSet.xba | 18 ----
wizards/source/access2base/Python.xba | 12 +-
4 files changed, 123 insertions(+), 123 deletions(-)
New commits:
commit fd2a8fc9651037263069aa5f0f97c205d8fc4a1c
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Tue Aug 20 11:56:42 2019 +0200
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Tue Aug 20 12:01:40 2019 +0200
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
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
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
