diff options
Diffstat (limited to 'wizards/source/scriptforge/SF_UI.xba')
| -rw-r--r-- | wizards/source/scriptforge/SF_UI.xba | 1350 |
1 files changed, 1350 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_UI.xba b/wizards/source/scriptforge/SF_UI.xba new file mode 100644 index 000000000..c8a7f9a8f --- /dev/null +++ b/wizards/source/scriptforge/SF_UI.xba @@ -0,0 +1,1350 @@ +<?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, ... +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 +</script:module>
\ No newline at end of file |