Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quelle  SF_UI.xba   Sprache: unbekannt

 
Untersuchungsergebnis.xba Download desUnknown {[0] [0] [0]}zum Wurzelverzeichnis wechseln

<?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 DataFileName As Variant _
       , Optional ByVal CalcFileName As Variant _
       ) As Object
''' Create a new LibreOffice Base document embedding an empty database of the given type
''' or finding its datasource in an external database file (Calc or Firebird).
''' 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
'''  DataFileName: when EmbedddedDatabase = "CALC", the name of the file containing the tables as Calc sheets,
'''   when EmbeddedDatabase = "FIREBIRD_EXTERNAL", the Firebird external database file.
'''   The name of the file must be given in SF_FileSystem.FileNaming notation
'''   The file must exist
'''  CalcFileName: only when EmbedddedDatabase = "CALC", the name of the file containing the tables as Calc sheets
'''   The argument is obsolete as from SF 25.8.
''' Returns:
'''   A SFDocuments.SF_Base object or Nothing
''' 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 sTarget As String    ' sdbc abbreviation
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""|""FIREBIRD_EXTERNAL""|""CALC""], " _
     & "[RegistrationName=""""], [DataFileName]"

 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(DataFileName) Or IsEmpty(DataFileName) Then DataFileName = ""
 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", "FIREBIRD_EXTERNAL")) Then GoTo Finally
  If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally
  If InStr(UCase(EmbeddedDatabase), "CALC,FIREBIRD_EXTERNAL") > 0 Then
   If Len(CalcFileName) > 0 And Len(DataFileName) = 0 Then DataFileName = CalcFileName
   If Not SF_Utils._ValidateFile(DataFileName, "DataFileName") Then GoTo Finally
   If Not FSO.FileExists(DataFileName) Then GoTo CatchNotExists
  End If
 End If

Try:
 sFileName = FSO._ConvertToUrl(FileName)

 Set oDBContext = SF_Utils._GetUNOService("DatabaseContext")
 With oDBContext
  Set oDatabase = .createInstance()

  ' Build the url links in the database descriptors
  oDatabase.URL = sFileName
  Select Case UCase(EmbeddedDatabase)
   Case "HSQLDB", "FIREBIRD"
    oDatabase.DatabaseDocument.DataSource.URL = "sdbc:embedded:" & LCase(EmbeddedDatabase)
   Case "CALC", "FIREBIRD_EXTERNAL"
    If UCase(EmbeddedDatabase) = "CALC" Then sTarget = "calc" Else sTarget = "firebird"
    oDatabase.DatabaseDocument.DataSource.URL = "sdbc:" & sTarget & ":" & FSO._ConvertToUrl(DataFileName)
  End Select

  ' Create empty Base document
  ' 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, "DataFileName", DataFileName)
 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
    .Terminate()
    Set oDialog = Nothing
   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
--> --------------------

--> maximum size reached

--> --------------------

[ zur Elbe Produktseite wechseln0.87Quellennavigators  ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge