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 <[email protected]> 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 _______________________________________________ Libreoffice-commits mailing list [email protected] https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
