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, ... 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 IMPRESSDOCUMENT = "Impress" Const MATHDOCUMENT = "Math" Const WRITERDOCUMENT = "Writer" ' Window subtypes - Not supported yet Const BASETABLE = "BASETABLE" Const BASEQUERY = "BASEQUERY" 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 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 vArg As Variant ' One single item of the Args UNO property 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 = "" 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" 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 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 _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