Access2Base - Get and set On... properties on dialog events

The technique used on form, subform and control events
is not applicable on dialog events
Workaround now implemented

Change-Id: Ie729e47e6f87f156536fd43ab4bfa36cb6ae35f6

2 files changed, 152 insertions, 11 deletions

diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index a0b23eab60de..00d9b13db620 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -82,6 +82,96 @@ Property Get ObjectType() As String
 End Property		'	ObjectType (get)
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnFocusGained() As Variant
+	OnFocusGained = _PropertyGet("OnFocusGained")
+End Property		'	OnFocusGained (get)
+
+Property Let OnFocusGained(ByVal pvValue As Variant)
+	Call _PropertySet("OnFocusGained", pvValue)
+End Property		'	OnFocusGained (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnFocusLost() As Variant
+	OnFocusLost = _PropertyGet("OnFocusLost")
+End Property		'	OnFocusLost (get)
+
+Property Let OnFocusLost(ByVal pvValue As Variant)
+	Call _PropertySet("OnFocusLost", pvValue)
+End Property		'	OnFocusLost (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnKeyPressed() As Variant
+	OnKeyPressed = _PropertyGet("OnKeyPressed")
+End Property		'	OnKeyPressed (get)
+
+Property Let OnKeyPressed(ByVal pvValue As Variant)
+	Call _PropertySet("OnKeyPressed", pvValue)
+End Property		'	OnKeyPressed (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnKeyReleased() As Variant
+	OnKeyReleased = _PropertyGet("OnKeyReleased")
+End Property		'	OnKeyReleased (get)
+
+Property Let OnKeyReleased(ByVal pvValue As Variant)
+	Call _PropertySet("OnKeyReleased", pvValue)
+End Property		'	OnKeyReleased (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMouseDragged() As Variant
+	OnMouseDragged = _PropertyGet("OnMouseDragged")
+End Property		'	OnMouseDragged (get)
+
+Property Let OnMouseDragged(ByVal pvValue As Variant)
+	Call _PropertySet("OnMouseDragged", pvValue)
+End Property		'	OnMouseDragged (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMouseEntered() As Variant
+	OnMouseEntered = _PropertyGet("OnMouseEntered")
+End Property		'	OnMouseEntered (get)
+
+Property Let OnMouseEntered(ByVal pvValue As Variant)
+	Call _PropertySet("OnMouseEntered", pvValue)
+End Property		'	OnMouseEntered (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMouseExited() As Variant
+	OnMouseExited = _PropertyGet("OnMouseExited")
+End Property		'	OnMouseExited (get)
+
+Property Let OnMouseExited(ByVal pvValue As Variant)
+	Call _PropertySet("OnMouseExited", pvValue)
+End Property		'	OnMouseExited (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMouseMoved() As Variant
+	OnMouseMoved = _PropertyGet("OnMouseMoved")
+End Property		'	OnMouseMoved (get)
+
+Property Let OnMouseMoved(ByVal pvValue As Variant)
+	Call _PropertySet("OnMouseMoved", pvValue)
+End Property		'	OnMouseMoved (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMousePressed() As Variant
+	OnMousePressed = _PropertyGet("OnMousePressed")
+End Property		'	OnMousePressed (get)
+
+Property Let OnMousePressed(ByVal pvValue As Variant)
+	Call _PropertySet("OnMousePressed", pvValue)
+End Property		'	OnMousePressed (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnMouseReleased() As Variant
+	OnMouseReleased = _PropertyGet("OnMouseReleased")
+End Property		'	OnMouseReleased (get)
+
+Property Let OnMouseReleased(ByVal pvValue As Variant)
+	Call _PropertySet("OnMouseReleased", pvValue)
+End Property		'	OnMouseReleased (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
 '	Return either an error or an object of type OPTIONGROUP based on its name
 '	A group is determined by the successive TabIndexes of the radio button
@@ -543,12 +633,32 @@ End Function		'	Terminate
 REM -----------------------------------------------------------------------------------------------------------------------
 REM --- PRIVATE FUNCTIONS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _GetListener(ByVal psProperty As String) As String
+'	Return the X...Listener corresponding with the property in argument
+
+	Select Case UCase(psProperty)
+		Case UCase("OnFocusGained"), UCase("OnFocusLost")
+			_GetListener = "XFocusListener"
+		Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
+			_GetListener = "XKeyListener"
+		Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
+			_GetListener = "XMouseMotionListener"
+		Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
+			_GetListener = "XMouseListener"
+	End Select
+	
+End Function	'	_GetListener	V1.7.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _PropertiesList() As Variant
 
 	If IsLoaded Then
 		_PropertiesList =  Array("Caption", "Height", "IsLoaded", "Name" _
-										, "ObjectType", "Page", "Visible", "Width" _
+									, "OnFocusGained", "OnFocusLost", "OnKeyPressed", "OnKeyReleased", "OnMouseDragged" _
+									, "OnMouseEntered", "OnMouseExited", "OnMouseMoved", "OnMousePressed", "OnMouseReleased" _
+									, "ObjectType", "Page", "Visible", "Width" _
 									)
 	Else
 		 _PropertiesList = Array("IsLoaded", "Name" _
@@ -563,7 +673,9 @@ Private Function _PropertyGet(ByVal psProperty As String) As Variant
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 	Utils._SetCalledSub("Dialog.get" & psProperty)
-	
+
+Dim oDialogEvents As Object, sEventName As String
+
 'Execute
 	_PropertyGet = EMPTY
 
@@ -583,6 +695,16 @@ Private Function _PropertyGet(ByVal psProperty As String) As Variant
 			_PropertyGet = _Name
 		Case UCase("ObjectType")
 			_PropertyGet = _Type
+		Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
+				, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
+				, UCase("OnMousePressed"), UCase("OnMouseReleased")
+			Set oDialogEvents = unoDialog.Model.getEvents()
+			sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty)
+			If oDialogEvents.hasByName(sEventName) Then
+				_PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
+			Else
+				_PropertyGet = ""
+			End If
 		Case UCase("Page")
 			_PropertyGet = UnoDialog.Model.Step
 		Case UCase("Visible")
@@ -617,6 +739,8 @@ Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Varia
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 	_PropertySet = True
 
+Dim oDialogEvents As Object, sEventName As String, oEvent As Object, sListener As String, sEvent As String
+
 'Execute
 Dim iArgNr As Integer
 
@@ -629,6 +753,23 @@ Dim iArgNr As Integer
 		Case UCase("Height")
 			If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
 			UnoDialog.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT)
+		Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
+				, 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)
 		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 3b71d0adb92d..ac99e5aae0e3 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -299,6 +299,15 @@ Dim oDialogLib As Object
 End Function
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _GetEventName(ByVal psProperty As String) As String
+'	Return the LO internal event name
+'	Corrects the typo on ErrorOccur(r?)ed
+
+	_GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) & Right(psProperty, Len(psProperty) - 3), "errorOccurred", "errorOccured")
+	
+End Function	'	_GetEventName	V1.7.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _GetEventScriptCode(poObject As Object _
 					, ByVal psEvent As String _
 					, ByVal psName As String _
@@ -449,15 +458,6 @@ Dim sComponents() As String, sSubComponents() As String
 End Function	'	FinalProperty
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _GetEventName(ByVal psProperty As String) As String
-'	Return the LO internal event name
-'	Corrects the typo on ErrorOccur(r?)ed
-
-	_GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) & Right(psProperty, Len(psProperty) - 3), "errorOccurred", "errorOccured")
-	
-End Function	'	_GetEventName	V1.7.0
-
-REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _GetProductName(ByVal Optional psFlag As String) as String
 'Return OO product ("PRODUCT") and version numbers ("VERSION")
 'Derived from Tools library