ScriptForge - (SF_DialogControl) get OnEvent properties

Applied on DialogControl class:
OnXxx properties return the triggered script as a string
or a zero-length string when not defined

Change-Id: I832f4f5ee0fcddfecd877bc710cce276bfb5b951
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/106803
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>

1 files changed, 262 insertions, 23 deletions

diff --git a/wizards/source/sfdialogs/SF_DialogControl.xba b/wizards/source/sfdialogs/SF_DialogControl.xba
index 0559d8c036d4..2dce649a1db3 100644
--- a/wizards/source/sfdialogs/SF_DialogControl.xba
+++ b/wizards/source/sfdialogs/SF_DialogControl.xba
@@ -226,6 +226,174 @@ Property Get Name() As String
 End Property	'	SFDialogs.SF_DialogControl.Name
 
 REM -----------------------------------------------------------------------------
+Property Get OnActionPerformed() As Variant
+'''	Get the script associated with the OnActionPerformed event
+	OnActionPerformed = _PropertyGet("OnActionPerformed")
+End Property	'	SFDialogs.SF_DialogControl.OnActionPerformed (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
+'''	Set the updatable property OnActionPerformed
+	_PropertySet("OnActionPerformed", pvOnActionPerformed)
+End Property	'	SFDialogs.SF_DialogControl.OnActionPerformed (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnAdjustmentValueChanged() As Variant
+'''	Get the script associated with the OnAdjustmentValueChanged event
+	OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged")
+End Property	'	SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
+'''	Set the updatable property OnAdjustmentValueChanged
+	_PropertySet("OnAdjustmentValueChanged", pvOnAdjustmentValueChanged)
+End Property	'	SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnFocusGained() As Variant
+'''	Get the script associated with the OnFocusGained event
+	OnFocusGained = _PropertyGet("OnFocusGained")
+End Property	'	SFDialogs.SF_DialogControl.OnFocusGained (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
+'''	Set the updatable property OnFocusGained
+	_PropertySet("OnFocusGained", pvOnFocusGained)
+End Property	'	SFDialogs.SF_DialogControl.OnFocusGained (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnFocusLost() As Variant
+'''	Get the script associated with the OnFocusLost event
+	OnFocusLost = _PropertyGet("OnFocusLost")
+End Property	'	SFDialogs.SF_DialogControl.OnFocusLost (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
+'''	Set the updatable property OnFocusLost
+	_PropertySet("OnFocusLost", pvOnFocusLost)
+End Property	'	SFDialogs.SF_DialogControl.OnFocusLost (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnItemStateChanged() As Variant
+'''	Get the script associated with the OnItemStateChanged event
+	OnItemStateChanged = _PropertyGet("OnItemStateChanged")
+End Property	'	SFDialogs.SF_DialogControl.OnItemStateChanged (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
+'''	Set the updatable property OnItemStateChanged
+	_PropertySet("OnItemStateChanged", pvOnItemStateChanged)
+End Property	'	SFDialogs.SF_DialogControl.OnItemStateChanged (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnKeyPressed() As Variant
+'''	Get the script associated with the OnKeyPressed event
+	OnKeyPressed = _PropertyGet("OnKeyPressed")
+End Property	'	SFDialogs.SF_DialogControl.OnKeyPressed (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
+'''	Set the updatable property OnKeyPressed
+	_PropertySet("OnKeyPressed", pvOnKeyPressed)
+End Property	'	SFDialogs.SF_DialogControl.OnKeyPressed (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnKeyReleased() As Variant
+'''	Get the script associated with the OnKeyReleased event
+	OnKeyReleased = _PropertyGet("OnKeyReleased")
+End Property	'	SFDialogs.SF_DialogControl.OnKeyReleased (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
+'''	Set the updatable property OnKeyReleased
+	_PropertySet("OnKeyReleased", pvOnKeyReleased)
+End Property	'	SFDialogs.SF_DialogControl.OnKeyReleased (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMouseDragged() As Variant
+'''	Get the script associated with the OnMouseDragged event
+	OnMouseDragged = _PropertyGet("OnMouseDragged")
+End Property	'	SFDialogs.SF_DialogControl.OnMouseDragged (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
+'''	Set the updatable property OnMouseDragged
+	_PropertySet("OnMouseDragged", pvOnMouseDragged)
+End Property	'	SFDialogs.SF_DialogControl.OnMouseDragged (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMouseEntered() As Variant
+'''	Get the script associated with the OnMouseEntered event
+	OnMouseEntered = _PropertyGet("OnMouseEntered")
+End Property	'	SFDialogs.SF_DialogControl.OnMouseEntered (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
+'''	Set the updatable property OnMouseEntered
+	_PropertySet("OnMouseEntered", pvOnMouseEntered)
+End Property	'	SFDialogs.SF_DialogControl.OnMouseEntered (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMouseExited() As Variant
+'''	Get the script associated with the OnMouseExited event
+	OnMouseExited = _PropertyGet("OnMouseExited")
+End Property	'	SFDialogs.SF_DialogControl.OnMouseExited (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
+'''	Set the updatable property OnMouseExited
+	_PropertySet("OnMouseExited", pvOnMouseExited)
+End Property	'	SFDialogs.SF_DialogControl.OnMouseExited (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMouseMoved() As Variant
+'''	Get the script associated with the OnMouseMoved event
+	OnMouseMoved = _PropertyGet("OnMouseMoved")
+End Property	'	SFDialogs.SF_DialogControl.OnMouseMoved (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
+'''	Set the updatable property OnMouseMoved
+	_PropertySet("OnMouseMoved", pvOnMouseMoved)
+End Property	'	SFDialogs.SF_DialogControl.OnMouseMoved (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMousePressed() As Variant
+'''	Get the script associated with the OnMousePressed event
+	OnMousePressed = _PropertyGet("OnMousePressed")
+End Property	'	SFDialogs.SF_DialogControl.OnMousePressed (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
+'''	Set the updatable property OnMousePressed
+	_PropertySet("OnMousePressed", pvOnMousePressed)
+End Property	'	SFDialogs.SF_DialogControl.OnMousePressed (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnMouseReleased() As Variant
+'''	Get the script associated with the OnMouseReleased event
+	OnMouseReleased = _PropertyGet("OnMouseReleased")
+End Property	'	SFDialogs.SF_DialogControl.OnMouseReleased (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
+'''	Set the updatable property OnMouseReleased
+	_PropertySet("OnMouseReleased", pvOnMouseReleased)
+End Property	'	SFDialogs.SF_DialogControl.OnMouseReleased (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnTextChanged() As Variant
+'''	Get the script associated with the OnTextChanged event
+	OnTextChanged = _PropertyGet("OnTextChanged")
+End Property	'	SFDialogs.SF_DialogControl.OnTextChanged (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
+'''	Set the updatable property OnTextChanged
+	_PropertySet("OnTextChanged", pvOnTextChanged)
+End Property	'	SFDialogs.SF_DialogControl.OnTextChanged (let)
+
+REM -----------------------------------------------------------------------------
 Property Get Page() As Variant
 '''	A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active.
 '''	The Page property of a control defines the page of the dialog on which the control is visible.
@@ -402,6 +570,20 @@ Public Function Properties() As Variant
 					, "Locked" _
 					, "MultiSelect" _
 					, "Name" _
+					, "OnActionPerformed" _
+					, "OnAdjustmentValueChanged" _
+					, "OnFocusGained" _
+					, "OnFocusLost" _
+					, "OnItemStateChanged" _
+					, "OnKeyPressed" _
+					, "OnKeyReleased" _
+					, "OnMouseDragged" _
+					, "OnMouseEntered" _
+					, "OnMouseExited" _
+					, "OnMouseMoved" _
+					, "OnMousePressed" _
+					, "OnMouseReleased" _
+					, "OnTextChanged" _
 					, "Page" _
 					, "Parent" _
 					, "Picture" _
@@ -593,6 +775,50 @@ Dim vFormats() As Variant		'	Return value
 End Function	'	SFDialogs.SF_DialogControl._FormatsList
 
 REM -----------------------------------------------------------------------------
+Public Function _GetEventName(ByVal psProperty As String) As String
+'''	Return the LO internal event name derived from the SF property name
+'''	The SF property name is not case sensitive, while the LO name is case-sensitive
+'	Corrects the typo on ErrorOccur(r?)ed, if necessary
+
+Dim vProperties As Variant			'	Array of class properties
+Dim sProperty As String				'	Correctly cased property name
+
+	vProperties = Properties()
+	sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
+
+	_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
+	
+End Function	'	SFDialogs.SF_DialogControl._GetEventName
+
+REM -----------------------------------------------------------------------------
+Private Function _GetListener(ByVal psEventName As String) As String
+'''	Getting/Setting macros triggered by events requires a Listener-EventName pair
+'''	Return the X...Listener corresponding with the event name in argument
+
+	Select Case UCase(psEventName)
+		Case UCase("OnActionPerformed")
+			_GetListener = "XActionListener"
+		Case UCase("OnAdjustmentValueChanged")
+			_GetListener = "XAdjustmentListener"
+		Case UCase("OnFocusGained"), UCase("OnFocusLost")
+			_GetListener = "XFocusListener"
+		Case UCase("OnItemStateChanged")
+			_GetListener = "XItemListener"
+		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"
+		Case UCase("OnTextChanged")
+			_GetListener = "XTextListener"
+		Case Else
+			_GetListener = ""
+	End Select
+	
+End Function	'	SFDialogs.SF_DialogControl._GetListener
+
+REM -----------------------------------------------------------------------------
 Public Sub _Initialize()
 '''	Complete the object creation process:
 '''		- Initialization of private members
@@ -636,6 +862,8 @@ Dim lIndex As Long							'	Index in StringItemList
 Dim sItem As String							'	A single item
 Dim vDate As Variant						'	com.sun.star.util.Date or com.sun.star.util.Time
 Dim vValues As Variant						'	Array of listbox values
+Dim oControlEvents As Object				'	com.sun.star.container.XNameContainer
+Dim sEventName As String					'	Internal event name
 Dim i As Long
 Dim cstThisSub As String
 Const cstSubArgs = ""
@@ -650,30 +878,30 @@ Const cstSubArgs = ""
 	_PropertyGet = pvDefault
 
 	If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
-	Select Case psProperty
-		Case "Cancel"
+	Select Case UCase(psProperty)
+		Case UCase("Cancel")
 			Select Case _ControlType
 				Case CTLBUTTON
 					If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Caption"
+		Case UCase("Caption")
 			Select Case _ControlType
 				Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
 					If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "ControlType"
+		Case UCase("ControlType")
 			_PropertyGet = _ControlType
-		Case "Default"
+		Case UCase("Default")
 			Select Case _ControlType
 				Case CTLBUTTON
 					If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Enabled"
+		Case UCase("Enabled")
 			If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
-		Case "Format"
+		Case UCase("Format")
 			Select Case _ControlType
 				Case CTLDATEFIELD
 					If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
@@ -685,13 +913,13 @@ Const cstSubArgs = ""
 					End If
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "ListCount"
+		Case UCase("ListCount")
 			Select Case _ControlType
 				Case CTLCOMBOBOX, CTLLISTBOX
 					If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "ListIndex"
+		Case UCase("ListIndex")
 			Select Case _ControlType
 				Case CTLCOMBOBOX
 					_PropertyGet = -1	'	Not found, multiselection
@@ -706,14 +934,14 @@ Const cstSubArgs = ""
 					End If
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Locked"
+		Case UCase("Locked")
 			Select Case _ControlType
 				Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
 						, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
 					If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "MultiSelect"
+		Case UCase("MultiSelect")
 			Select Case _ControlType
 				Case CTLLISTBOX
 					If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
@@ -723,19 +951,30 @@ Const cstSubArgs = ""
 					End If
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Name"
+		Case UCase("Name")
 			_PropertyGet = _Name
-		Case "Page"
+		Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
+				, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
+				, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
+				, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
+			Set oControlEvents = _ControlModel.getEvents()
+			sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
+			If oControlEvents.hasByName(sEventName) Then
+				_PropertyGet = oControlEvents.getByName(sEventName).ScriptCode
+			Else
+				_PropertyGet = ""
+			End If
+		Case UCase("Page")
 			If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step
-		Case "Parent"
+		Case UCase("Parent")
 			Set _PropertyGet = [_Parent]
-		Case "Picture"
+		Case UCase("Picture")
 			Select Case _ControlType
 				Case CTLBUTTON, CTLIMAGECONTROL
 					If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "RowSource"
+		Case UCase("RowSource")
 			Select Case _ControlType
 				Case CTLCOMBOBOX, CTLLISTBOX
 					If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
@@ -743,21 +982,21 @@ Const cstSubArgs = ""
 					End If
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Text"
+		Case UCase("Text")
 			Select Case _ControlType
 				Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
 					If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "TipText"
+		Case UCase("TipText")
 			If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
-		Case "TripleState"
+		Case UCase("TripleState")
 			Select Case _ControlType
 				Case CTLCHECKBOX
 					If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
 				Case Else	:	GoTo CatchType
 			End Select
-		Case "Value"	'	Default values are set here by control type, not in the 2nd argument
+		Case UCase("Value")	'	Default values are set here by control type, not in the 2nd argument
 			vGet = pvDefault
 			Select Case _ControlType
 				Case CTLBUTTON		'Boolean, toggle buttons only
@@ -822,11 +1061,11 @@ Const cstSubArgs = ""
 				Case Else	:	GoTo CatchType
 			End Select
 			_PropertyGet = vGet
-		Case "Visible"
+		Case UCase("Visible")
 			If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
-		Case "XControlModel"
+		Case UCase("XControlModel")
 			Set _PropertyGet = _ControlModel
-		Case "XControlView"
+		Case UCase("XControlView")
 			Set _PropertyGet = _ControlView
 		Case Else
 			_PropertyGet = Null