Access2Base - Dialog on event properties

Forms and dialogs events are stored differently.
New code manages correctly dialog events.

Additionally performance improvement in Control class:
the list of properties is buffered in a private variable

Change-Id: I9d3e2cf3853f8caa043fc4a84c67d323cea44ffe

5 files changed, 97 insertions, 32 deletions

diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 2c38590136d8..41c9a1d42e4f 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -193,7 +193,7 @@ Const cstThisSub = "AllDialogs"
 
 Dim iMode As Integer, vDialogs() As Variant, i As Integer, j As Integer, iCount As Integer
 Dim oMacLibraries As Object, vAllDialogs As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean
-Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object
+Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object, bLocalStorage As Boolean
 Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object
 Const cstCount = 0
 Const cstByIndex = 1
@@ -209,7 +209,7 @@ Const cstSepar = "!"
 
 	Set vAllDialogs = Nothing
 
-	Set oDocLibraries = ThisComponent.DialogLibraries
+	Set oDocLibraries = _A2B_.CurrentDocument.Document.DialogLibraries	'	ThisComponent.DialogLibraries
 	vDocLibraries = oDocLibraries.getElementNames()
 	Set oMacLibraries = DialogLibraries
 	vMacLibraries = oMacLibraries.getElementNames()
@@ -236,11 +236,13 @@ Const cstSepar = "!"
 		bFound = False
 		If i <= UBound(vDocLibraries) Then
 			sLibrary = vDocLibraries(i)
+			bLocalStorage = True
 			Set oDocMacLib = oDocLibraries
 			'	Sometimes library not loaded as should ??
 			If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary)
 		Else
 			sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1)
+			bLocalStorage = False
 			Set oDocMacLib = oMacLibraries
 		End If
 		If oDocMacLib.IsLibraryLoaded(sLibrary) Then
@@ -280,9 +282,13 @@ Const cstSepar = "!"
 			If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found
 		End If
 		Set vAllDialogs = New Dialog
-		vAllDialogs._Name = vDialogs(j)
-		vAllDialogs._Shortcut = "Dialogs!" & vDialogs(j)
-		Set vAllDialogs._Dialog = oLibDialog
+		With vAllDialogs
+			._Name = vDialogs(j)
+			._Shortcut = "Dialogs!" & vDialogs(j)
+			Set ._Dialog = oLibDialog
+			._Library = sLibrary
+			._Storage = Iif(bLocalStorage, "DOCUMENT", "GLOBAL")
+		End With
 	End If
 
 Exit_Function:
@@ -447,7 +453,7 @@ Const cstDot = "."
 
 	Set vAllModules = Nothing
 
-	Set oDocLibraries = ThisComponent.BasicLibraries
+	Set oDocLibraries = _A2B_.CurrentDocument.Document.BasicLibraries	'	ThisComponent.BasicLibraries
 	vDocLibraries = oDocLibraries.getElementNames()
 	If pbAllModules Then
 		Set oMacLibraries = GlobalScope.BasicLibraries
diff --git a/wizards/source/access2base/Control.xba b/wizards/source/access2base/Control.xba
index 859e44601328..ca3e887e2f06 100644
--- a/wizards/source/access2base/Control.xba
+++ b/wizards/source/access2base/Control.xba
@@ -24,6 +24,7 @@ Private _FormComponent			As Object				'	com.sun.star.text.TextDocument
 Private _DocEntry				As Integer				'	Doc- and DbContainer entries in Root structure
 Private _DbEntry				As Integer
 Private	_ControlType			As Integer
+Private _ThisProperties			As Variant				'	Buffer for properties list
 Private	_SubType				As String
 Private	ControlModel			As Object				'	com.sun.star.comp.forms.XXXModel
 Private	ControlView				As Object				'	com.sun.star.comp.forms.XXXControl	(NULL if form open in edit mode)
@@ -42,6 +43,7 @@ Private Sub Class_Initialize()
 	Set _FormComponent	= Nothing
 	_DocEntry			= -1
 	_DbEntry			= -1
+	_ThisProperties		= Array()
 	_SubType			= ""
 	Set ControlModel	= Nothing
 	Set ControlView		= Nothing
@@ -1226,6 +1228,13 @@ Private Function _PropertiesList() As Variant
 '	Based on ControlProperties.ods analysis
 
 Dim vFullPropertiesList() As Variant
+
+	'List established only once
+	If UBound(_ThisProperties) > -1 Then
+		_PropertiesList = _ThisProperties
+		Exit Function
+	End If
+
 	vFullPropertiesList = Array( _
 		"BackColor" _
 		, "BorderColor" _
@@ -1362,18 +1371,18 @@ Dim vPropertiesMatrix(25) As Variant
 			vPropertiesMatrix(acTimeField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70)
 	End Select
 	
-Dim vProperties() As Variant, i As Integer, iIndex As Integer
+Dim i As Integer, iIndex As Integer
 	If _ControlType = acSubForm Then iIndex = 0 Else iIndex = _ControlType
 	If IsEmpty(vPropertiesMatrix(iIndex)) Then
-		vProperties = Array()
+		_ThisProperties = Array()
 	Else
-		ReDim vProperties(0 To UBound(vPropertiesMatrix(iIndex)))
-		For i = 0 To UBound(vProperties)
-			vProperties(i) = vFullPropertiesList(vPropertiesMatrix(iIndex)(i))
+		ReDim _ThisProperties(0 To UBound(vPropertiesMatrix(iIndex)))
+		For i = 0 To UBound(_ThisProperties)
+			_ThisProperties(i) = vFullPropertiesList(vPropertiesMatrix(iIndex)(i))
 		Next i
 	End If
 
-	_PropertiesList = vProperties()
+	_PropertiesList = _ThisProperties()
 
 End Function	'	_PropertiesList
 
@@ -1404,6 +1413,7 @@ Dim vGet As Variant, vDate As Variant
 Dim ofSubForm As Object
 Dim vFormats() As Variant
 Dim vSelection As Variant, sSelectedText As String
+Dim oControlEvents As Object, sEventName As String
 	
 	If Not hasProperty(psProperty) Then Goto Trace_Error
 
@@ -1590,7 +1600,18 @@ Dim vSelection As Variant, sSelectedText As String
 				, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
 				, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _
 				, UCase("OnUpdated")
-			_PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name)
+			Select Case _ParentType
+				Case CTLPARENTISDIALOG
+					Set oControlEvents = ControlModel.getEvents()
+					sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty)
+					If oControlEvents.hasByName(sEventName) Then
+						_PropertyGet = oControlEvents.getByName(sEventName).ScriptCode
+					Else
+						_PropertyGet = ""
+					End If
+				Case Else
+					_PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name)
+			End Select
 		Case UCase("OptionValue")
 			If Utils._hasUNOProperty(ControlModel, "RefValue") Then
 				If ControlModel.RefValue <> "" Then
@@ -1869,6 +1890,7 @@ Dim bMultiSelect As Boolean, iCount As Integer, iSelectedItems() As Integer, lLi
 Dim vItemList() As Variant, vFormats() As Variant
 Dim oStruct As Object, sValue As String
 Dim vSelection As Variant, sText As String, lStart As long
+Dim oControlEvents As Object, sListener As String, sEvent As String, sEventName As String, oEvent As Object
 
 	_PropertySet = True
 	Select Case UCase(_A2B_.CalledSub)
@@ -2081,11 +2103,21 @@ Dim vSelection As Variant, sText As String, lStart As long
 				, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _
 				, UCase("OnUpdated")
 			If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
-			If Not Utils._RegisterEventScript(ControlModel _
-						, psProperty _
-						, _GetListener(psProperty) _
-						, pvValue, _Name _
-						) Then GoTo Trace_Error
+			Select Case _ParentType
+				Case CTLPARENTISDIALOG
+					If Not Utils._RegisterDialogEventScript(ControlModel _
+								, psProperty _
+								, _GetListener(psProperty) _
+								, pvValue _
+								) Then GoTo Trace_Error
+				Case Else
+					If Not Utils._RegisterEventScript(ControlModel _
+								, psProperty _
+								, _GetListener(psProperty) _
+								, pvValue _
+								, _Name _
+								) Then GoTo Trace_Error
+			End Select
 		Case UCase("OptionValue")
 			If Not Utils._hasUNOProperty(ControlModel, "RefValue") Then Goto Trace_Error
 			If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index 00d9b13db620..1d11e6ce8e1b 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -18,6 +18,8 @@ Private	_Type					As String				'	Must be DIALOG
 Private	_Name					As String
 Private _Shortcut				As String
 Private _Dialog					As Object				'	com.sun.star.io.XInputStreamProvider
+Private _Storage				As String				'	GLOBAL or DOCUMENT
+Private _Library				As String
 Private UnoDialog				As Object				'	com.sun.star.awt.XControl
 
 REM -----------------------------------------------------------------------------------------------------------------------
@@ -27,6 +29,8 @@ Private Sub Class_Initialize()
 	_Type = OBJDIALOG
 	_Name = ""
 	Set _Dialog = Nothing
+	_Storage = ""
+	_Library = ""
 	Set UnoDialog = Nothing
 End Sub		'	Constructor
 
@@ -757,19 +761,11 @@ Dim iArgNr As Integer
 				, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
 				, UCase("OnMousePressed"), UCase("OnMouseReleased")
 			If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
-			Set oDialogEvents = unoDialog.Model.getEvents()
-			sListener = _GetListener(psProperty)
-			sEvent = Utils._GetEventName(psProperty)
-			sEventName = "com.sun.star.awt." & sListener & "::" & sEvent
-			If oDialogEvents.hasByName(sEventName) Then oDialogEvents.removeByName(sEventName)
-			Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
-			With oEvent
-				.ListenerType = sListener
-				.EventMethod = sEvent
-				.ScriptType = "Script"			'	Better than "Basic"
-				.ScriptCode = pvValue
-			End With
-			oDialogEvents.insertByName(sEventName, oEvent)
+			If Not Utils._RegisterDialogEventScript(UnoDialog.Model _
+						, psProperty _
+						, _GetListener(psProperty) _
+						, pvValue _
+						) Then GoTo Trace_Error_Dialog
 		Case UCase("Page")
 			If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
 			If pvValue < 0 Then Goto Trace_Error_Value
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 79cebb63d0c6..42c0a4b15a24 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -964,6 +964,37 @@ Dim lEnd As Long, vResult As Object
 End Function
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _RegisterDialogEventScript(poObject As Object _
+								, ByVal psEvent As String _
+								, ByVal psListener As String _
+								, ByVal psScriptCode As String _
+								) As Boolean
+'	Register a script event (psEvent) to poObject (Dialog or dialog Control)
+
+Dim oEvents As Object, sEvent As String, sEventName As String, oEvent As Object
+
+	_RegisterDialogEventScript = False
+	If Not _hasUNOMethod(poObject, "getEvents") Then Exit Function
+
+'	Remove existing event, if any, than store new script code
+	Set oEvents = poObject.getEvents()
+	sEvent = Utils._GetEventName(psEvent)
+	sEventName = "com.sun.star.awt." & psListener & "::" & sEvent
+	If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName)
+	Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
+	With oEvent
+		.ListenerType = psListener
+		.EventMethod = sEvent
+		.ScriptType = "Script"			'	Better than "Basic"
+		.ScriptCode = psScriptCode
+	End With
+	oEvents.insertByName(sEventName, oEvent)
+
+	_RegisterDialogEventScript = True
+
+End Function	'	_RegisterDialogEventScript	V1.8.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _RegisterEventScript(poObject As Object _
 								, ByVal psEvent As String _
 								, ByVal psListener As String _
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index e382996b22fc..f2aeb26ea82c 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM ============================================================================
 Option Explicit
 
 REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.7.0"
+Global Const Access2Base_Version = "1.8.0"
 
 REM AcCloseSave
 REM -----------------------------------------------------------------