REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === The SFDocuments library is one of the associated libraries. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Register ''' =========== ''' The ScriptForge framework includes ''' the master ScriptForge library ''' a number of "associated" libraries SF* ''' any user/contributor extension wanting to fit into the framework ''' ''' The main methods in this module allow the current library to cling to ScriptForge ''' - RegisterScriptServices ''' Register the list of services implemented by the current library ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS REM ================================================================= DEFINITIONS ''' Strategy for management of Form and FormControl events: ''' ------------------------------------------------------ ''' At the contrary of Dialogs and DialogControls, which are always started from some code, ''' Forms and FormControls will be initiated most often by the user, even if the SFDocuments library ''' allows to start forms programmatically ''' ''' For Forms started programmatically, the corresponding objects are built top-down ''' Event management of forms and their controls requires to being able to rebuild Form ''' and FormControl objects bottom-up ''' ''' To avoid multiple rebuilds requested by multiple events, ''' 1. The active form objects are cached in a global array of _FormCache types ''' 2. FormControl objects are cached in Form objects ''' 3. The bottom-up rebuild is executed only once, at instance creation Type _FormCache Terminated As Boolean XUnoForm As Object BasicForm As Object End Type REM ============================================================== PUBLIC METHODS REM ----------------------------------------------------------------------------- Public Sub RegisterScriptServices() As Variant ''' Register into ScriptForge the list of the services implemented by the current library ''' Each library pertaining to the framework must implement its own version of this method ''' ''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods ''' with 2 arguments: ''' ServiceName: the name of the service as a case-insensitive string ''' ServiceReference: the reference as an object ''' If the reference refers to a module, then return the module as an object: ''' GlobalScope.Library.Module ''' If the reference is a class instance, then return a string referring to the method ''' containing the New statement creating the instance ''' "libraryname.modulename.function" With GlobalScope.ScriptForge.SF_Services .RegisterService("Document", "SFDocuments.SF_Register._NewDocument") ' Reference to the function initializing the service .RegisterService("Base", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function .RegisterService("Calc", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function .RegisterService("Writer", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function .RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager .RegisterEventManager("FormEvent", "SFDocuments.SF_Register._FormEventManager")' Reference to the form and controls events manager End With End Sub ' SFDocuments.SF_Register.RegisterScriptServices REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _AddFormToCache(ByRef pvUnoForm As Object _ , ByRef pvBasicForm As Object _ ) As Long ''' Add a new entry in the cache array with the references of the actual Form ''' If relevant, the last entry of the cache is reused. ''' The cache is located in the global _SF_ variable ''' Args: ''' pvUnoForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm ''' pvBasicForm: its corresponding Basic object ''' Returns: ''' The index of the new or modified entry Dim vCache As New _FormCache ' Entry to be added Dim lIndex As Long ' UBound of _SF_.SFForms Dim vCacheArray As Variant ' Alias of _SF_.SFForms Try: vCacheArray = _SF_.SFForms If IsEmpty(vCacheArray) Then vCacheArray = Array() lIndex = UBound(vCacheArray) If lIndex < LBound(vCacheArray) Then ReDim vCacheArray(0 To 0) lIndex = 0 ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused lIndex = lIndex + 1 ReDim Preserve vCacheArray(0 To lIndex) End If With vCache .Terminated = False Set .XUnoForm = pvUnoForm Set .BasicForm = pvBasicForm End With Set vCacheArray(lIndex) = vCache _SF_.SFForms = vCacheArray Finally: _AddFormToCache = lIndex Exit Function End Function ' SFDocuments.SF_Register._AddFormToCache REM ----------------------------------------------------------------------------- Private Sub _CleanCacheEntry(ByVal plIndex As Long) ''' Clean the plIndex-th entry in the Forms cache ''' Args: ''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored Dim vCache As New _FormCache ' Cleaned entry With _SF_ If Not IsArray(.SFForms) Then Exit Sub If plIndex < LBound(.SFForms) Or plIndex > UBound(.SFForms) Then Exit Sub With vCache .Terminated = True Set .XUnoForm = Nothing Set .BasicForm = Nothing End With .SFForms(plIndex) = vCache End With Finally: Exit Sub End Sub ' SFDocuments.SF_Register._CleanCacheEntry REM ----------------------------------------------------------------------------- Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object ''' Returns a Document, Calc or Base object corresponding with the active component ''' which triggered the event in argument ''' This method should be triggered only thru the invocation of CreateScriptService ''' Args: ''' pvEvent: com.sun.star.document.DocumentEvent ''' Returns: ''' the output of a Document, Calc, ... service or Nothing ''' Example: ''' Sub TriggeredByEvent(ByRef poEvent As Object) ''' Dim oDoc As Object ''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent) ''' If Not IsNull(oDoc) Then ''' ' ... (a valid document has been identified) ''' End Sub Dim oSource As Object ' Return value Dim vEvent As Variant ' Alias of pvArgs(0) ' Never abort while an event is processed If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally Set oSource = Nothing Check: If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else Set vEvent = Empty If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally Try: If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then Set oSource = SF_Register._NewDocument(vEvent.Source) End If Finally: Set _EventManager = oSource Exit Function End Function ' SFDocuments.SF_Register._EventManager REM ----------------------------------------------------------------------------- Private Function _FindFormInCache(ByRef poForm As Object) As Object ''' Find the Form based on its XUnoForm ''' The Form must not be terminated ''' Returns: ''' The corresponding Basic Form part or Nothing Dim oBasicForm As Object ' Return value Dim oCache As _FormCache ' Entry in the cache Set oBasicForm = Nothing Try: With _SF_ If Not IsEmpty(.SFForms) Then For Each oCache In .SFForms If EqualUnoObjects(poForm, oCache.XUnoForm) And Not oCache.Terminated Then Set oBasicForm = oCache.BasicForm Exit For End If Next oCache End If End With Finally: Set _FindFormInCache = oBasicForm Exit Function End Function ' SFDocuments.SF_Register._FindFormInCache REM ----------------------------------------------------------------------------- Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object ''' Returns a Form or FormControl object corresponding with the form or control ''' which triggered the event in argument ''' This method should be triggered only thru the invocation of CreateScriptService ''' Args: ''' pvEvent: com.sun.star.lang.EventObject ''' Returns: ''' the output of a Form, FormControl service or Nothing ''' Example: ''' Sub TriggeredByEvent(ByRef poEvent As Object) ''' Dim oForm As Object ''' Set oForm = CreateScriptService("SFDocuments.FormEvent", poEvent) ''' If Not IsNull(oForm) Then ''' ' ... (a valid form or subform has been identified) ''' End Sub Dim oSource As Object ' Return value Dim vEvent As Variant ' Alias of pvArgs(0) Dim oControlModel As Object ' com.sun.star.awt.XControlModel Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm" Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl Dim oSFForm As Object ' The grand-parent SF_Form instance Dim oSession As Object : Set oSession = ScriptForge.SF_Session ' Never abort while an event is processed If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally Set oSource = Nothing Check: If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else Set vEvent = Empty If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally Try: If oSession.HasUnoProperty(vEvent, "Source") Then ' FORM EVENT If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True) ' CONTROL EVENT Else ' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl Set oParent = oControlModel.Parent sParentType = oSession.UnoObjectType(oParent) Select Case sParentType Case "com.sun.star.form.OGridControlModel" Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True) Set oSFParent = oSFForm.Controls(oParent.Name) Case "com.sun.star.comp.forms.ODatabaseForm" Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True) End Select ' The final instance is derived from its parent instance Set oSource = oSFParent.Controls(oControlModel.Name) End If End If Finally: Set _FormEventManager = oSource Exit Function End Function ' SFDocuments.SF_Register._FormEventManager REM ----------------------------------------------------------------------------- Public Function _GetEventScriptCode(poObject As Object _ , ByVal psEvent As String _ , ByVal psName As String _ ) As String ''' Extract from the parent of poObject the Basic script linked to psEvent. ''' Helper function common to forms and form controls ''' Args: ''' poObject: a com.sun.star.form.XForm or XControl object ''' psEvent: the "On..." name of the event ''' psName: the name of the object to be identified from the parent object ''' Returns: ''' The script to trigger when psEvent occurs ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification Dim vEvents As Variant ' List of available events in the parent object ' Array of com.sun.star.script.ScriptEventDescriptor Dim sEvent As String ' The targeted event name Dim oParent As Object ' The parent object Dim lIndex As Long ' The index of the targeted event in the events list of the parent object Dim sName As String ' The corrected UNO event name Dim i As Long _GetEventScriptCode = "" On Local Error GoTo Catch If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally Try: ' Find form index i.e. find control via getByIndex() ' The name is known (= psName) but getByIndex() is not in the same sequence as getElementNames() Set oParent = poObject.getParent() lIndex = -1 For i = 0 To oParent.getCount() - 1 sName = oParent.getByIndex(i).Name If (sName = psName) Then lIndex = i Exit For End If Next i If lIndex < 0 Then GoTo Finally ' Not found, should not happen ' Find script triggered by event vEvents = oParent.getScriptEvents(lIndex) ' Returns an array ' Fix historical typo error sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured") For i = 0 To UBound(vEvents) If vEvents(i).EventMethod = sEvent Then _GetEventScriptCode = vEvents(i).ScriptCode Exit For End If Next i Finally: Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Register._GetEventScriptCode REM ----------------------------------------------------------------------------- Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...) ' Args: ''' WindowName: see the definition of WindowName in the description of the UI service ''' If absent, the document is presumed to be in the active window ''' If WindowName is an object, it must be a component ''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument) ''' Returns: the instance or Nothing Dim oDocument As Object ' Return value Dim oSuperDocument As Object ' Companion superclass document Dim vWindowName As Variant ' Alias of pvArgs(0) Dim oEnum As Object ' com.sun.star.container.XEnumeration Dim oComp As Object ' com.sun.star.lang.XComponent Dim vWindow As Window ' A single component Dim oUi As Object ' "UI" service Dim bFound As Boolean ' True if the document is found on the desktop If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDocument called from _EventManager If UBound(pvArgs) >= 0 Then vWindowName = pvArgs(0) Else vWindowName = "" If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally Set oDocument = Nothing Try: Set oUi = ScriptForge.SF_Services.CreateScriptService("UI") Select Case VarType(vWindowName) Case V_STRING If Len(vWindowName) > 0 Then bFound = False Set oEnum = StarDesktop.Components().createEnumeration Do While oEnum.hasMoreElements Set oComp = oEnum.nextElement vWindow = oUi._IdentifyWindow(oComp) With vWindow ' Does the current window match the argument ? If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vWindowName)) _ Or (Len(.WindowName) > 0 And .WindowName = vWindowName) _ Or (Len(.WindowTitle) > 0 And .WindowTitle = vWindowName) Then bFound = True Exit Do End If End With Loop Else bFound = True vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent) End If Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent bFound = True vWindow = oUi._IdentifyWindow(vWindowName) End Select If bFound And Not IsNull(vWindow.Frame) And Len(vWindow.DocumentType) > 0 Then ' Create the right subclass and associate to it a new instance of the superclass Select Case vWindow.DocumentType Case "Base" Set oDocument = New SF_Base Set oSuperDocument = New SF_Document Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned Set oSuperDocument.[_SubClass] = oDocument Case "Calc" Set oDocument = New SF_Calc Set oSuperDocument = New SF_Document Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned Set oSuperDocument.[_SubClass] = oDocument Case "Writer" Set oDocument = New SF_Writer Set oSuperDocument = New SF_Document Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned Set oSuperDocument.[_SubClass] = oDocument Case Else ' Only superclass Set oDocument = New SF_Document Set oSuperDocument = oDocument End Select With oDocument ' Initialize attributes of subclass Set .[Me] = oDocument Set ._Component = vWindow.Component ' Initialize specific attributes Select Case vWindow.DocumentType Case "Base" Set ._DataSource = ._Component.DataSource Case Else End Select End With With oSuperDocument ' Initialize attributes of superclass Set .[Me] = oSuperDocument Set ._Component = vWindow.Component Set ._Frame = vWindow.Frame ._WindowName = vWindow.WindowName ._WindowTitle = vWindow.WindowTitle ._WindowFileName = vWindow.WindowFileName ._DocumentType = vWindow.DocumentType End With End If Finally: Set _NewDocument = oDocument Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Register._NewDocument REM ----------------------------------------------------------------------------- Public Function _NewForm(ByRef poForm As Object _ , Optional pbForceInit As Boolean _ ) As Object ''' Returns an existing or a new SF_Form instance based on the argument ''' If the instance is new (not found in cache), the minimal members are initialized ''' Args: ''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm ''' pbForceInit: when True, initialize the form instance. Default = False ''' Returns: ''' A SF_Form instance Dim oForm As Object ' Return value Try: Set oForm = SF_Register._FindFormInCache(poForm) If IsNull(oForm) Then ' Not found If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False Set oForm = New SF_Form With oForm ._Name = poForm.Name Set .[Me] = oForm Set ._Form = poForm If pbForceInit Then ._Initialize() End With End If Finally: Set _NewForm = oForm Exit Function End Function ' SFDocuments.SF_Register._NewForm REM ----------------------------------------------------------------------------- Public Function _RegisterEventScript(poObject As Object _ , ByVal psEvent As String _ , ByVal psListener As String _ , ByVal psScriptCode As String _ , ByVal psName As String _ ) As Boolean ''' Register a script event (psEvent) to poObject (Form, SubForm or Control) ''' Args: ''' poObject: a com.sun.star.form.XForm or XControl object ''' psEvent: the "On..." name of the event ''' psListener: the listener name corresponding with the event ''' psScriptCode: The script to trigger when psEvent occurs ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification ''' psName: the name of the object to associate with the event ''' Returns: ''' True when successful Dim oEvent As Object ' com.sun.star.script.ScriptEventDescriptor Dim sEvent As String ' The targeted event name Dim oParent As Object ' The parent object Dim lIndex As Long ' The index of the targeted event in the events list of the parent object Dim sName As String ' The corrected UNO event name Dim i As Long _RegisterEventScript = False On Local Error GoTo Catch If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally Try: ' Find object's internal index i.e. how to reach it via getByIndex() Set oParent = poObject.getParent() lIndex = -1 For i = 0 To oParent.getCount() - 1 sName = oParent.getByIndex(i).Name If (sName = psName) Then lIndex = i Exit For End If Next i If lIndex < 0 Then GoTo Finally ' Not found, should not happen ' Fix historical typo error sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured") ' Apply new script code. Erasing it is done with a specific UNO method If psScriptCode = "" Then oParent.revokeScriptEvent(lIndex, psListener, sEvent, "") Else Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor") With oEvent .ListenerType = psListener .EventMethod = sEvent .ScriptType = "Script" ' Better than "Basic" .ScriptCode = psScriptCode End With oParent.registerScriptEvent(lIndex, oEvent) End If _RegisterEventScript = True Finally: Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Register._RegisterEventScript REM ============================================== END OF SFDOCUMENTS.SF_REGISTER