| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546 |
- <?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>
|
