[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Sat Aug 5 13:57:01 UTC 2017
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 <jp at 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 = "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 -----------------------------------------------------------------
More information about the Libreoffice-commits
mailing list