wizards/source/sfdialogs/SF_DialogControl.xba | 285 +++++++++++++++++++++++--- 1 file changed, 262 insertions(+), 23 deletions(-)
New commits: commit eef1e5c02b2e9ef80c9070d2472b622fe3121ec8 Author: Jean-Pierre Ledure <[email protected]> AuthorDate: Sat Nov 28 14:23:50 2020 +0100 Commit: Jean-Pierre Ledure <[email protected]> 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 <[email protected]> Tested-by: Jenkins Reviewed-by: Jean-Pierre Ledure <[email protected]> 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 _______________________________________________ Libreoffice-commits mailing list [email protected] https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
