forked from amazingfate/loongoffice
0483b0a4bb
A dialog box and its controls may be associated with scripts triggered by events (mouse moved, key pressed, ...). The link is usually preset in the Basic IDE when the dialog is designed. So far, ScriptForge did not offer the setting of a link event-script by code. The actual commit removes this limitation: every On-property related to either a dialog or a dialog control is now editbale. With the important precision that such a property may be updated ONLY IF it was NOT PRESET in the Basic IDE. Static (IDE) and dynamic (by code) definition of a specific On property on a specific dialog or on a specific dialog control are mutually exclusive. The new capacity may be used both in Basic and Python scripts. A short update of the help texts (dialog and dialogcontrol) is needed with mention of above restriction. Change-Id: Ia078aaab317ced7ade7ce69694504013f8e768a1 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/148800 Tested-by: Jean-Pierre Ledure <jp@ledure.be> Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
1509 lines
67 KiB
XML
1509 lines
67 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
|
|
With oStatusbar
|
|
If IsNull(oStatusbar) Then ' Initial call
|
|
Set oComp = StarDesktop.CurrentComponent
|
|
If Not IsNull(oComp) Then
|
|
Set oControl = Nothing
|
|
If SF_Session.HasUnoProperty(oComp, "CurrentController") Then Set oControl = oComp.CurrentController
|
|
If Not IsNull(oControl) Then
|
|
If SF_Session.HasUnoMethod(oControl, "getStatusIndicator") Then oStatusbar = oControl.getStatusIndicator()
|
|
End If
|
|
End If
|
|
If Not IsNull(oStatusbar) Then
|
|
.start("", 100)
|
|
End If
|
|
End If
|
|
If Not IsNull(oStatusbar) Then
|
|
If Len(Text) = 0 And Percentage = -1 Then
|
|
.end()
|
|
Set oStatusbar = Nothing
|
|
Else
|
|
If Len(Text) > 0 Then .setText(Text)
|
|
If Percentage >= 0 And Percentage <= 100 Then .setValue(Percentage)
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
Set _SF_.Statusbar = oStatusbar
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_UI.SetStatusbar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub ShowProgressBar(Optional Title As Variant _
|
|
, Optional ByVal Text As Variant _
|
|
, Optional ByVal Percentage As Variant _
|
|
, Optional ByRef _Context As Variant _
|
|
)
|
|
''' Display a non-modal dialog box. Specify its title, an explicatory text and the progress on a progressbar
|
|
''' A call without arguments erases the progress bar dialog.
|
|
''' The box will anyway vanish at the end of the macro run.
|
|
''' Args:
|
|
''' Title: the title appearing on top of the dialog box (Default = "ScriptForge")
|
|
''' Text: the optional text to be displayed above the progress bar (default = zero-length string)
|
|
''' Percentage: the degree of progress between 0 and 100. Default = 0
|
|
''' _Context: from Python, the XComponentXontext (FOR INTERNAL USE ONLY)
|
|
''' Examples:
|
|
''' Dim i As Integer
|
|
''' For i = 0 To 100
|
|
''' ui.ShowProgressBar(, "Progress ... " & i & "/100", i)
|
|
''' Wait 50
|
|
''' Next i
|
|
''' ui.ShowProgressBar
|
|
|
|
Dim bFirstCall As Boolean ' True at first invocation of method
|
|
Dim oDialog As Object ' SFDialogs.Dialog object
|
|
Dim oFixedText As Object ' SFDialogs.DialogControl object
|
|
Dim oProgressBar As Object ' SFDialogs.DialogControl object
|
|
Dim sTitle As String ' Alias of Title
|
|
Const cstThisSub = "UI.ShowProgressBar"
|
|
Const cstSubArgs = "[Title], [Text], [Percentage]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
|
|
If IsMissing(Text) Or IsEmpty(Text) Then Text = ""
|
|
If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1
|
|
If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Title, "Title", V_STRING) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Text, "Text", V_STRING) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Percentage, "Percentage", V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With _SF_
|
|
Set oDialog = .ProgressBarDialog
|
|
Set oFixedText = .ProgressBarText
|
|
Set oProgressBar = .ProgressBarBar
|
|
End With
|
|
With oDialog
|
|
bFirstCall = ( IsNull(oDialog) )
|
|
If Not bFirstCall Then bFirstCall = Not ._IsStillAlive(False) ' False to not raise an error
|
|
If bFirstCall Then Set oDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgProgress", _Context)
|
|
|
|
If Not IsNull(oDialog) Then
|
|
If Len(Title) = 0 And Len(Text) = 0 And Percentage = -1 Then
|
|
Set oDialog = .Dispose()
|
|
Else
|
|
.Caption = Iif(Len(Title) > 0, Title, "ScriptForge")
|
|
If bFirstCall Then
|
|
Set oFixedText = .Controls("ProgressText")
|
|
Set oProgressBar = .Controls("ProgressBar")
|
|
.Execute(Modal := False)
|
|
End If
|
|
If Len(Text) > 0 Then oFixedText.Caption = Text
|
|
oProgressBar.Value = Iif(Percentage >= 0 And Percentage <= 100, Percentage, 0)
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
With _SF_
|
|
Set .ProgressBarDialog = oDialog
|
|
Set .ProgressBarText = oFixedText
|
|
Set .ProgressBarBar = oProgressBar
|
|
End With
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' ScriptForge.SF_UI.ShowProgressBar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function WindowExists(Optional ByVal WindowName As Variant) As Boolean
|
|
''' Returns True if the specified window exists
|
|
''' Args:
|
|
''' WindowName: see definitions
|
|
''' Returns:
|
|
''' True if the given window is found
|
|
''' Examples:
|
|
''' ui.WindowExists("C:\Me\My file.odt")
|
|
|
|
Dim bWindowExists As Boolean ' Return value
|
|
Dim oEnum As Object ' com.sun.star.container.XEnumeration
|
|
Dim oComp As Object ' com.sun.star.lang.XComponent
|
|
Dim vWindow As Window ' A single component
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Const cstThisSub = "UI.WindowExists"
|
|
Const cstSubArgs = "WindowName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bWindowExists = False
|
|
|
|
Check:
|
|
If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(WindowName, "WindowName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oEnum = StarDesktop.Components().createEnumeration
|
|
Do While oEnum.hasMoreElements
|
|
Set oComp = oEnum.nextElement
|
|
vWindow = SF_UI._IdentifyWindow(oComp)
|
|
With vWindow
|
|
' Does the current window match the arguments ?
|
|
If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _
|
|
Or (Len(.WindowName) > 0 And .WindowName = WindowName) _
|
|
Or (Len(.WindowTitle) > 0 And .WindowTitle = WindowName) Then
|
|
bWindowExists = True
|
|
Exit Do
|
|
End If
|
|
End With
|
|
Loop
|
|
|
|
Finally:
|
|
WindowExists = bWindowExists
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_UI.WindowExists
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _CloseProgressBar(Optional ByRef poEvent As Object)
|
|
''' Triggered by the Close button in the dlgProgress dialog
|
|
''' to simply close the dialog
|
|
|
|
ShowProgressBar() ' Without arguments => close the dialog
|
|
|
|
End Sub ' ScriptForge.SF_UI._CloseProgressBar
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _IdentifyWindow(ByRef poComponent As Object) As Object
|
|
''' Return a Window object (definition on top of module) based on component given as argument
|
|
''' Is a shortcut to explore the most relevant properties or objects bound to a UNO component
|
|
|
|
Dim oWindow As Window ' Return value
|
|
Dim sImplementation As String ' Component's implementationname
|
|
Dim sIdentifier As String ' Component's identifier
|
|
Dim vSelection As Variant ' Array of poCOmponent.Selection property values
|
|
Dim iCommandType As Integer ' Datasheet type
|
|
Dim FSO As Object ' Alias for SF_FileSystem
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set _IdentifyWindow = Nothing
|
|
sImplementation = "" : sIdentifier = ""
|
|
|
|
Set FSO = SF_FileSystem
|
|
With oWindow
|
|
Set .Frame = Nothing
|
|
Set .Component = Nothing
|
|
.WindowName = ""
|
|
.WindowTitle = ""
|
|
.WindowFileName = ""
|
|
.DocumentType = ""
|
|
.ParentName = ""
|
|
If IsNull(poComponent) Then GoTo Finally
|
|
If SF_Session.HasUnoProperty(poComponent, "ImplementationName") Then sImplementation = poComponent.ImplementationName
|
|
If SF_Session.HasUnoProperty(poComponent, "Identifier") Then sIdentifier = poComponent.Identifier
|
|
Set .Component = poComponent
|
|
Select Case sImplementation
|
|
Case "com.sun.star.comp.basic.BasicIDE"
|
|
.WindowName = BASICIDE
|
|
Case "com.sun.star.comp.dba.ODatabaseDocument" ' No identifier
|
|
.WindowFileName = SF_Utils._GetPropertyValue(poComponent.Args, "URL")
|
|
If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
|
|
.DocumentType = BASEDOCUMENT
|
|
Case "org.openoffice.comp.dbu.ODatasourceBrowser" ' Base datasheet (table, query or sql) in read mode
|
|
Set .Frame = poComponent.Frame
|
|
If Not IsEmpty(poComponent.Selection) Then ' Empty for (F4) DatasourceBrowser !!
|
|
vSelection = poComponent.Selection
|
|
.WindowName = SF_Utils._GetPropertyValue(vSelection, "Command")
|
|
iCommandType = SF_Utils._GetPropertyValue(vSelection, "CommandType")
|
|
Select Case iCommandType
|
|
Case com.sun.star.sdb.CommandType.TABLE : .DocumentType = TABLEDATA
|
|
Case com.sun.star.sdb.CommandType.QUERY : .DocumentType = QUERYDATA
|
|
Case com.sun.star.sdb.CommandType.COMMAND : .DocumentType = SQLDATA
|
|
End Select
|
|
.ParentName = SF_Utils._GetPropertyValue(vSelection, "DataSourceName")
|
|
.WindowTitle = .WindowName
|
|
End If
|
|
Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign" ' Table or Query in Edit mode
|
|
Case "org.openoffice.comp.dbu.ORelationDesign"
|
|
Case "com.sun.star.comp.sfx2.BackingComp" ' Welcome screen
|
|
Set .Frame = poComponent.Frame
|
|
.WindowName = WELCOMESCREEN
|
|
Case Else
|
|
If Len(sIdentifier) > 0 Then
|
|
' Do not use URL : it contains the TemplateFile when new documents are created from a template
|
|
.WindowFileName = poComponent.Location
|
|
If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
|
|
If SF_Session.HasUnoProperty(poComponent, "Title") Then .WindowTitle = poComponent.Title
|
|
Select Case sIdentifier
|
|
Case "com.sun.star.sdb.FormDesign" ' Form
|
|
.DocumentType = FORMDOCUMENT
|
|
Case "com.sun.star.sdb.TextReportDesign" ' Report
|
|
Case "com.sun.star.text.TextDocument" ' Writer
|
|
.DocumentType = WRITERDOCUMENT
|
|
Case "com.sun.star.sheet.SpreadsheetDocument" ' Calc
|
|
.DocumentType = CALCDOCUMENT
|
|
Case "com.sun.star.presentation.PresentationDocument" ' Impress
|
|
.DocumentType = IMPRESSDOCUMENT
|
|
Case "com.sun.star.drawing.DrawingDocument" ' Draw
|
|
.DocumentType = DRAWDOCUMENT
|
|
Case "com.sun.star.formula.FormulaProperties" ' Math
|
|
.DocumentType = MATHDOCUMENT
|
|
Case Else
|
|
End Select
|
|
End If
|
|
End Select
|
|
If IsNull(.Frame) Then
|
|
If Not IsNull(poComponent.CurrentController) Then Set .Frame = poComponent.CurrentController.Frame
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
Set _IdentifyWindow = oWindow
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_UI._IdentifyWindow
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _ListToolbars(ByRef poComponent As Object) As Object
|
|
''' Returns a SF_Dictionary object containing a list of all available
|
|
''' toolbars in the given component
|
|
''' A toolbar may be located:
|
|
''' - builtin in the LibreOffice configuration, but dependent on the component type
|
|
''' - added by the user and stored in the LibreOffice configuration of the user
|
|
''' - added by the user and stored in the component/document itself
|
|
''' The output dictionary has as
|
|
''' key: the UIName of the toolbar when not blank, otherwise the last component of its ResourceURL
|
|
''' item: a _Toolbar object (see top of module)
|
|
''' Menubar, statusbar and popup menus are ignored.
|
|
''' Args:
|
|
''' poComponent: any component in desktop, typically a document but not only
|
|
|
|
Dim oToolbarsDict As Object ' Return value
|
|
Dim oWindow As Object ' Window type
|
|
Dim oConfigMgr As Object ' com.sun.star.ui.ModuleUIConfigurationManagerSupplier
|
|
Dim sConfigurationManager As String ' Derived from the component's type
|
|
Dim oUIConfigMgr As Object ' com.sun.star.comp.framework.ModuleUIConfigurationManager
|
|
Dim vCommandBars As Variant ' Array of bars in component
|
|
Dim vCommandBar As Variant ' Array of PropertyValue about a single bar
|
|
Dim oToolbar As Object ' Toolbar description as a _Toolbar object
|
|
Dim sResourceURL As String ' Toolbar internal name as "private:resource/toolbar/..."
|
|
Dim sUIName As String ' Toolbar external name, may be zero-length string
|
|
Dim sBarName As String ' External bar name: either UIName or last component of resource URL
|
|
Dim i As Long
|
|
|
|
Const cstCUSTOM = "custom_"
|
|
|
|
Check:
|
|
' On Local Error GoTo Catch
|
|
If IsNull(poComponent) Then GoTo Catch
|
|
|
|
Try:
|
|
Set oToolbarsDict = CreateScriptService("Dictionary")
|
|
Set oWindow = _IdentifyWindow(poComponent)
|
|
|
|
' 1. Collect all builtin and custom toolbars stored in the LibreOffice configuration files
|
|
|
|
' Derive the name of the UI configuration manager from the component type
|
|
With oWindow
|
|
Select Case .WindowName
|
|
Case BASICIDE : sConfigurationManager = "com.sun.star.script.BasicIDE"
|
|
Case WELCOMESCREEN : sConfigurationManager = "com.sun.star.frame.StartModule"
|
|
Case Else
|
|
Select Case .DocumentType
|
|
Case BASEDOCUMENT : sConfigurationManager = "com.sun.star.sdb.OfficeDatabaseDocument"
|
|
Case CALCDOCUMENT : sConfigurationManager = "com.sun.star.sheet.SpreadsheetDocument"
|
|
Case DRAWDOCUMENT : sConfigurationManager = "com.sun.star.drawing.DrawingDocument"
|
|
Case FORMDOCUMENT : sConfigurationManager = "com.sun.star.sdb.FormDesign"
|
|
Case IMPRESSDOCUMENT : sConfigurationManager = "com.sun.star.presentation.PresentationDocument"
|
|
Case MATHDOCUMENT : sConfigurationManager = "com.sun.star.formula.FormulaProperties"
|
|
Case WRITERDOCUMENT : sConfigurationManager = "com.sun.star.text.TextDocument"
|
|
Case TABLEDATA, QUERYDATA, SQLDATA
|
|
sConfigurationManager = "com.sun.star.sdb.DataSourceBrowser"
|
|
Case Else : sConfigurationManager = ""
|
|
End Select
|
|
End Select
|
|
End With
|
|
Set oConfigMgr = SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier")
|
|
Set oUIConfigMgr = oConfigMgr.getUIConfigurationManager(sConfigurationManager)
|
|
vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
|
|
|
|
' Ignore statusbar, menubar and popup menus. Store toolbars in dictionary
|
|
For i = 0 To UBound(vCommandBars)
|
|
vCommandBar = vCommandBars(i)
|
|
sResourceURL = SF_Utils._GetPropertyValue(vCommandBar, "ResourceURL")
|
|
sUIName = SF_Utils._GetPropertyValue(vCommandBar, "UIName")
|
|
If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
|
|
' Store a new entry in the returned dictionary
|
|
If Not oToolbarsDict.Exists(sBarName) Then
|
|
Set oToolbar = New _Toolbar
|
|
With oToolbar
|
|
Set .Component = poComponent
|
|
.ResourceURL = sResourceURL
|
|
.UIName = sUIName
|
|
Set .UIConfigurationManager = oUIConfigMgr
|
|
.ElementsInfoIndex = i
|
|
' Distinguish builtin and custom toolbars stored in the application
|
|
If SF_String.StartsWith(sBarName, cstCUSTOM, CaseSensitive := True) Then
|
|
.Storage = cstCUSTOMTOOLBAR
|
|
sBarName = Mid(sBarName, Len(cstCUSTOM) + 1)
|
|
Else
|
|
.Storage = cstBUILTINTOOLBAR
|
|
End If
|
|
End With
|
|
oToolbarsDict.Add(sBarName, oToolbar)
|
|
End If
|
|
Next i
|
|
|
|
' 2. Collect all toolbars stored in the current component/document
|
|
|
|
' Some components (e.g. datasheets) cannot contain own toolbars
|
|
If SF_Session.HasUnoMethod(poComponent, "getUIConfigurationManager") Then
|
|
Set oUIConfigMgr = poComponent.getUIConfigurationManager
|
|
vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
|
|
For i = 0 To UBound(vCommandBars)
|
|
vCommandBar = vCommandBars(i)
|
|
sResourceURL = SF_Utils._GetPropertyValue(vCommandBar, "ResourceURL")
|
|
sUIName = SF_Utils._GetPropertyValue(vCommandBar, "UIName")
|
|
If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
|
|
' Store a new entry in the returned dictionary
|
|
If Not oToolbarsDict.Exists(sBarName) Then
|
|
Set oToolbar = New _Toolbar
|
|
With oToolbar
|
|
Set .Component = poComponent
|
|
.ResourceURL = sResourceURL
|
|
.UIName = sUIName
|
|
Set .UIConfigurationManager = oUIConfigMgr
|
|
.ElementsInfoIndex = i
|
|
.Storage = cstCUSTOMDOCTOOLBAR
|
|
End With
|
|
oToolbarsDict.Add(sBarName, oToolbar)
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
Finally:
|
|
Set _ListToolbars = oToolbarsDict
|
|
Exit Function
|
|
Catch:
|
|
Set oToolbarsDict = Nothing
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_UI._ListToolbars
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _PosSize() As Object
|
|
''' Returns the PosSize structure of the active window
|
|
|
|
Dim vWindow As Window ' A single component
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
|
|
|
|
Set oPosSize = Nothing
|
|
|
|
Try:
|
|
vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
|
|
If Not IsNull(vWindow.Frame) Then
|
|
Set oContainer = vWindow.Frame.ContainerWindow
|
|
Set oPosSize = oContainer.getPosSize()
|
|
End If
|
|
|
|
Finally:
|
|
Set _PosSize = oPosSize
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_UI._PosSize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the UI instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[UI]"
|
|
|
|
_Repr = "[UI]"
|
|
|
|
End Function ' ScriptForge.SF_UI._Repr
|
|
|
|
REM ============================================ END OF SCRIPTFORGE.SF_UI
|
|
</script:module> |