diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
| commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
| tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/sfdocuments/SF_Register.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.tar.xz libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.zip | |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/sfdocuments/SF_Register.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Register.xba | 546 |
1 files changed, 546 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Register.xba b/wizards/source/sfdocuments/SF_Register.xba new file mode 100644 index 000000000..5baf37afb --- /dev/null +++ b/wizards/source/sfdocuments/SF_Register.xba @@ -0,0 +1,546 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">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 +</script:module>
\ No newline at end of file |