Access2Base - Set Parent property in all classes

To get faster access to parents from controls
Top classes (form, dialog and commandbar) should return Parent = Nothing

wizards/source/access2base/CommandBar.xba

@@ -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 )

wizards/source/access2base/CommandBarControl.xba

@@ -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", "")

wizards/source/access2base/Control.xba

@@ -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")

wizards/source/access2base/DataDef.xba

@@ -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

wizards/source/access2base/Database.xba

@@ -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

wizards/source/access2base/Dialog.xba

@@ -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()

wizards/source/access2base/Field.xba

@@ -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 = ""

wizards/source/access2base/Form.xba

@@ -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)

wizards/source/access2base/Module.xba

@@ -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 = ""

wizards/source/access2base/OptionGroup.xba

@@ -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 = ""

wizards/source/access2base/Property.xba

@@ -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

wizards/source/access2base/Recordset.xba

@@ -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 = ""

wizards/source/access2base/SubForm.xba

@@ -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()

wizards/source/access2base/TempVar.xba

@@ -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