diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2017-08-05 15:52:00 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2017-08-05 15:52:00 +0200 |
commit | 39a6524625a3a682cf53128b5544cd7f2f75f3f1 (patch) | |
tree | fe1685a089a43e276d099ca24f70a89fb5a58c84 | |
parent | updater: disable lang pack handling for windows (diff) | |
download | core-39a6524625a3a682cf53128b5544cd7f2f75f3f1.tar.gz core-39a6524625a3a682cf53128b5544cd7f2f75f3f1.zip |
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
-rw-r--r-- | wizards/source/access2base/Application.xba | 18 | ||||
-rw-r--r-- | wizards/source/access2base/Control.xba | 56 | ||||
-rw-r--r-- | wizards/source/access2base/Dialog.xba | 22 | ||||
-rw-r--r-- | wizards/source/access2base/Utils.xba | 31 | ||||
-rw-r--r-- | wizards/source/access2base/acConstants.xba | 2 |
5 files changed, 97 insertions, 32 deletions
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 = "AllDialogs" 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 = "!" Set vAllDialogs = Nothing - Set oDocLibraries = ThisComponent.DialogLibraries + Set oDocLibraries = _A2B_.CurrentDocument.Document.DialogLibraries ' ThisComponent.DialogLibraries vDocLibraries = oDocLibraries.getElementNames() Set oMacLibraries = DialogLibraries vMacLibraries = oMacLibraries.getElementNames() @@ -236,11 +236,13 @@ Const cstSepar = "!" bFound = False If i <= UBound(vDocLibraries) Then sLibrary = vDocLibraries(i) + bLocalStorage = True Set oDocMacLib = oDocLibraries ' 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 = "!" 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 = "Dialogs!" & vDialogs(j) - Set vAllDialogs._Dialog = oLibDialog + With vAllDialogs + ._Name = vDialogs(j) + ._Shortcut = "Dialogs!" & vDialogs(j) + Set ._Dialog = oLibDialog + ._Library = sLibrary + ._Storage = Iif(bLocalStorage, "DOCUMENT", "GLOBAL") + End With End If Exit_Function: @@ -447,7 +453,7 @@ Const cstDot = "." Set vAllModules = Nothing - Set oDocLibraries = ThisComponent.BasicLibraries + Set oDocLibraries = _A2B_.CurrentDocument.Document.BasicLibraries ' 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 ' com.sun.star.text.TextDocument Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure Private _DbEntry As Integer Private _ControlType As Integer +Private _ThisProperties As Variant ' Buffer for properties list Private _SubType As String Private ControlModel As Object ' com.sun.star.comp.forms.XXXModel Private ControlView As Object ' 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 = "" Set ControlModel = Nothing Set ControlView = Nothing @@ -1226,6 +1228,13 @@ Private Function _PropertiesList() As Variant ' Based on ControlProperties.ods analysis Dim vFullPropertiesList() As Variant + + 'List established only once + If UBound(_ThisProperties) > -1 Then + _PropertiesList = _ThisProperties + Exit Function + End If + vFullPropertiesList = Array( _ "BackColor" _ , "BorderColor" _ @@ -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 ' _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("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _ , UCase("OnUpdated") - _PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name) + Select Case _ParentType + Case CTLPARENTISDIALOG + Set oControlEvents = ControlModel.getEvents() + sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty) + If oControlEvents.hasByName(sEventName) Then + _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode + Else + _PropertyGet = "" + End If + Case Else + _PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name) + End Select Case UCase("OptionValue") If Utils._hasUNOProperty(ControlModel, "RefValue") Then If ControlModel.RefValue <> "" 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("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _ , UCase("OnUpdated") 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("OptionValue") If Not Utils._hasUNOProperty(ControlModel, "RefValue") 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 ' Must be DIALOG Private _Name As String Private _Shortcut As String Private _Dialog As Object ' com.sun.star.io.XInputStreamProvider +Private _Storage As String ' GLOBAL or DOCUMENT +Private _Library As String Private UnoDialog As Object ' com.sun.star.awt.XControl REM ----------------------------------------------------------------------------------------------------------------------- @@ -27,6 +29,8 @@ Private Sub Class_Initialize() _Type = OBJDIALOG _Name = "" Set _Dialog = Nothing + _Storage = "" + _Library = "" Set UnoDialog = Nothing End Sub ' Constructor @@ -757,19 +761,11 @@ Dim iArgNr As Integer , 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) + If Not Utils._RegisterDialogEventScript(UnoDialog.Model _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue _ + ) Then GoTo Trace_Error_Dialog 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 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 +' 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, "getEvents") Then Exit Function + +' Remove existing event, if any, than store new script code + Set oEvents = poObject.getEvents() + sEvent = Utils._GetEventName(psEvent) + sEventName = "com.sun.star.awt." & psListener & "::" & sEvent + If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName) + Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor") + With oEvent + .ListenerType = psListener + .EventMethod = sEvent + .ScriptType = "Script" ' Better than "Basic" + .ScriptCode = psScriptCode + End With + oEvents.insertByName(sEventName, oEvent) + + _RegisterDialogEventScript = True + +End Function ' _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 = "1.7.0" +Global Const Access2Base_Version = "1.8.0" REM AcCloseSave REM ----------------------------------------------------------------- |