mir/libreoffice
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Access2Base - Set Parent property in all classes

Browse Source 
To get faster access to parents from controls
Top classes (form, dialog and commandbar) should return Parent = Nothing
This commit is contained in:
Jean-Pierre Ledure
2019-07-13 16:19:17 +02:00
parent 35463d886e
commit 15fec4ee1c
14 changed files with 54 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
wizards/source/access2base/CommandBar.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be COMMANDBAR
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _ResourceURL As String
Private _Window As Object ' com.sun.star.frame.XFrame
@@ -31,6 +32,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCOMMANDBAR
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_ResourceURL = ""
Set _Window = Nothing
@@ -74,6 +76,11 @@ Property Get ObjectType() As String
ObjectType = _PropertyGet("ObjectType")
End Property ' ObjectType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Parent() As Object
Parent = _Parent
End Function ' Parent (get) V6.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
' Return
@@ -151,7 +158,8 @@ Dim oObject As Object
If pvIndex = iItemsCount - 1 Then
Set oObject = New CommandBarControl
With oObject
._This = oObject
Set ._This = oObject
Set ._Parent = _This
._ParentCommandBarName = _Name
._ParentCommandBar = oToolbar
._ParentBuiltin = ( _BarBuiltin = 1 )

4
wizards/source/access2base/CommandBarControl.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be COMMANDBARCONTROL
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
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
@@ -32,6 +33,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCOMMANDBARCONTROL
Set _This = Nothing
Set _Parent = Nothing
_Index = -1
_ParentCommandBarName = ""
Set _ParentCommandBar = Nothing
@@ -238,7 +240,7 @@ Const cstUnoPrefix = ".uno:"
Case UCase("OnAction")
_PropertyGet = _GetPropertyValue(_Element, "CommandURL", "")
Case UCase("Parent")
Set _PropertyGet = Application.CommandBars(_ParentCommandBarName)
Set _PropertyGet = _Parent
Case UCase("TooltipText")
sValue = _GetPropertyValue(_Element, "Tooltip", "")
If sValue <> "" Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, "Label", "")

5
wizards/source/access2base/Control.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be CONTROL
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _ImplementationName As String
Private _ClassId As Integer
Private _ParentType As String ' One of CTLPARENTISxxxx constants
@@ -40,6 +41,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCONTROL
Set _This = Nothing
Set _Parent = Nothing
_ClassId = -1
_ParentType = ""
_Shortcut = ""
@@ -781,6 +783,7 @@ Dim j As Integer, oView As Object
' Determine exact name
Set ocControl = New Control
Set ocControl._This = ocControl
Set ocControl._Parent = _This
ocControl._ParentType = CTLPARENTISGRID
sParentShortcut = _Shortcut
sControls() = ControlModel.getElementNames()
@@ -1649,7 +1652,7 @@ Dim oControlEvents As Object, sEventName As String
Case UCase("Page")
If Utils._hasUNOProperty(ControlModel, "Step") Then _PropertyGet = ControlModel.Step
Case UCase("Parent")
Set _PropertyGet = PropertiesGet._ParentObject(_Shortcut)
Set _PropertyGet = _Parent
Case UCase("Picture")
_PropertyGet = ConvertToUrl(ControlModel.ImageURL)
Case UCase("Required")

2
wizards/source/access2base/DataDef.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be TABLEDEF or QUERYDEF
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String ' For tables: [[Catalog.]Schema.]Table
Private _ParentDatabase As Object
Private _ReadOnly As Boolean
@@ -35,6 +36,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = ""
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
Set _ParentDatabase = Nothing
_ReadOnly = False

2
wizards/source/access2base/Database.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be DATABASE
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _DbConnect As Integer ' DBCONNECTxxx constants
Private Title As String
Private Document As Object ' com.sun.star.comp.dba.ODatabaseDocument or SwXTextDocument or ScModelObj
@@ -43,6 +44,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJDATABASE
Set _This = Nothing
Set _Parent = Nothing
_DbConnect = 0
Title = ""
Set Document = Nothing

8
wizards/source/access2base/Dialog.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be DIALOG
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _Shortcut As String
Private _Dialog As Object ' com.sun.star.io.XInputStreamProvider
@@ -30,6 +31,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJDIALOG
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
Set _Dialog = Nothing
_Storage = ""
@@ -291,6 +293,11 @@ Property Let Page(ByVal pvValue As Variant)
Call _PropertySet("Page", pvValue)
End Property ' Page (set)
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Parent() As Object
Parent = _Parent
End Function ' Parent (get) V6.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
' Return
@@ -353,6 +360,7 @@ Dim j As Integer
If Not IsLoaded Then Goto Trace_Error_NotOpen
Set ocControl = New Control
Set ocControl._This = ocControl
Set ocControl._Parent = _This
ocControl._ParentType = CTLPARENTISDIALOG
sParentShortcut = _Shortcut
sControls() = UnoDialog.Model.getElementNames()

2
wizards/source/access2base/Field.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be FIELD
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _Precision As Long
Private _ParentName As String
@@ -35,6 +36,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJFIELD
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_ParentName = ""
_ParentType = ""

10
wizards/source/access2base/Form.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be FORM
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Shortcut As String
Private _Name As String
Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure
@@ -37,6 +38,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJFORM
Set _This = Nothing
Set _Parent = Nothing
_Shortcut = ""
_Name = ""
_DocEntry = -1
@@ -397,6 +399,11 @@ Error_Function:
GoTo Exit_Function
End Function ' OptionGroup V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Parent() As Object
Parent = _Parent
End Function ' Parent (get) V6.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
' Return
@@ -556,7 +563,8 @@ Dim oDatabaseForm As Object, iCtlCount As Integer
'Initialize a new Control object
Set ocControl = New Control
With ocControl
._This = ocControl
Set ._This = ocControl
Set ._Parent = _This
._ParentType = CTLPARENTISFORM
._Name = sName
._Shortcut = _Shortcut & "!" & Utils._Surround(sName)

2
wizards/source/access2base/Module.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be MODULE
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _Library As Object ' com.sun.star.container.XNameAccess
Private _LibraryName As String
@@ -36,6 +37,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJMODULE
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
Set _Library = Nothing
_LibraryName = ""

3
wizards/source/access2base/OptionGroup.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be FORM
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _ParentType As String
Private _ParentComponent As Object
@@ -33,6 +34,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJOPTIONGROUP
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_ParentType = ""
_ParentComponent = Nothing
@@ -137,6 +139,7 @@ Dim oCounter As Object
' Determine exact name
Set ocControl = New Control
Set ocControl._This = ocControl
Set ocControl._Parent = _This
ocControl._ParentType = CTLPARENTISGROUP
ocControl._Shortcut = ""

2
wizards/source/access2base/Property.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be PROPERTY
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _Value As Variant
Private _ParentDatabase As Object
@@ -27,6 +28,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJPROPERTY
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_Value = Null
End Sub ' Constructor

2
wizards/source/access2base/Recordset.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be RECORDSET
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String ' Unique, generated
Private _Fields() As Variant
Private _ParentName As String
@@ -52,6 +53,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJRECORDSET
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_Fields = Array()
_ParentName = ""

5
wizards/source/access2base/SubForm.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be SUBFORM
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Shortcut As String
Private _Name As String
Private _MainForm As String
@@ -32,6 +33,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJSUBFORM
Set _This = Nothing
Set _Parent = Nothing
_Shortcut = ""
_Name = ""
_MainForm = ""
@@ -317,7 +319,7 @@ Public Function Parent() As Object
Utils._SetCalledSub("SubForm.getParent")
On Error Goto Error_Function
Set Parent = PropertiesGet._ParentObject(_Shortcut)
Set Parent = _Parent
Exit_Function:
Utils._ResetCalledSub("SubForm.getParent")
@@ -395,6 +397,7 @@ Dim j As Integer
' Determine exact name
Set ocControl = New Control
Set ocControl._This = ocControl
Set ocControl._Parent = _This
ocControl._ParentType = CTLPARENTISSUBFORM
sParentShortcut = _Shortcut
sControls() = DatabaseForm.getElementNames()

2
wizards/source/access2base/TempVar.xba
View File

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
Private _Type As String ' Must be TEMPVAR
Private _This As Object ' Workaround for absence of This builtin function
Private _Parent As Object
Private _Name As String
Private _Value As Variant
@@ -26,6 +27,7 @@ REM ----------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJTEMPVAR
Set _This = Nothing
Set _Parent = Nothing
_Name = ""
_Value = Null
End Sub ' Constructor