wizards/source/access2base/Application.xba |   18 ++++++---
 wizards/source/access2base/Control.xba     |   56 ++++++++++++++++++++++-------
 wizards/source/access2base/Dialog.xba      |   22 ++++-------
 wizards/source/access2base/Utils.xba       |   31 ++++++++++++++++
 wizards/source/access2base/acConstants.xba |    2 -
 5 files changed, 97 insertions(+), 32 deletions(-)

New commits:
commit 39a6524625a3a682cf53128b5544cd7f2f75f3f1
Author: Jean-Pierre Ledure <j...@ledure.be>
Date:   Sat Aug 5 15:52:00 2017 +0200

    Access2Base - Dialog on event properties
    
    Forms and dialogs events are stored differently.
    New code manages correctly dialog events.
    
    Additionally performance improvement in Control class:
    the list of properties is buffered in a private variable
    
    Change-Id: I9d3e2cf3853f8caa043fc4a84c67d323cea44ffe

diff --git a/wizards/source/access2base/Application.xba 
b/wizards/source/access2base/Application.xba
index 2c38590136d8..41c9a1d42e4f 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -193,7 +193,7 @@ Const cstThisSub = &quot;AllDialogs&quot;
 
 Dim iMode As Integer, vDialogs() As Variant, i As Integer, j As Integer, 
iCount As Integer
 Dim oMacLibraries As Object, vAllDialogs As Variant, oLibrary As Object, 
vNames() As Variant, bFound As Boolean
-Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object
+Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object, 
bLocalStorage As Boolean
 Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As 
Variant, oDocMacLib As Object
 Const cstCount = 0
 Const cstByIndex = 1
@@ -209,7 +209,7 @@ Const cstSepar = &quot;!&quot;
 
        Set vAllDialogs = Nothing
 
-       Set oDocLibraries = ThisComponent.DialogLibraries
+       Set oDocLibraries = _A2B_.CurrentDocument.Document.DialogLibraries      
&apos;  ThisComponent.DialogLibraries
        vDocLibraries = oDocLibraries.getElementNames()
        Set oMacLibraries = DialogLibraries
        vMacLibraries = oMacLibraries.getElementNames()
@@ -236,11 +236,13 @@ Const cstSepar = &quot;!&quot;
                bFound = False
                If i &lt;= UBound(vDocLibraries) Then
                        sLibrary = vDocLibraries(i)
+                       bLocalStorage = True
                        Set oDocMacLib = oDocLibraries
                        &apos;  Sometimes library not loaded as should ??
                        If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then 
oDocMacLib.loadLibrary(sLibrary)
                Else
                        sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1)
+                       bLocalStorage = False
                        Set oDocMacLib = oMacLibraries
                End If
                If oDocMacLib.IsLibraryLoaded(sLibrary) Then
@@ -280,9 +282,13 @@ Const cstSepar = &quot;!&quot;
                        If iMode = cstByIndex Then Goto Trace_Error_Index Else 
Goto Trace_Not_Found
                End If
                Set vAllDialogs = New Dialog
-               vAllDialogs._Name = vDialogs(j)
-               vAllDialogs._Shortcut = &quot;Dialogs!&quot; &amp; vDialogs(j)
-               Set vAllDialogs._Dialog = oLibDialog
+               With vAllDialogs
+                       ._Name = vDialogs(j)
+                       ._Shortcut = &quot;Dialogs!&quot; &amp; vDialogs(j)
+                       Set ._Dialog = oLibDialog
+                       ._Library = sLibrary
+                       ._Storage = Iif(bLocalStorage, &quot;DOCUMENT&quot;, 
&quot;GLOBAL&quot;)
+               End With
        End If
 
 Exit_Function:
@@ -447,7 +453,7 @@ Const cstDot = &quot;.&quot;
 
        Set vAllModules = Nothing
 
-       Set oDocLibraries = ThisComponent.BasicLibraries
+       Set oDocLibraries = _A2B_.CurrentDocument.Document.BasicLibraries       
&apos;  ThisComponent.BasicLibraries
        vDocLibraries = oDocLibraries.getElementNames()
        If pbAllModules Then
                Set oMacLibraries = GlobalScope.BasicLibraries
diff --git a/wizards/source/access2base/Control.xba 
b/wizards/source/access2base/Control.xba
index 859e44601328..ca3e887e2f06 100644
--- a/wizards/source/access2base/Control.xba
+++ b/wizards/source/access2base/Control.xba
@@ -24,6 +24,7 @@ Private _FormComponent                        As Object       
                        &apos;  com.sun.star.text.TextDocument
 Private _DocEntry                              As Integer                      
        &apos;  Doc- and DbContainer entries in Root structure
 Private _DbEntry                               As Integer
 Private        _ControlType                    As Integer
+Private _ThisProperties                        As Variant                      
        &apos;  Buffer for properties list
 Private        _SubType                                As String
 Private        ControlModel                    As Object                       
        &apos;  com.sun.star.comp.forms.XXXModel
 Private        ControlView                             As Object               
                &apos;  com.sun.star.comp.forms.XXXControl      (NULL if form 
open in edit mode)
@@ -42,6 +43,7 @@ Private Sub Class_Initialize()
        Set _FormComponent      = Nothing
        _DocEntry                       = -1
        _DbEntry                        = -1
+       _ThisProperties         = Array()
        _SubType                        = &quot;&quot;
        Set ControlModel        = Nothing
        Set ControlView         = Nothing
@@ -1226,6 +1228,13 @@ Private Function _PropertiesList() As Variant
 &apos; Based on ControlProperties.ods analysis
 
 Dim vFullPropertiesList() As Variant
+
+       &apos;List established only once
+       If UBound(_ThisProperties) &gt; -1 Then
+               _PropertiesList = _ThisProperties
+               Exit Function
+       End If
+
        vFullPropertiesList = Array( _
                &quot;BackColor&quot; _
                , &quot;BorderColor&quot; _
@@ -1362,18 +1371,18 @@ Dim vPropertiesMatrix(25) As Variant
                        vPropertiesMatrix(acTimeField) = 
Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70)
        End Select
        
-Dim vProperties() As Variant, i As Integer, iIndex As Integer
+Dim i As Integer, iIndex As Integer
        If _ControlType = acSubForm Then iIndex = 0 Else iIndex = _ControlType
        If IsEmpty(vPropertiesMatrix(iIndex)) Then
-               vProperties = Array()
+               _ThisProperties = Array()
        Else
-               ReDim vProperties(0 To UBound(vPropertiesMatrix(iIndex)))
-               For i = 0 To UBound(vProperties)
-                       vProperties(i) = 
vFullPropertiesList(vPropertiesMatrix(iIndex)(i))
+               ReDim _ThisProperties(0 To UBound(vPropertiesMatrix(iIndex)))
+               For i = 0 To UBound(_ThisProperties)
+                       _ThisProperties(i) = 
vFullPropertiesList(vPropertiesMatrix(iIndex)(i))
                Next i
        End If
 
-       _PropertiesList = vProperties()
+       _PropertiesList = _ThisProperties()
 
 End Function   &apos;  _PropertiesList
 
@@ -1404,6 +1413,7 @@ Dim vGet As Variant, vDate As Variant
 Dim ofSubForm As Object
 Dim vFormats() As Variant
 Dim vSelection As Variant, sSelectedText As String
+Dim oControlEvents As Object, sEventName As String
        
        If Not hasProperty(psProperty) Then Goto Trace_Error
 
@@ -1590,7 +1600,18 @@ Dim vSelection As Variant, sSelectedText As String
                                , UCase(&quot;OnMouseDragged&quot;), 
UCase(&quot;OnMouseEntered&quot;), UCase(&quot;OnMouseExited&quot;), 
UCase(&quot;OnMouseMoved&quot;) _
                                , UCase(&quot;OnMousePressed&quot;), 
UCase(&quot;OnMouseReleased&quot;), UCase(&quot;OnResetted&quot;), 
UCase(&quot;OnTextChanged&quot;) _
                                , UCase(&quot;OnUpdated&quot;)
-                       _PropertyGet = Utils._GetEventScriptCode(ControlModel, 
psProperty, _Name)
+                       Select Case _ParentType
+                               Case CTLPARENTISDIALOG
+                                       Set oControlEvents = 
ControlModel.getEvents()
+                                       sEventName = 
&quot;com.sun.star.awt.&quot; &amp; _GetListener(psProperty) &amp; 
&quot;::&quot; &amp; Utils._GetEventName(psProperty)
+                                       If oControlEvents.hasByName(sEventName) 
Then
+                                               _PropertyGet = 
oControlEvents.getByName(sEventName).ScriptCode
+                                       Else
+                                               _PropertyGet = &quot;&quot;
+                                       End If
+                               Case Else
+                                       _PropertyGet = 
Utils._GetEventScriptCode(ControlModel, psProperty, _Name)
+                       End Select
                Case UCase(&quot;OptionValue&quot;)
                        If Utils._hasUNOProperty(ControlModel, 
&quot;RefValue&quot;) Then
                                If ControlModel.RefValue &lt;&gt; &quot;&quot; 
Then
@@ -1869,6 +1890,7 @@ Dim bMultiSelect As Boolean, iCount As Integer, 
iSelectedItems() As Integer, lLi
 Dim vItemList() As Variant, vFormats() As Variant
 Dim oStruct As Object, sValue As String
 Dim vSelection As Variant, sText As String, lStart As long
+Dim oControlEvents As Object, sListener As String, sEvent As String, 
sEventName As String, oEvent As Object
 
        _PropertySet = True
        Select Case UCase(_A2B_.CalledSub)
@@ -2081,11 +2103,21 @@ Dim vSelection As Variant, sText As String, lStart As 
long
                                , UCase(&quot;OnMousePressed&quot;), 
UCase(&quot;OnMouseReleased&quot;), UCase(&quot;OnResetted&quot;), 
UCase(&quot;OnTextChanged&quot;) _
                                , UCase(&quot;OnUpdated&quot;)
                        If Not Utils._CheckArgument(pvValue, iArgNr, vbString, 
, False) Then Goto Trace_Error_Value
-                       If Not Utils._RegisterEventScript(ControlModel _
-                                               , psProperty _
-                                               , _GetListener(psProperty) _
-                                               , pvValue, _Name _
-                                               ) Then GoTo Trace_Error
+                       Select Case _ParentType
+                               Case CTLPARENTISDIALOG
+                                       If Not 
Utils._RegisterDialogEventScript(ControlModel _
+                                                               , psProperty _
+                                                               , 
_GetListener(psProperty) _
+                                                               , pvValue _
+                                                               ) Then GoTo 
Trace_Error
+                               Case Else
+                                       If Not 
Utils._RegisterEventScript(ControlModel _
+                                                               , psProperty _
+                                                               , 
_GetListener(psProperty) _
+                                                               , pvValue _
+                                                               , _Name _
+                                                               ) Then GoTo 
Trace_Error
+                       End Select
                Case UCase(&quot;OptionValue&quot;)
                        If Not Utils._hasUNOProperty(ControlModel, 
&quot;RefValue&quot;) Then Goto Trace_Error
                        If Not Utils._CheckArgument(pvValue, iArgNr, vbString, 
, False) Then Goto Trace_Error_Value
diff --git a/wizards/source/access2base/Dialog.xba 
b/wizards/source/access2base/Dialog.xba
index 00d9b13db620..1d11e6ce8e1b 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -18,6 +18,8 @@ Private       _Type                                   As 
String                               &apos;  Must be DIALOG
 Private        _Name                                   As String
 Private _Shortcut                              As String
 Private _Dialog                                        As Object               
                &apos;  com.sun.star.io.XInputStreamProvider
+Private _Storage                               As String                       
        &apos;  GLOBAL or DOCUMENT
+Private _Library                               As String
 Private UnoDialog                              As Object                       
        &apos;  com.sun.star.awt.XControl
 
 REM 
-----------------------------------------------------------------------------------------------------------------------
@@ -27,6 +29,8 @@ Private Sub Class_Initialize()
        _Type = OBJDIALOG
        _Name = &quot;&quot;
        Set _Dialog = Nothing
+       _Storage = &quot;&quot;
+       _Library = &quot;&quot;
        Set UnoDialog = Nothing
 End Sub                &apos;  Constructor
 
@@ -757,19 +761,11 @@ Dim iArgNr As Integer
                                , UCase(&quot;OnMouseDragged&quot;), 
UCase(&quot;OnMouseEntered&quot;), UCase(&quot;OnMouseExited&quot;), 
UCase(&quot;OnMouseMoved&quot;) _
                                , UCase(&quot;OnMousePressed&quot;), 
UCase(&quot;OnMouseReleased&quot;)
                        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 = &quot;com.sun.star.awt.&quot; &amp; 
sListener &amp; &quot;::&quot; &amp; sEvent
-                       If oDialogEvents.hasByName(sEventName) Then 
oDialogEvents.removeByName(sEventName)
-                       Set oEvent = 
CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
-                       With oEvent
-                               .ListenerType = sListener
-                               .EventMethod = sEvent
-                               .ScriptType = &quot;Script&quot;                
        &apos;  Better than &quot;Basic&quot;
-                               .ScriptCode = pvValue
-                       End With
-                       oDialogEvents.insertByName(sEventName, oEvent)
+                       If Not Utils._RegisterDialogEventScript(UnoDialog.Model 
_
+                                               , psProperty _
+                                               , _GetListener(psProperty) _
+                                               , pvValue _
+                                               ) Then GoTo Trace_Error_Dialog
                Case UCase(&quot;Page&quot;)
                        If Not Utils._CheckArgument(pvValue, iArgNr, 
Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
                        If pvValue &lt; 0 Then Goto Trace_Error_Value
diff --git a/wizards/source/access2base/Utils.xba 
b/wizards/source/access2base/Utils.xba
index 79cebb63d0c6..42c0a4b15a24 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -964,6 +964,37 @@ Dim lEnd As Long, vResult As Object
 End Function
 
 REM 
-----------------------------------------------------------------------------------------------------------------------
+Public Function _RegisterDialogEventScript(poObject As Object _
+                                                               , ByVal psEvent 
As String _
+                                                               , ByVal 
psListener As String _
+                                                               , ByVal 
psScriptCode As String _
+                                                               ) As Boolean
+&apos; Register a script event (psEvent) to poObject (Dialog or dialog Control)
+
+Dim oEvents As Object, sEvent As String, sEventName As String, oEvent As Object
+
+       _RegisterDialogEventScript = False
+       If Not _hasUNOMethod(poObject, &quot;getEvents&quot;) Then Exit Function
+
+&apos; Remove existing event, if any, than store new script code
+       Set oEvents = poObject.getEvents()
+       sEvent = Utils._GetEventName(psEvent)
+       sEventName = &quot;com.sun.star.awt.&quot; &amp; psListener &amp; 
&quot;::&quot; &amp; sEvent
+       If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName)
+       Set oEvent = 
CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
+       With oEvent
+               .ListenerType = psListener
+               .EventMethod = sEvent
+               .ScriptType = &quot;Script&quot;                        &apos;  
Better than &quot;Basic&quot;
+               .ScriptCode = psScriptCode
+       End With
+       oEvents.insertByName(sEventName, oEvent)
+
+       _RegisterDialogEventScript = True
+
+End Function   &apos;  _RegisterDialogEventScript      V1.8.0
+
+REM 
-----------------------------------------------------------------------------------------------------------------------
 Public Function _RegisterEventScript(poObject As Object _
                                                                , ByVal psEvent 
As String _
                                                                , ByVal 
psListener As String _
diff --git a/wizards/source/access2base/acConstants.xba 
b/wizards/source/access2base/acConstants.xba
index e382996b22fc..f2aeb26ea82c 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM 
============================================================================
 Option Explicit
 
 REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = &quot;1.7.0&quot;
+Global Const Access2Base_Version = &quot;1.8.0&quot;
 
 REM AcCloseSave
 REM -----------------------------------------------------------------
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits

Reply via email to