Current File : //usr/lib/libreoffice/share/basic/ScriptForge/SF_UI.xba
<?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_UI" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === Full documentation is available on https://help.libreoffice.org/ ===
REM =======================================================================================================================
Option Compatible
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_UI
''' =====
''' Singleton class module for the identification and the manipulation of the
''' different windows composing the whole LibreOffice application:
''' - Windows selection
''' - Windows moving and resizing
''' - Statusbar settings
''' - Creation of new windows
''' - Access to the underlying "documents"
'''
''' WindowName: how to designate a window. It can be either
''' a full FileName given in the notation indicated by the current value of SF_FileSystem.FileNaming
''' or the last component of the full FileName or even only its BaseName
''' or the title of the window
''' or, for new documents, something like "Untitled 1"
''' or one of the special windows "BASICIDE" and "WELCOMESCREEN"
''' The window search is case-sensitive
'''
''' Service invocation example:
''' Dim ui As Variant
''' ui = CreateScriptService("UI")
'''
''' Detailed user documentation:
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_ui.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
Const DOCUMENTERROR = "DOCUMENTERROR" ' Requested document was not found
Const DOCUMENTCREATIONERROR = "DOCUMENTCREATIONERROR" ' Incoherent arguments, new document could not be created
Const DOCUMENTOPENERROR = "DOCUMENTOPENERROR" ' Document could not be opened, check the arguments
Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" ' Id. for Base document
Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Calc datasource does not exist
REM ============================================================= PRIVATE MEMBERS
Type Window
Component As Object ' com.sun.star.lang.XComponent
Frame As Object ' com.sun.star.comp.framework.Frame
WindowName As String ' Object Name
WindowTitle As String ' Only mean to identify new documents
WindowFileName As String ' URL of file name
DocumentType As String ' Writer, Calc, ...
ParentName As String ' Identifier of the parent Base file when Window is a subcomponent
End Type
Type _Toolbar ' Proto-toolbar object. Passed to the "Toolbar" service, a full ScriptForge Toolbar object will be returned
Component As Object ' com.sun.star.lang.XComponent
ResourceURL As String ' Toolbar internal name
UIName As String ' Toolbar external name, may be ""
UIConfigurationManager As Object ' com.sun.star.ui.XUIConfigurationManager
ElementsInfoIndex As Long ' Index of the toolbar in the getElementsInfo(0) array
Storage As Long ' One of the toolbar location constants
End Type
' The progress/status bar of the active window
'Private oStatusBar As Object ' com.sun.star.task.XStatusIndicator
REM ============================================================ MODULE CONSTANTS
' Special windows
Const BASICIDE = "BASICIDE"
Const WELCOMESCREEN = "WELCOMESCREEN"
' Document types (only if not 1 of the special windows)
Const BASEDOCUMENT = "Base"
Const CALCDOCUMENT = "Calc"
Const DRAWDOCUMENT = "Draw"
Const FORMDOCUMENT = "FormDocument"
Const IMPRESSDOCUMENT = "Impress"
Const MATHDOCUMENT = "Math"
Const WRITERDOCUMENT = "Writer"
' Window subtypes
Const TABLEDATA = "TableData"
Const QUERYDATA = "QueryData"
Const SQLDATA = "SqlData"
Const BASEREPORT = "BaseReport"
Const BASEDIAGRAM = "BaseDiagram"
' Macro execution modes
Const cstMACROEXECNORMAL = 0 ' Default, execution depends on user configuration and choice
Const cstMACROEXECNEVER = 1 ' Macros are not executed
Const cstMACROEXECALWAYS = 2 ' Macros are always executed
' Toolbar locations
Const cstBUILTINTOOLBAR = 0 ' Standard toolbar
Const cstCUSTOMTOOLBAR = 1 ' Toolbar added by user and stored in the LibreOffice application
Const cstCUSTOMDOCTOOLBAR = 2 ' Toolbar added by user solely for a single document
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
Set Dispose = Nothing
End Function ' ScriptForge.SF_UI Explicit destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Public Function ActiveWindow() As String
''' Returns a valid WindowName for the currently active window
''' When "" is returned, the window could not be identified
Dim vWindow As Window ' A component
Dim oComp As Object ' com.sun.star.lang.XComponent
Set oComp = StarDesktop.CurrentComponent
If Not IsNull(oComp) Then
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
If Len(.WindowFileName) > 0 Then
ActiveWindow = SF_FileSystem._ConvertFromUrl(.WindowFileName)
ElseIf Len(.WindowName) > 0 Then
ActiveWindow = .WindowName
ElseIf Len(.WindowTitle) > 0 Then
ActiveWindow = .WindowTitle
Else
ActiveWindow = ""
End If
End With
End If
End Function ' ScriptForge.SF_UI.ActiveWindow
REM -----------------------------------------------------------------------------
Property Get Height() As Long
''' Returns the height of the active window
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
Set oPosSize = SF_UI._PosSize()
If Not IsNull(oPosSize) Then Height = oPosSize.Height Else Height = -1
End Property ' ScriptForge.SF_UI.Height
REM -----------------------------------------------------------------------------
Property Get MACROEXECALWAYS As Integer
''' Macros are always executed
MACROEXECALWAYS = cstMACROEXECALWAYS
End Property ' ScriptForge.SF_UI.MACROEXECALWAYS
REM -----------------------------------------------------------------------------
Property Get MACROEXECNEVER As Integer
''' Macros are not executed
MACROEXECNEVER = cstMACROEXECNEVER
End Property ' ScriptForge.SF_UI.MACROEXECNEVER
REM -----------------------------------------------------------------------------
Property Get MACROEXECNORMAL As Integer
''' Default, execution depends on user configuration and choice
MACROEXECNORMAL = cstMACROEXECNORMAL
End Property ' ScriptForge.SF_UI.MACROEXECNORMAL
REM -----------------------------------------------------------------------------
Property Get ObjectType As String
''' Only to enable object representation
ObjectType = "SF_UI"
End Property ' ScriptForge.SF_UI.ObjectType
REM -----------------------------------------------------------------------------
Property Get ServiceName As String
''' Internal use
ServiceName = "ScriptForge.UI"
End Property ' ScriptForge.SF_UI.ServiceName
REM -----------------------------------------------------------------------------
Property Get Width() As Long
''' Returns the width of the active window
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
Set oPosSize = SF_UI._PosSize()
If Not IsNull(oPosSize) Then Width = oPosSize.Width Else Width = -1
End Property ' ScriptForge.SF_UI.Width
REM -----------------------------------------------------------------------------
Property Get X() As Long
''' Returns the X coordinate of the active window
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
Set oPosSize = SF_UI._PosSize()
If Not IsNull(oPosSize) Then X = oPosSize.X Else X = -1
End Property ' ScriptForge.SF_UI.X
REM -----------------------------------------------------------------------------
Property Get Y() As Long
''' Returns the Y coordinate of the active window
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
Set oPosSize = SF_UI._PosSize()
If Not IsNull(oPosSize) Then Y = oPosSize.Y Else Y = -1
End Property ' ScriptForge.SF_UI.Y
REM ===================================================================== METHODS
REM -----------------------------------------------------------------------------
Public Function Activate(Optional ByVal WindowName As Variant) As Boolean
''' Make the specified window active
''' Args:
''' WindowName: see definitions
''' Returns:
''' True if the given window is found and can be activated
''' There is no change in the actual user interface if no window matches the selection
''' Examples:
''' ui.Activate("C:\Me\My file.odt")
Dim bActivate As Boolean ' Return value
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 oContainer As Object ' com.sun.star.awt.XWindow
Const cstThisSub = "UI.Activate"
Const cstSubArgs = "WindowName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bActivate = False
Check:
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(WindowName, "WindowName") Then GoTo Finally
End If
Try:
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements
Set oComp = oEnum.nextElement
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
' Does the current window match the arguments ?
If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem._ConvertToUrl(WindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = WindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then
Set oContainer = vWindow.Frame.ContainerWindow
With oContainer
If .isVisible() = False Then .setVisible(True)
.IsMinimized = False
.setFocus()
.toFront() ' Force window change in Linux
Wait 1 ' Bypass desynchro issue in Linux
End With
bActivate = True
Exit Do
End If
End With
Loop
Finally:
Activate = bActivate
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI.Activate
REM -----------------------------------------------------------------------------
Public Function CreateBaseDocument(Optional ByVal FileName As Variant _
, Optional ByVal EmbeddedDatabase As Variant _
, Optional ByVal RegistrationName As Variant _
, Optional ByVal CalcFileName As Variant _
) As Object
''' Create a new LibreOffice Base document embedding an empty database of the given type
''' Args:
''' FileName: Identifies the file to create. It must follow the SF_FileSystem.FileNaming notation
''' If the file already exists, it is overwritten without warning
''' EmbeddedDatabase: either "HSQLDB" (default) or "FIREBIRD" or "CALC"
''' RegistrationName: the name used to store the new database in the databases register
''' If "" (default), no registration takes place
''' If the name already exists it is overwritten without warning
''' CalcFileName: only when EmbedddedDatabase = "CALC", the name of the file containing the tables as Calc sheets
''' The name of the file must be given in SF_FileSystem.FileNaming notation
''' The file must exist
''' Returns:
''' A SFDocuments.SF_Document object or one of its subclasses
''' Exceptions
''' UNKNOWNFILEERROR Calc datasource does not exist
''' Examples:
''' Dim myBase As Object, myCalcBase As Object
''' Set myBase = ui.CreateBaseDocument("C:\Databases\MyBaseFile.odb", "FIREBIRD")
''' Set myCalcBase = ui.CreateBaseDocument("C:\Databases\MyCalcBaseFile.odb", "CALC", , "C:\Databases\MyCalcFile.ods")
Dim oCreate As Variant ' Return value
Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
Dim oDatabase As Object ' com.sun.star.comp.dba.ODatabaseSource
Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
Dim sFileName As String ' Alias of FileName
Dim FSO As Object ' Alias for FileSystem service
Const cstDocType = "private:factory/s"
Const cstThisSub = "UI.CreateBaseDocument"
Const cstSubArgs = "FileName, [EmbeddedDatabase=""HSQLDB""|""FIREBIRD""|""CALC""], [RegistrationName=""""], [CalcFileName]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oCreate = Nothing
Set FSO = CreateScriptService("FileSystem")
Check:
If IsMissing(EmbeddedDatabase) Or IsEmpty(EmbeddedDatabase) Then EmbeddedDatabase = "HSQLDB"
If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
If IsMissing(CalcFileName) Or IsEmpty(CalcFileName) Then CalcFileName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
If Not SF_Utils._Validate(EmbeddedDatabase, "EmbeddedDatabase", V_STRING, Array("CALC", "HSQLDB", "FIREBIRD")) Then GoTo Finally
If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally
If UCase(EmbeddedDatabase) = "CALC" Then
If Not SF_Utils._ValidateFile(CalcFileName, "CalcFileName") Then GoTo Finally
If Not FSO.FileExists(CalcFileName) Then GoTo CatchNotExists
End If
End If
Try:
Set oDBContext = SF_Utils._GetUNOService("DatabaseContext")
With oDBContext
Set oDatabase = .createInstance()
' Build the url link to the database
Select Case UCase(EmbeddedDatabase)
Case "HSQLDB", "FIREBIRD"
oDatabase.URL = "sdbc:embedded:" & LCase(EmbeddedDatabase)
Case "CALC"
oDatabase.URL = "sdbc:calc:" & FSO._ConvertToUrl(CalcFileName)
End Select
' Create empty Base document
sFileName = FSO._ConvertToUrl(FileName)
' An existing file is overwritten without warning
If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName)
If FSO.FileExists(FileName & ".lck") Then FSO.DeleteFile(FileName & ".lck")
oDatabase.DatabaseDocument.storeAsURL(sFileName, Array(SF_Utils._MakePropertyValue("Overwrite", True)))
' Register database if requested
If Len(RegistrationName) > 0 Then
If .hasRegisteredDatabase(RegistrationName) Then
.changeDatabaseLocation(RegistrationName, sFileName)
Else
.registerDatabaseLocation(RegistrationName, sFileName)
End If
End If
End With
Set oCreate = OpenBaseDocument(FileName)
Finally:
Set CreateBaseDocument = oCreate
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "CalcFileName", CalcFileName)
GoTo Finally
End Function ' ScriptForge.SF_UI.CreateBaseDocument
REM -----------------------------------------------------------------------------
Public Function CreateDocument(Optional ByVal DocumentType As Variant _
, Optional ByVal TemplateFile As Variant _
, Optional ByVal Hidden As Variant _
) As Object
''' Create a new LibreOffice document of a given type or based on a given template
''' Args:
''' DocumentType: "Calc", "Writer", etc. If absent, a TemplateFile must be given
''' TemplateFile: the full FileName of the template to build the new document on
''' If the file does not exist, the argument is ignored
''' The "FileSystem" service provides the TemplatesFolder and UserTemplatesFolder
''' properties to help to build the argument
''' Hidden: if True, open in the background (default = False)
''' To use with caution: activation or closure can only happen programmatically
''' Returns:
''' A SFDocuments.SF_Document object or one of its subclasses
''' Exceptions:
''' DOCUMENTCREATIONERROR Wrong arguments
''' Examples:
''' Dim myDoc1 As Object, myDoc2 As Object, FSO As Object
''' Set myDoc1 = ui.CreateDocument("Calc")
''' Set FSO = CreateScriptService("FileSystem")
''' Set myDoc2 = ui.CreateDocument(, FSO.BuildPath(FSO.TemplatesFolder, "personal/CV.ott"))
Dim oCreate As Variant ' Return value
Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
Dim bTemplateExists As Boolean ' True if TemplateFile is valid
Dim sNew As String ' File url
Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
Const cstDocType = "private:factory/s"
Const cstThisSub = "UI.CreateDocument"
Const cstSubArgs = "[DocumentType=""""], [TemplateFile=""""], [Hidden=False]"
'>>> If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oCreate = Nothing
Check:
If IsMissing(DocumentType) Or IsEmpty(DocumentType) Then DocumentType = ""
If IsMissing(TemplateFile) Or IsEmpty(TemplateFile) Then TemplateFile = ""
If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(DocumentType, "DocumentType", V_STRING _
, Array("", BASEDOCUMENT, CALCDOCUMENT, DRAWDOCUMENT _
, IMPRESSDOCUMENT, MATHDOCUMENT, WRITERDOCUMENT)) Then GoTo Finally
If Not SF_Utils._ValidateFile(TemplateFile, "TemplateFile", , True) Then GoTo Finally
If Not SF_Utils._Validate(Hidden, "Hidden", V_BOOLEAN) Then GoTo Finally
End If
If Len(DocumentType) + Len(TemplateFile) = 0 Then GoTo CatchError
If Len(TemplateFile) > 0 Then bTemplateExists = SF_FileSystem.FileExists(TemplateFile) Else bTemplateExists = False
If Len(DocumentType) = 0 Then
If Not bTemplateExists Then GoTo CatchError
End If
Try:
If bTemplateExists Then sNew = SF_FileSystem._ConvertToUrl(TemplateFile) Else sNew = cstDocType & LCase(DocumentType)
vProperties = Array( _
SF_Utils._MakePropertyValue("AsTemplate", bTemplateExists) _
, SF_Utils._MakePropertyValue("Hidden", Hidden) _
)
Set oComp = StarDesktop.loadComponentFromURL(sNew, "_blank", 0, vProperties)
If Not IsNull(oComp) Then Set oCreate = CreateScriptService("SFDocuments.Document", oComp)
Finally:
Set CreateDocument = oCreate
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchError:
SF_Exception.RaiseFatal(DOCUMENTCREATIONERROR, "DocumentType", DocumentType, "TemplateFile", TemplateFile)
GoTo Finally
End Function ' ScriptForge.SF_UI.CreateDocument
REM -----------------------------------------------------------------------------
Public Function Documents() As Variant
''' Returns the list of the currently open documents. Special windows are ignored.
''' Returns:
''' A zero-based 1D array of filenames (in SF_FileSystem.FileNaming notation)
''' or of window titles for unsaved documents
''' Examples:
''' Dim vDocs As Variant, sDoc As String
''' vDocs = ui.Documents()
''' For each sDoc In vDocs
''' ...
Dim vDocuments As Variant ' Return value
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
Const cstThisSub = "UI.Documents"
Const cstSubArgs = ""
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vDocuments = Array()
Check:
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements
Set oComp = oEnum.nextElement
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
If Len(.WindowFileName) > 0 Then
vDocuments = SF_Array.Append(vDocuments, SF_FileSystem._ConvertFromUrl(.WindowFileName))
ElseIf Len(.WindowTitle) > 0 Then
vDocuments = SF_Array.Append(vDocuments, .WindowTitle)
End If
End With
Loop
Finally:
Documents = vDocuments
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI.Documents
REM -----------------------------------------------------------------------------
Public Function GetDocument(Optional ByVal WindowName As Variant) As Variant
''' Returns a SFDocuments.Document object referring to the active window or the given window
''' Args:
''' WindowName: when a string, see definitions. If absent the active window is considered.
''' when an object, must be a UNO object of types
''' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument
''' Exceptions:
''' DOCUMENTERROR The targeted window could not be found
''' Examples:
''' Dim oDoc As Object
''' Set oDoc = ui.GetDocument ' or Set oDoc = ui.GetDocument(ThisComponent)
''' oDoc.Save()
Dim oDocument As Object ' Return value
Const cstThisSub = "UI.GetDocument"
Const cstSubArgs = "[WindowName]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oDocument = Nothing
Check:
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(WindowName, "WindowName", Array(V_STRING, V_OBJECT)) Then GoTo Finally
If VarType(WindowName) = V_STRING Then
If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally
End If
End If
Try:
Set oDocument = SF_Services.CreateScriptService("SFDocuments.Document", WindowName)
If IsNull(oDocument) Then GoTo CatchDeliver
Finally:
Set GetDocument = oDocument
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchDeliver:
SF_Exception.RaiseFatal(DOCUMENTERROR, "WindowName", WindowName)
GoTo Finally
End Function ' ScriptForge.SF_UI.GetDocument
REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Returns:
''' The actual value of the property
''' Exceptions
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "UI.GetProperty"
Const cstSubArgs = "PropertyName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
Select Case UCase(PropertyName)
Case "ACTIVEWINDOW" : GetProperty = ActiveWindow()
Case "HEIGHT" : GetProperty = SF_UI.Height
Case "WIDTH" : GetProperty = SF_UI.Width
Case "X" : GetProperty = SF_UI.X
Case "Y" : GetProperty = SF_UI.Y
Case Else
End Select
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI.GetProperty
REM -----------------------------------------------------------------------------
Public Sub Maximize(Optional ByVal WindowName As Variant)
''' Maximizes the active window or the given window
''' Args:
''' WindowName: see definitions. If absent the active window is considered
''' Examples:
''' ui.Maximize
''' ...
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 oContainer As Object ' com.sun.star.awt.XWindow
Dim bFound As Boolean ' True if window found
Const cstThisSub = "UI.Maximize"
Const cstSubArgs = "[WindowName]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally
End If
Try:
bFound = False
If Len(WindowName) > 0 Then
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements And Not bFound
Set oComp = oEnum.nextElement
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
' Does the current window match the arguments ?
If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = WindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then bFound = True
End With
Loop
Else
vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
bFound = True
End If
If bFound Then
Set oContainer = vWindow.Frame.ContainerWindow
oContainer.IsMaximized = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.Maximize
REM -----------------------------------------------------------------------------
Public Sub Minimize(Optional ByVal WindowName As Variant)
''' Minimizes the current window or the given window
''' Args:
''' WindowName: see definitions. If absent the current window is considered
''' Examples:
''' ui.Minimize("myFile.ods")
''' ...
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 oContainer As Object ' com.sun.star.awt.XWindow
Dim bFound As Boolean ' True if window found
Const cstThisSub = "UI.Minimize"
Const cstSubArgs = "[WindowName]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(WindowName, "WindowName", , True) Then GoTo Finally
End If
Try:
bFound = False
If Len(WindowName) > 0 Then
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements And Not bFound
Set oComp = oEnum.nextElement
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
' Does the current window match the arguments ?
If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = WindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then bFound = True
End With
Loop
Else
vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
bFound = True
End If
If bFound Then
Set oContainer = vWindow.Frame.ContainerWindow
oContainer.IsMinimized = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.Minimize
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the UI service as an array
Methods = Array("Activate" _
, "CreateBaseDocument" _
, "CreateDocument" _
, "Documents" _
, "GetDocument" _
, "Maximize" _
, "Minimize" _
, "OpenBaseDocument" _
, "OpenDocument" _
, "Resize" _
, "RunCommand" _
, "SetStatusbar" _
, "ShowProgressBar" _
, "WindowExists" _
)
End Function ' ScriptForge.SF_UI.Methods
REM -----------------------------------------------------------------------------
Public Function OpenBaseDocument(Optional ByVal FileName As Variant _
, Optional ByVal RegistrationName As Variant _
, Optional ByVal MacroExecution As Variant _
) As Object
''' Open an existing LibreOffice Base document and return a SFDocuments.Document object
''' Args:
''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
''' RegistrationName: the name of a registered database
''' It is ignored if FileName <> ""
''' MacroExecution: one of the MACROEXECxxx constants
''' Returns:
''' A SFDocuments.SF_Base object
''' Null if the opening failed, including when due to a user decision
''' Exceptions:
''' BASEDOCUMENTOPENERROR Wrong arguments
''' Examples:
''' Dim mBasec As Object, FSO As Object
''' Set myBase = ui.OpenBaseDocument("C:\Temp\myDB.odb", MacroExecution := ui.MACROEXECNEVER)
Dim oOpen As Variant ' Return value
Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
Dim sFile As String ' Alias for FileName
Dim iMacro As Integer ' Alias for MacroExecution
Const cstThisSub = "UI.OpenBaseDocument"
Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], [MacroExecution=0|1|2]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oOpen = Nothing
Check:
If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = ""
If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally
If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(MacroExecution, "MacroExecution", V_NUMERIC _
, Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally
End If
' Check the existence of FileName
If Len(FileName) = 0 Then ' FileName has precedence over RegistrationName
If Len(RegistrationName) = 0 Then GoTo CatchError
Set oDBContext = SF_Utils._GetUNOService("DatabaseContext")
If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError
FileName = SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName))
End If
If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError
Try:
With com.sun.star.document.MacroExecMode
Select Case MacroExecution
Case 0 : iMacro = .USE_CONFIG
Case 1 : iMacro = .NEVER_EXECUTE
Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN
End Select
End With
vProperties = Array(SF_Utils._MakePropertyValue("MacroExecutionMode", iMacro))
sFile = SF_FileSystem._ConvertToUrl(FileName)
Set oComp = StarDesktop.loadComponentFromURL(sFile, "_blank", 0, vProperties)
If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp)
Finally:
Set OpenBaseDocument = oOpen
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchError:
SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName)
GoTo Finally
End Function ' ScriptForge.SF_UI.OpenBaseDocument
REM -----------------------------------------------------------------------------
Public Function OpenDocument(Optional ByVal FileName As Variant _
, Optional ByVal Password As Variant _
, Optional ByVal ReadOnly As Variant _
, Optional ByVal Hidden As Variant _
, Optional ByVal MacroExecution As Variant _
, Optional ByVal FilterName As Variant _
, Optional ByVal FilterOptions As Variant _
) As Object
''' Open an existing LibreOffice document with the given options
''' Args:
''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
''' Password: To use when the document is protected
''' If wrong or absent while the document is protected, the user will be prompted to enter a password
''' ReadOnly: Default = False
''' Hidden: if True, open in the background (default = False)
''' To use with caution: activation or closure can only happen programmatically
''' MacroExecution: one of the MACROEXECxxx constants
''' FilterName: the name of a filter that should be used for loading the document
''' If present, the filter must exist
''' FilterOptions: an optional string of options associated with the filter
''' Returns:
''' A SFDocuments.SF_Document object or one of its subclasses
''' Null if the opening failed, including when due to a user decision
''' Exceptions:
''' DOCUMENTOPENERROR Wrong arguments
''' Examples:
''' Dim myDoc As Object, FSO As Object
''' Set myDoc = ui.OpenDocument("C:\Temp\myFile.odt", MacroExecution := ui.MACROEXECNEVER)
Dim oOpen As Variant ' Return value
Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
Dim sFile As String ' Alias for FileName
Dim iMacro As Integer ' Alias for MacroExecution
Const cstThisSub = "UI.OpenDocument"
Const cstSubArgs = "FileName, [Password=""""], [ReadOnly=False], [Hidden=False], [MacroExecution=0|1|2], [FilterName=""""], [FilterOptions=""""]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oOpen = Nothing
Check:
If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
If IsMissing(ReadOnly) Or IsEmpty(ReadOnly) Then ReadOnly = False
If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False
If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL
If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(ReadOnly, "ReadOnly", V_BOOLEAN) Then GoTo Finally
If Not SF_Utils._Validate(Hidden, "Hidden", V_BOOLEAN) Then GoTo Finally
If Not SF_Utils._Validate(MacroExecution, "MacroExecution", V_NUMERIC _
, Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally
If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
End If
' Check the existence of FileName and FilterName
If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError
If Len(FilterName) > 0 Then
Set oFilterFactory = SF_Utils._GetUNOService("FilterFactory")
If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
End If
Try:
With com.sun.star.document.MacroExecMode
Select Case MacroExecution
Case 0 : iMacro = .USE_CONFIG
Case 1 : iMacro = .NEVER_EXECUTE
Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN
End Select
End With
vProperties = Array( _
SF_Utils._MakePropertyValue("ReadOnly", ReadOnly) _
, SF_Utils._MakePropertyValue("Hidden", Hidden) _
, SF_Utils._MakePropertyValue("MacroExecutionMode", iMacro) _
, SF_Utils._MakePropertyValue("FilterName", FilterName) _
, SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _
)
If Len(Password) > 0 Then ' Password is to add only if <> "" !?
vProperties = SF_Array.Append(vProperties, SF_Utils._MakePropertyValue("Password", Password))
End If
sFile = SF_FileSystem._ConvertToUrl(FileName)
Set oComp = StarDesktop.loadComponentFromURL(sFile, "_blank", 0, vProperties)
If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp)
Finally:
Set OpenDocument = oOpen
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchError:
SF_Exception.RaiseFatal(DOCUMENTOPENERROR, "FileName", FileName, "Password", Password, "FilterName", FilterName)
GoTo Finally
End Function ' ScriptForge.SF_UI.OpenDocument
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Timer class as an array
Properties = Array( _
"ActiveWindow" _
, "Height" _
, "Width" _
, "X" _
, "Y" _
)
End Function ' ScriptForge.SF_UI.Properties
REM -----------------------------------------------------------------------------
Public Sub Resize(Optional ByVal Left As Variant _
, Optional ByVal Top As Variant _
, Optional ByVal Width As Variant _
, Optional ByVal Height As Variant _
)
''' Resizes and/or moves the active window. Negative arguments are ignored.
''' If the window was minimized or without arguments, it is restored
''' Args:
''' Left, Top: Distances from top and left edges of the screen
''' Width, Height: Dimensions of the window
''' Examples:
''' ui.Resize(10,,500) ' Top and Height are unchanged
''' ...
Dim vWindow As Window ' A single component
Dim oContainer As Object ' com.sun.star.awt.XWindow
Dim iPosSize As Integer ' Computes which of the 4 arguments should be considered
Const cstThisSub = "UI.Resize"
Const cstSubArgs = "[Left], [Top], [Width], [Height]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(Left) Or IsEmpty(Left) Then Left = -1
If IsMissing(Top) Or IsEmpty(Top) Then Top = -1
If IsMissing(Width) Or IsEmpty(Width) Then Width = -1
If IsMissing(Height) Or IsEmpty(Height) Then Height = -1
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Left, "Left", V_NUMERIC) Then GoTo Finally
If Not SF_Utils._Validate(Top, "Top", V_NUMERIC) Then GoTo Finally
If Not SF_Utils._Validate(Width, "Width", V_NUMERIC) Then GoTo Finally
If Not SF_Utils._Validate(Height, "Height", V_NUMERIC) Then GoTo Finally
End If
Try:
vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
If Not IsNull(vWindow.Frame) Then
Set oContainer = vWindow.Frame.ContainerWindow
iPosSize = 0
If Left >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X
If Top >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y
If Width > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH
If Height > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT
With oContainer
.IsMaximized = False
.IsMinimized = False
.setPosSize(Left, Top, Width, Height, iPosSize)
End With
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.Resize
REM -----------------------------------------------------------------------------
Public Sub RunCommand(Optional ByVal Command As Variant _
, ParamArray Args As Variant _
)
''' Run on the current window the given menu command. The command is executed with or without arguments
''' A few typical commands:
''' About, Delete, Edit, Undo, Copy, Paste, ...
''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
''' Args:
''' Command: Case-sensitive. The command itself is not checked.
''' If the command does not contain the ".uno:" prefix, it is added.
''' If nothing happens, then the command is probably wrong
''' Args: Pairs of arguments name (string), value (any)
''' Returns:
''' Examples:
''' ui.RunCommand("BasicIDEAppear", _
''' "Document", "LibreOffice Macros & Dialogs", _
''' "LibName", "ScriptForge", _
''' "Name", "SF_Session", _
''' "Line", 600)
Dim oDispatch ' com.sun.star.frame.DispatchHelper
Dim vProps As Variant ' Array of PropertyValues
Dim vValue As Variant ' A single value argument
Dim sCommand As String ' Alias of Command
Dim i As Long
Const cstPrefix = ".uno:"
Const cstThisSub = "UI.RunCommand"
Const cstSubArgs = "Command, [arg0Name, arg0Value], [arg1Name, arg1Value], ..."
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally
If Not SF_Utils._ValidateArray(Args, "Args", 1) Then GoTo Finally
For i = 0 To UBound(Args) - 1 Step 2
If Not SF_Utils._Validate(Args(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
Next i
End If
Try:
' Build array of property values
vProps = Array()
For i = 0 To UBound(Args) - 1 Step 2
If IsEmpty(Args(i + 1)) Then vValue = Null Else vValue = Args(i + 1)
vProps = SF_Array.Append(vProps, SF_Utils._MakePropertyValue(Args(i), vValue))
Next i
Set oDispatch = SF_Utils._GetUNOService("DispatchHelper")
If SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
oDispatch.executeDispatch(StarDesktop.ActiveFrame, sCommand, "", 0, vProps)
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.RunCommand
REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
, Optional ByRef Value As Variant _
) As Boolean
''' Set a new value to the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Value: its new value
''' Exceptions
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "UI.SetProperty"
Const cstSubArgs = "PropertyName, Value"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
SetProperty = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
Select Case UCase(PropertyName)
Case Else
End Select
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI.SetProperty
REM -----------------------------------------------------------------------------
Public Sub SetStatusbar(Optional ByVal Text As Variant _
, Optional ByVal Percentage As Variant _
)
''' Display a text and a progressbar in the status bar of the active window
''' Any subsequent calls in the same macro run refer to the same status bar of the same window,
''' even if the window is not active anymore
''' A call without arguments resets the status bar to its normal state.
''' Args:
''' Text: the optional text to be displayed before the progress bar
''' Percentage: the optional degree of progress between 0 and 100
''' Examples:
''' Dim i As Integer
''' For i = 0 To 100
''' ui.SetStatusbar("Progress ...", i)
''' Wait 50
''' Next i
''' ui.SetStatusbar
Dim oComp As Object
Dim oControl As Object
Dim oStatusbar As Object
Const cstThisSub = "UI.SetStatusbar"
Const cstSubArgs = "[Text], [Percentage]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(Text) Or IsEmpty(Text) Then Text = ""
If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Text, "Text", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(Percentage, "Percentage", V_NUMERIC) Then GoTo Finally
End If
Try:
Set oStatusbar = _SF_.Statusbar
With oStatusbar
If IsNull(oStatusbar) Then ' Initial call
Set oComp = StarDesktop.CurrentComponent
If Not IsNull(oComp) Then
Set oControl = Nothing
If SF_Session.HasUnoProperty(oComp, "CurrentController") Then Set oControl = oComp.CurrentController
If Not IsNull(oControl) Then
If SF_Session.HasUnoMethod(oControl, "getStatusIndicator") Then oStatusbar = oControl.getStatusIndicator()
End If
End If
If Not IsNull(oStatusbar) Then
.start("", 100)
End If
End If
If Not IsNull(oStatusbar) Then
If Len(Text) = 0 And Percentage = -1 Then
.end()
Set oStatusbar = Nothing
Else
If Len(Text) > 0 Then .setText(Text)
If Percentage >= 0 And Percentage <= 100 Then .setValue(Percentage)
End If
End If
End With
Finally:
Set _SF_.Statusbar = oStatusbar
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.SetStatusbar
REM -----------------------------------------------------------------------------
Public Sub ShowProgressBar(Optional Title As Variant _
, Optional ByVal Text As Variant _
, Optional ByVal Percentage As Variant _
, Optional ByRef _Context As Variant _
)
''' Display a non-modal dialog box. Specify its title, an explicatory text and the progress on a progressbar
''' A call without arguments erases the progress bar dialog.
''' The box will anyway vanish at the end of the macro run.
''' Args:
''' Title: the title appearing on top of the dialog box (Default = "ScriptForge")
''' Text: the optional text to be displayed above the progress bar (default = zero-length string)
''' Percentage: the degree of progress between 0 and 100. Default = 0
''' _Context: from Python, the XComponentXontext (FOR INTERNAL USE ONLY)
''' Examples:
''' Dim i As Integer
''' For i = 0 To 100
''' ui.ShowProgressBar(, "Progress ... " & i & "/100", i)
''' Wait 50
''' Next i
''' ui.ShowProgressBar
Dim bFirstCall As Boolean ' True at first invocation of method
Dim oDialog As Object ' SFDialogs.Dialog object
Dim oFixedText As Object ' SFDialogs.DialogControl object
Dim oProgressBar As Object ' SFDialogs.DialogControl object
Dim sTitle As String ' Alias of Title
Const cstThisSub = "UI.ShowProgressBar"
Const cstSubArgs = "[Title], [Text], [Percentage]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
If IsMissing(Text) Or IsEmpty(Text) Then Text = ""
If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1
If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Title, "Title", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(Text, "Text", V_STRING) Then GoTo Finally
If Not SF_Utils._Validate(Percentage, "Percentage", V_NUMERIC) Then GoTo Finally
End If
Try:
With _SF_
Set oDialog = .ProgressBarDialog
Set oFixedText = .ProgressBarText
Set oProgressBar = .ProgressBarBar
End With
With oDialog
bFirstCall = ( IsNull(oDialog) )
If Not bFirstCall Then bFirstCall = Not ._IsStillAlive(False) ' False to not raise an error
If bFirstCall Then Set oDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgProgress", _Context)
If Not IsNull(oDialog) Then
If Len(Title) = 0 And Len(Text) = 0 And Percentage = -1 Then
Set oDialog = .Dispose()
Else
.Caption = Iif(Len(Title) > 0, Title, "ScriptForge")
If bFirstCall Then
Set oFixedText = .Controls("ProgressText")
Set oProgressBar = .Controls("ProgressBar")
.Execute(Modal := False)
End If
If Len(Text) > 0 Then oFixedText.Caption = Text
oProgressBar.Value = Iif(Percentage >= 0 And Percentage <= 100, Percentage, 0)
End If
End If
End With
Finally:
With _SF_
Set .ProgressBarDialog = oDialog
Set .ProgressBarText = oFixedText
Set .ProgressBarBar = oProgressBar
End With
SF_Utils._ExitFunction(cstThisSub)
Exit Sub
Catch:
GoTo Finally
End Sub ' ScriptForge.SF_UI.ShowProgressBar
REM -----------------------------------------------------------------------------
Public Function WindowExists(Optional ByVal WindowName As Variant) As Boolean
''' Returns True if the specified window exists
''' Args:
''' WindowName: see definitions
''' Returns:
''' True if the given window is found
''' Examples:
''' ui.WindowExists("C:\Me\My file.odt")
Dim bWindowExists As Boolean ' Return value
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 oContainer As Object ' com.sun.star.awt.XWindow
Const cstThisSub = "UI.WindowExists"
Const cstSubArgs = "WindowName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bWindowExists = False
Check:
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(WindowName, "WindowName") Then GoTo Finally
End If
Try:
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements
Set oComp = oEnum.nextElement
vWindow = SF_UI._IdentifyWindow(oComp)
With vWindow
' Does the current window match the arguments ?
If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = WindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then
bWindowExists = True
Exit Do
End If
End With
Loop
Finally:
WindowExists = bWindowExists
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI.WindowExists
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Public Sub _CloseProgressBar(Optional ByRef poEvent As Object)
''' Triggered by the Close button in the dlgProgress dialog
''' to simply close the dialog
ShowProgressBar() ' Without arguments => close the dialog
End Sub ' ScriptForge.SF_UI._CloseProgressBar
REM -----------------------------------------------------------------------------
Public Function _IdentifyWindow(ByRef poComponent As Object) As Object
''' Return a Window object (definition on top of module) based on component given as argument
''' Is a shortcut to explore the most relevant properties or objects bound to a UNO component
Dim oWindow As Window ' Return value
Dim sImplementation As String ' Component's implementationname
Dim sIdentifier As String ' Component's identifier
Dim vSelection As Variant ' Array of poCOmponent.Selection property values
Dim iCommandType As Integer ' Datasheet type
Dim FSO As Object ' Alias for SF_FileSystem
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set _IdentifyWindow = Nothing
sImplementation = "" : sIdentifier = ""
Set FSO = SF_FileSystem
With oWindow
Set .Frame = Nothing
Set .Component = Nothing
.WindowName = ""
.WindowTitle = ""
.WindowFileName = ""
.DocumentType = ""
.ParentName = ""
If IsNull(poComponent) Then GoTo Finally
If SF_Session.HasUnoProperty(poComponent, "ImplementationName") Then sImplementation = poComponent.ImplementationName
If SF_Session.HasUnoProperty(poComponent, "Identifier") Then sIdentifier = poComponent.Identifier
Set .Component = poComponent
Select Case sImplementation
Case "com.sun.star.comp.basic.BasicIDE"
.WindowName = BASICIDE
Case "com.sun.star.comp.dba.ODatabaseDocument" ' No identifier
.WindowFileName = SF_Utils._GetPropertyValue(poComponent.Args, "URL")
If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
.DocumentType = BASEDOCUMENT
Case "org.openoffice.comp.dbu.ODatasourceBrowser" ' Base datasheet (table, query or sql) in read mode
Set .Frame = poComponent.Frame
If Not IsEmpty(poComponent.Selection) Then ' Empty for (F4) DatasourceBrowser !!
vSelection = poComponent.Selection
.WindowName = SF_Utils._GetPropertyValue(vSelection, "Command")
iCommandType = SF_Utils._GetPropertyValue(vSelection, "CommandType")
Select Case iCommandType
Case com.sun.star.sdb.CommandType.TABLE : .DocumentType = TABLEDATA
Case com.sun.star.sdb.CommandType.QUERY : .DocumentType = QUERYDATA
Case com.sun.star.sdb.CommandType.COMMAND : .DocumentType = SQLDATA
End Select
.ParentName = SF_Utils._GetPropertyValue(vSelection, "DataSourceName")
.WindowTitle = .WindowName
End If
Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign" ' Table or Query in Edit mode
Case "org.openoffice.comp.dbu.ORelationDesign"
Case "com.sun.star.comp.sfx2.BackingComp" ' Welcome screen
Set .Frame = poComponent.Frame
.WindowName = WELCOMESCREEN
Case Else
If Len(sIdentifier) > 0 Then
' Do not use URL : it contains the TemplateFile when new documents are created from a template
.WindowFileName = poComponent.Location
If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
If SF_Session.HasUnoProperty(poComponent, "Title") Then .WindowTitle = poComponent.Title
Select Case sIdentifier
Case "com.sun.star.sdb.FormDesign" ' Form
.DocumentType = FORMDOCUMENT
Case "com.sun.star.sdb.TextReportDesign" ' Report
Case "com.sun.star.text.TextDocument" ' Writer
.DocumentType = WRITERDOCUMENT
Case "com.sun.star.sheet.SpreadsheetDocument" ' Calc
.DocumentType = CALCDOCUMENT
Case "com.sun.star.presentation.PresentationDocument" ' Impress
.DocumentType = IMPRESSDOCUMENT
Case "com.sun.star.drawing.DrawingDocument" ' Draw
.DocumentType = DRAWDOCUMENT
Case "com.sun.star.formula.FormulaProperties" ' Math
.DocumentType = MATHDOCUMENT
Case Else
End Select
End If
End Select
If IsNull(.Frame) Then
If Not IsNull(poComponent.CurrentController) Then Set .Frame = poComponent.CurrentController.Frame
End If
End With
Finally:
Set _IdentifyWindow = oWindow
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_UI._IdentifyWindow
REM -----------------------------------------------------------------------------
Public Function _ListToolbars(ByRef poComponent As Object) As Object
''' Returns a SF_Dictionary object containing a list of all available
''' toolbars in the given component
''' A toolbar may be located:
''' - builtin in the LibreOffice configuration, but dependent on the component type
''' - added by the user and stored in the LibreOffice configuration of the user
''' - added by the user and stored in the component/document itself
''' The output dictionary has as
''' key: the UIName of the toolbar when not blank, otherwise the last component of its ResourceURL
''' item: a _Toolbar object (see top of module)
''' Menubar, statusbar and popup menus are ignored.
''' Args:
''' poComponent: any component in desktop, typically a document but not only
Dim oToolbarsDict As Object ' Return value
Dim oWindow As Object ' Window type
Dim oConfigMgr As Object ' com.sun.star.ui.ModuleUIConfigurationManagerSupplier
Dim sConfigurationManager As String ' Derived from the component's type
Dim oUIConfigMgr As Object ' com.sun.star.comp.framework.ModuleUIConfigurationManager
Dim vCommandBars As Variant ' Array of bars in component
Dim vCommandBar As Variant ' Array of PropertyValue about a single bar
Dim oToolbar As Object ' Toolbar description as a _Toolbar object
Dim sResourceURL As String ' Toolbar internal name as "private:resource/toolbar/..."
Dim sUIName As String ' Toolbar external name, may be zero-length string
Dim sBarName As String ' External bar name: either UIName or last component of resource URL
Dim i As Long
Const cstCUSTOM = "custom_"
Check:
' On Local Error GoTo Catch
If IsNull(poComponent) Then GoTo Catch
Try:
Set oToolbarsDict = CreateScriptService("Dictionary")
Set oWindow = _IdentifyWindow(poComponent)
' 1. Collect all builtin and custom toolbars stored in the LibreOffice configuration files
' Derive the name of the UI configuration manager from the component type
With oWindow
Select Case .WindowName
Case BASICIDE : sConfigurationManager = "com.sun.star.script.BasicIDE"
Case WELCOMESCREEN : sConfigurationManager = "com.sun.star.frame.StartModule"
Case Else
Select Case .DocumentType
Case BASEDOCUMENT : sConfigurationManager = "com.sun.star.sdb.OfficeDatabaseDocument"
Case CALCDOCUMENT : sConfigurationManager = "com.sun.star.sheet.SpreadsheetDocument"
Case DRAWDOCUMENT : sConfigurationManager = "com.sun.star.drawing.DrawingDocument"
Case FORMDOCUMENT : sConfigurationManager = "com.sun.star.sdb.FormDesign"
Case IMPRESSDOCUMENT : sConfigurationManager = "com.sun.star.presentation.PresentationDocument"
Case MATHDOCUMENT : sConfigurationManager = "com.sun.star.formula.FormulaProperties"
Case WRITERDOCUMENT : sConfigurationManager = "com.sun.star.text.TextDocument"
Case TABLEDATA, QUERYDATA, SQLDATA
sConfigurationManager = "com.sun.star.sdb.DataSourceBrowser"
Case Else : sConfigurationManager = ""
End Select
End Select
End With
Set oConfigMgr = SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier")
Set oUIConfigMgr = oConfigMgr.getUIConfigurationManager(sConfigurationManager)
vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
' Ignore statusbar, menubar and popup menus. Store toolbars in dictionary
For i = 0 To UBound(vCommandBars)
vCommandBar = vCommandBars(i)
sResourceURL = SF_Utils._GetPropertyValue(vCommandBar, "ResourceURL")
sUIName = SF_Utils._GetPropertyValue(vCommandBar, "UIName")
If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
' Store a new entry in the returned dictionary
If Not oToolbarsDict.Exists(sBarName) Then
Set oToolbar = New _Toolbar
With oToolbar
Set .Component = poComponent
.ResourceURL = sResourceURL
.UIName = sUIName
Set .UIConfigurationManager = oUIConfigMgr
.ElementsInfoIndex = i
' Distinguish builtin and custom toolbars stored in the application
If SF_String.StartsWith(sBarName, cstCUSTOM, CaseSensitive := True) Then
.Storage = cstCUSTOMTOOLBAR
sBarName = Mid(sBarName, Len(cstCUSTOM) + 1)
Else
.Storage = cstBUILTINTOOLBAR
End If
End With
oToolbarsDict.Add(sBarName, oToolbar)
End If
Next i
' 2. Collect all toolbars stored in the current component/document
' Some components (e.g. datasheets) cannot contain own toolbars
If SF_Session.HasUnoMethod(poComponent, "getUIConfigurationManager") Then
Set oUIConfigMgr = poComponent.getUIConfigurationManager
vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
For i = 0 To UBound(vCommandBars)
vCommandBar = vCommandBars(i)
sResourceURL = SF_Utils._GetPropertyValue(vCommandBar, "ResourceURL")
sUIName = SF_Utils._GetPropertyValue(vCommandBar, "UIName")
If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
' Store a new entry in the returned dictionary
If Not oToolbarsDict.Exists(sBarName) Then
Set oToolbar = New _Toolbar
With oToolbar
Set .Component = poComponent
.ResourceURL = sResourceURL
.UIName = sUIName
Set .UIConfigurationManager = oUIConfigMgr
.ElementsInfoIndex = i
.Storage = cstCUSTOMDOCTOOLBAR
End With
oToolbarsDict.Add(sBarName, oToolbar)
End If
Next i
End If
Finally:
Set _ListToolbars = oToolbarsDict
Exit Function
Catch:
Set oToolbarsDict = Nothing
GoTo Finally
End Function ' ScriptForge.SF_UI._ListToolbars
REM -----------------------------------------------------------------------------
Public Function _PosSize() As Object
''' Returns the PosSize structure of the active window
Dim vWindow As Window ' A single component
Dim oContainer As Object ' com.sun.star.awt.XWindow
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
Set oPosSize = Nothing
Try:
vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
If Not IsNull(vWindow.Frame) Then
Set oContainer = vWindow.Frame.ContainerWindow
Set oPosSize = oContainer.getPosSize()
End If
Finally:
Set _PosSize = oPosSize
Exit Function
End Function ' ScriptForge.SF_UI._PosSize
REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the UI instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
''' "[UI]"
_Repr = "[UI]"
End Function ' ScriptForge.SF_UI._Repr
REM ============================================ END OF SCRIPTFORGE.SF_UI
</script:module>
Mini Shell