[Libreoffice-commits] core.git: wizards/source

Jean-Pierre Ledure (via logerrit) logerrit at kemper.freedesktop.org
Sat Nov 28 15:44:25 UTC 2020


 wizards/source/sfdialogs/SF_DialogControl.xba |  285 +++++++++++++++++++++++---
 1 file changed, 262 insertions(+), 23 deletions(-)

New commits:
commit eef1e5c02b2e9ef80c9070d2472b622fe3121ec8
Author:     Jean-Pierre Ledure <jp at ledure.be>
AuthorDate: Sat Nov 28 14:23:50 2020 +0100
Commit:     Jean-Pierre Ledure <jp at ledure.be>
CommitDate: Sat Nov 28 16:43:45 2020 +0100

    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 at ledure.be>
    Tested-by: Jenkins
    Reviewed-by: Jean-Pierre Ledure <jp at ledure.be>

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
@@ -225,6 +225,174 @@ Property Get Name() As String
 	Name = _PropertyGet("Name")
 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.
@@ -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" _
@@ -592,6 +774,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:
@@ -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


More information about the Libreoffice-commits mailing list