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