[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Sat Mar 18 15:50:59 UTC 2017
wizards/source/access2base/Dialog.xba | 145 +++++++++++++++++++++++++++++++++-
wizards/source/access2base/Utils.xba | 18 ++--
2 files changed, 152 insertions(+), 11 deletions(-)
New commits:
commit 4436bef02b85d08c9280027d3637c79a956183fc
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Sat Mar 18 16:46:41 2017 +0100
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
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
More information about the Libreoffice-commits
mailing list