| blob | 442b182915f08cff9c0a3157e0f05d7e803417d3 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_UI" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' SF_UI
13 ''' =====
14 ''' Singleton class module for the identification and the manipulation of the
15 ''' different windows composing the whole LibreOffice application:
16 ''' - Windows selection
17 ''' - Windows moving and resizing
18 ''' - Statusbar settings
19 ''' - Creation of new windows
21 '''
22 ''' WindowName: how to designate a window. It can be either
23 ''' a full FileName given in the notation indicated by the current value of SF_FileSystem.FileNaming
24 ''' or the last component of the full FileName or even only its BaseName
25 ''' or the title of the window
27 ''' or one of the special windows "BASICIDE" and "WELCOMESCREEN"
28 ''' The window search is case-sensitive
29 '''
30 ''' Service invocation example:
31 ''' Dim ui As Variant
33 '''
34 ''' Detailed user documentation:
35 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_ui.html?DbPAR=BASIC
36 '''
37 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
39 REM ================================================================== EXCEPTIONS
42 Const DOCUMENTCREATIONERROR = "DOCUMENTCREATIONERROR" ' Incoherent arguments, new document could not be created
43 Const DOCUMENTOPENERROR = "DOCUMENTOPENERROR" ' Document could not be opened, check the arguments
47 REM ============================================================= PRIVATE MEMBERS
49 Type Window
50 Component As Object ' com.sun.star.lang.XComponent
51 Frame As Object ' com.sun.star.comp.framework.Frame
52 WindowName As String ' Object Name
53 WindowTitle As String ' Only mean to identify new documents
54 WindowFileName As String ' URL of file name
55 DocumentType As String ' Writer, Calc, ...
56 ParentName As String ' Identifier of the parent Base file when Window is a subcomponent
57 End Type
59 Type _Toolbar ' Proto-toolbar object. Passed to the "Toolbar" service, a full ScriptForge Toolbar object will be returned
60 Component As Object ' com.sun.star.lang.XComponent
61 ResourceURL As String ' Toolbar internal name
63 UIConfigurationManager As Object ' com.sun.star.ui.XUIConfigurationManager
65 Storage As Long ' One of the toolbar location constants
66 End Type
68 ' The progress/status bar of the active window
71 REM ============================================================ MODULE CONSTANTS
73 ' Special windows
86 ' Window subtypes
93 ' Macro execution modes
98 ' Toolbar locations
100 Const cstCUSTOMTOOLBAR = 1 ' Toolbar added by user and stored in the LibreOffice application
103 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
105 REM -----------------------------------------------------------------------------
106 Public Function Dispose() As Variant
107 Set Dispose = Nothing
108 End Function ' ScriptForge.SF_UI Explicit destructor
110 REM ================================================================== PROPERTIES
112 REM -----------------------------------------------------------------------------
113 Public Function ActiveWindow() As String
114 ''' Returns a valid WindowName for the currently active window
117 Dim vWindow As Window ' A component
118 Dim oComp As Object ' com.sun.star.lang.XComponent
120 Set oComp = StarDesktop.CurrentComponent
121 If Not IsNull(oComp) Then
122 vWindow = SF_UI._IdentifyWindow(oComp)
123 With vWindow
125 ActiveWindow = SF_FileSystem._ConvertFromUrl(.WindowFileName)
127 ActiveWindow = .WindowName
129 ActiveWindow = .WindowTitle
130 Else
131 ActiveWindow = ""
132 End If
133 End With
134 End If
136 End Function ' ScriptForge.SF_UI.ActiveWindow
138 REM -----------------------------------------------------------------------------
139 Property Get Height() As Long
140 ''' Returns the height of the active window
141 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
142 Set oPosSize = SF_UI._PosSize()
143 If Not IsNull(oPosSize) Then Height = oPosSize.Height Else Height = -1
144 End Property ' ScriptForge.SF_UI.Height
146 REM -----------------------------------------------------------------------------
147 Property Get MACROEXECALWAYS As Integer
148 ''' Macros are always executed
149 MACROEXECALWAYS = cstMACROEXECALWAYS
150 End Property ' ScriptForge.SF_UI.MACROEXECALWAYS
152 REM -----------------------------------------------------------------------------
153 Property Get MACROEXECNEVER As Integer
154 ''' Macros are not executed
155 MACROEXECNEVER = cstMACROEXECNEVER
156 End Property ' ScriptForge.SF_UI.MACROEXECNEVER
158 REM -----------------------------------------------------------------------------
159 Property Get MACROEXECNORMAL As Integer
160 ''' Default, execution depends on user configuration and choice
161 MACROEXECNORMAL = cstMACROEXECNORMAL
162 End Property ' ScriptForge.SF_UI.MACROEXECNORMAL
164 REM -----------------------------------------------------------------------------
165 Property Get ObjectType As String
166 ''' Only to enable object representation
168 End Property ' ScriptForge.SF_UI.ObjectType
170 REM -----------------------------------------------------------------------------
171 Property Get ServiceName As String
172 ''' Internal use
174 End Property ' ScriptForge.SF_UI.ServiceName
176 REM -----------------------------------------------------------------------------
177 Property Get Width() As Long
178 ''' Returns the width of the active window
179 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
180 Set oPosSize = SF_UI._PosSize()
181 If Not IsNull(oPosSize) Then Width = oPosSize.Width Else Width = -1
182 End Property ' ScriptForge.SF_UI.Width
184 REM -----------------------------------------------------------------------------
185 Property Get X() As Long
186 ''' Returns the X coordinate of the active window
187 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
188 Set oPosSize = SF_UI._PosSize()
189 If Not IsNull(oPosSize) Then X = oPosSize.X Else X = -1
190 End Property ' ScriptForge.SF_UI.X
192 REM -----------------------------------------------------------------------------
193 Property Get Y() As Long
194 ''' Returns the Y coordinate of the active window
195 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
196 Set oPosSize = SF_UI._PosSize()
197 If Not IsNull(oPosSize) Then Y = oPosSize.Y Else Y = -1
198 End Property ' ScriptForge.SF_UI.Y
200 REM ===================================================================== METHODS
202 REM -----------------------------------------------------------------------------
203 Public Function Activate(Optional ByVal WindowName As Variant) As Boolean
204 ''' Make the specified window active
205 ''' Args:
206 ''' WindowName: see definitions
207 ''' Returns:
208 ''' True if the given window is found and can be activated
209 ''' There is no change in the actual user interface if no window matches the selection
210 ''' Examples:
213 Dim bActivate As Boolean ' Return value
214 Dim oEnum As Object ' com.sun.star.container.XEnumeration
215 Dim oComp As Object ' com.sun.star.lang.XComponent
216 Dim vWindow As Window ' A single component
217 Dim oContainer As Object ' com.sun.star.awt.XWindow
221 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
222 bActivate = False
224 Check:
225 If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
226 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
228 End If
230 Try:
231 Set oEnum = StarDesktop.Components().createEnumeration
232 Do While oEnum.hasMoreElements
233 Set oComp = oEnum.nextElement
234 vWindow = SF_UI._IdentifyWindow(oComp)
235 With vWindow
236 ' Does the current window match the arguments ?
237 If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem._ConvertToUrl(WindowName)) _
240 Set oContainer = vWindow.Frame.ContainerWindow
241 With oContainer
242 If .isVisible() = False Then .setVisible(True)
243 .IsMinimized = False
244 .setFocus()
245 .toFront() ' Force window change in Linux
247 End With
248 bActivate = True
249 Exit Do
250 End If
251 End With
252 Loop
254 Finally:
255 Activate = bActivate
256 SF_Utils._ExitFunction(cstThisSub)
257 Exit Function
258 Catch:
259 GoTo Finally
260 End Function ' ScriptForge.SF_UI.Activate
262 REM -----------------------------------------------------------------------------
263 Public Function CreateBaseDocument(Optional ByVal FileName As Variant _
264 , Optional ByVal EmbeddedDatabase As Variant _
265 , Optional ByVal RegistrationName As Variant _
266 , Optional ByVal CalcFileName As Variant _
267 ) As Object
268 ''' Create a new LibreOffice Base document embedding an empty database of the given type
269 ''' Args:
270 ''' FileName: Identifies the file to create. It must follow the SF_FileSystem.FileNaming notation
271 ''' If the file already exists, it is overwritten without warning
272 ''' EmbeddedDatabase: either "HSQLDB" (default) or "FIREBIRD" or "CALC"
273 ''' RegistrationName: the name used to store the new database in the databases register
275 ''' If the name already exists it is overwritten without warning
276 ''' CalcFileName: only when EmbedddedDatabase = "CALC", the name of the file containing the tables as Calc sheets
277 ''' The name of the file must be given in SF_FileSystem.FileNaming notation
278 ''' The file must exist
279 ''' Returns:
280 ''' A SFDocuments.SF_Document object or one of its subclasses
281 ''' Exceptions
282 ''' UNKNOWNFILEERROR Calc datasource does not exist
283 ''' Examples:
284 ''' Dim myBase As Object, myCalcBase As Object
285 ''' Set myBase = ui.CreateBaseDocument("C:\Databases\MyBaseFile.odb", "FIREBIRD")
286 ''' Set myCalcBase = ui.CreateBaseDocument("C:\Databases\MyCalcBaseFile.odb", "CALC", , "C:\Databases\MyCalcFile.ods")
288 Dim oCreate As Variant ' Return value
289 Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
290 Dim oDatabase As Object ' com.sun.star.comp.dba.ODatabaseSource
291 Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
292 Dim sFileName As String ' Alias of FileName
293 Dim FSO As Object ' Alias for FileSystem service
296 Const cstSubArgs = "FileName, [EmbeddedDatabase=""HSQLDB""|""FIREBIRD""|""CALC""], [RegistrationName=""""], [CalcFileName]"
298 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
299 Set oCreate = Nothing
302 Check:
303 If IsMissing(EmbeddedDatabase) Or IsEmpty(EmbeddedDatabase) Then EmbeddedDatabase = "HSQLDB"
304 If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
305 If IsMissing(CalcFileName) Or IsEmpty(CalcFileName) Then CalcFileName = ""
306 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
308 If Not SF_Utils._Validate(EmbeddedDatabase, "EmbeddedDatabase", V_STRING, Array("CALC", "HSQLDB", "FIREBIRD")) Then GoTo Finally
309 If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally
312 If Not FSO.FileExists(CalcFileName) Then GoTo CatchNotExists
313 End If
314 End If
316 Try:
318 With oDBContext
319 Set oDatabase = .createInstance()
320 ' Build the url link to the database
321 Select Case UCase(EmbeddedDatabase)
326 End Select
327 ' Create empty Base document
328 sFileName = FSO._ConvertToUrl(FileName)
329 ' An existing file is overwritten without warning
330 If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName)
331 If FSO.FileExists(FileName & ".lck") Then FSO.DeleteFile(FileName & ".lck")
332 oDatabase.DatabaseDocument.storeAsURL(sFileName, Array(SF_Utils._MakePropertyValue("Overwrite", True)))
333 ' Register database if requested
335 If .hasRegisteredDatabase(RegistrationName) Then
336 .changeDatabaseLocation(RegistrationName, sFileName)
337 Else
338 .registerDatabaseLocation(RegistrationName, sFileName)
339 End If
340 End If
341 End With
343 Set oCreate = OpenBaseDocument(FileName)
345 Finally:
346 Set CreateBaseDocument = oCreate
347 SF_Utils._ExitFunction(cstThisSub)
348 Exit Function
349 Catch:
350 GoTo Finally
351 CatchNotExists:
353 GoTo Finally
354 End Function ' ScriptForge.SF_UI.CreateBaseDocument
356 REM -----------------------------------------------------------------------------
357 Public Function CreateDocument(Optional ByVal DocumentType As Variant _
358 , Optional ByVal TemplateFile As Variant _
359 , Optional ByVal Hidden As Variant _
360 ) As Object
361 ''' Create a new LibreOffice document of a given type or based on a given template
362 ''' Args:
363 ''' DocumentType: "Calc", "Writer", etc. If absent, a TemplateFile must be given
364 ''' TemplateFile: the full FileName of the template to build the new document on
365 ''' If the file does not exist, the argument is ignored
366 ''' The "FileSystem" service provides the TemplatesFolder and UserTemplatesFolder
367 ''' properties to help to build the argument
368 ''' Hidden: if True, open in the background (default = False)
369 ''' To use with caution: activation or closure can only happen programmatically
370 ''' Returns:
371 ''' A SFDocuments.SF_Document object or one of its subclasses
372 ''' Exceptions:
373 ''' DOCUMENTCREATIONERROR Wrong arguments
374 ''' Examples:
375 ''' Dim myDoc1 As Object, myDoc2 As Object, FSO As Object
378 ''' Set myDoc2 = ui.CreateDocument(, FSO.BuildPath(FSO.TemplatesFolder, "personal/CV.ott"))
380 Dim oCreate As Variant ' Return value
381 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
382 Dim bTemplateExists As Boolean ' True if TemplateFile is valid
383 Dim sNew As String ' File url
384 Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
387 Const cstSubArgs = "[DocumentType=""""], [TemplateFile=""""], [Hidden=False]"
389 '>>> If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
390 Set oCreate = Nothing
392 Check:
393 If IsMissing(DocumentType) Or IsEmpty(DocumentType) Then DocumentType = ""
394 If IsMissing(TemplateFile) Or IsEmpty(TemplateFile) Then TemplateFile = ""
395 If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False
397 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
399 , Array("", BASEDOCUMENT, CALCDOCUMENT, DRAWDOCUMENT _
400 , IMPRESSDOCUMENT, MATHDOCUMENT, WRITERDOCUMENT)) Then GoTo Finally
403 End If
405 If Len(DocumentType) + Len(TemplateFile) = 0 Then GoTo CatchError
406 If Len(TemplateFile) > 0 Then bTemplateExists = SF_FileSystem.FileExists(TemplateFile) Else bTemplateExists = False
407 If Len(DocumentType) = 0 Then
408 If Not bTemplateExists Then GoTo CatchError
409 End If
411 Try:
412 If bTemplateExists Then sNew = SF_FileSystem._ConvertToUrl(TemplateFile) Else sNew = cstDocType & LCase(DocumentType)
413 vProperties = Array( _
416 )
418 If Not IsNull(oComp) Then Set oCreate = CreateScriptService("SFDocuments.Document", oComp)
420 Finally:
421 Set CreateDocument = oCreate
422 SF_Utils._ExitFunction(cstThisSub)
423 Exit Function
424 Catch:
425 GoTo Finally
426 CatchError:
427 SF_Exception.RaiseFatal(DOCUMENTCREATIONERROR, "DocumentType", DocumentType, "TemplateFile", TemplateFile)
428 GoTo Finally
429 End Function ' ScriptForge.SF_UI.CreateDocument
431 REM -----------------------------------------------------------------------------
432 Public Function Documents() As Variant
433 ''' Returns the list of the currently open documents. Special windows are ignored.
434 ''' Returns:
436 ''' or of window titles for unsaved documents
437 ''' Examples:
438 ''' Dim vDocs As Variant, sDoc As String
439 ''' vDocs = ui.Documents()
440 ''' For each sDoc In vDocs
441 ''' ...
443 Dim vDocuments As Variant ' Return value
444 Dim oEnum As Object ' com.sun.star.container.XEnumeration
445 Dim oComp As Object ' com.sun.star.lang.XComponent
446 Dim vWindow As Window ' A single component
448 Const cstSubArgs = ""
450 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
451 vDocuments = Array()
453 Check:
454 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
456 Try:
457 Set oEnum = StarDesktop.Components().createEnumeration
458 Do While oEnum.hasMoreElements
459 Set oComp = oEnum.nextElement
460 vWindow = SF_UI._IdentifyWindow(oComp)
461 With vWindow
463 vDocuments = SF_Array.Append(vDocuments, SF_FileSystem._ConvertFromUrl(.WindowFileName))
465 vDocuments = SF_Array.Append(vDocuments, .WindowTitle)
466 End If
467 End With
468 Loop
470 Finally:
471 Documents = vDocuments
472 SF_Utils._ExitFunction(cstThisSub)
473 Exit Function
474 Catch:
475 GoTo Finally
476 End Function ' ScriptForge.SF_UI.Documents
478 REM -----------------------------------------------------------------------------
479 Public Function GetDocument(Optional ByVal WindowName As Variant) As Variant
480 ''' Returns a SFDocuments.Document object referring to the active window or the given window
481 ''' Args:
482 ''' WindowName: when a string, see definitions. If absent the active window is considered.
483 ''' when an object, must be a UNO object of types
484 ''' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument
485 ''' Exceptions:
486 ''' DOCUMENTERROR The targeted window could not be found
487 ''' Examples:
488 ''' Dim oDoc As Object
490 ''' oDoc.Save()
492 Dim oDocument As Object ' Return value
496 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
497 Set oDocument = Nothing
499 Check:
500 If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
501 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
502 If Not SF_Utils._Validate(WindowName, "WindowName", Array(V_STRING, V_OBJECT)) Then GoTo Finally
503 If VarType(WindowName) = V_STRING Then
505 End If
506 End If
508 Try:
510 If IsNull(oDocument) Then GoTo CatchDeliver
512 Finally:
513 Set GetDocument = oDocument
514 SF_Utils._ExitFunction(cstThisSub)
515 Exit Function
516 Catch:
517 GoTo Finally
518 CatchDeliver:
520 GoTo Finally
521 End Function ' ScriptForge.SF_UI.GetDocument
523 REM -----------------------------------------------------------------------------
524 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
525 ''' Return the actual value of the given property
526 ''' Args:
527 ''' PropertyName: the name of the property as a string
528 ''' Returns:
529 ''' The actual value of the property
530 ''' Exceptions
531 ''' ARGUMENTERROR The property does not exist
536 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
537 GetProperty = Null
539 Check:
540 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
541 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
542 End If
544 Try:
545 Select Case UCase(PropertyName)
552 Case Else
553 End Select
555 Finally:
556 SF_Utils._ExitFunction(cstThisSub)
557 Exit Function
558 Catch:
559 GoTo Finally
560 End Function ' ScriptForge.SF_UI.GetProperty
562 REM -----------------------------------------------------------------------------
563 Public Sub Maximize(Optional ByVal WindowName As Variant)
564 ''' Maximizes the active window or the given window
565 ''' Args:
566 ''' WindowName: see definitions. If absent the active window is considered
567 ''' Examples:
568 ''' ui.Maximize
569 ''' ...
571 Dim oEnum As Object ' com.sun.star.container.XEnumeration
572 Dim oComp As Object ' com.sun.star.lang.XComponent
573 Dim vWindow As Window ' A single component
574 Dim oContainer As Object ' com.sun.star.awt.XWindow
575 Dim bFound As Boolean ' True if window found
579 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
581 Check:
582 If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
583 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
585 End If
587 Try:
588 bFound = False
590 Set oEnum = StarDesktop.Components().createEnumeration
591 Do While oEnum.hasMoreElements And Not bFound
592 Set oComp = oEnum.nextElement
593 vWindow = SF_UI._IdentifyWindow(oComp)
594 With vWindow
595 ' Does the current window match the arguments ?
599 End With
600 Loop
601 Else
602 vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
603 bFound = True
604 End If
606 If bFound Then
607 Set oContainer = vWindow.Frame.ContainerWindow
608 oContainer.IsMaximized = True
609 End If
611 Finally:
612 SF_Utils._ExitFunction(cstThisSub)
613 Exit Sub
614 Catch:
615 GoTo Finally
616 End Sub ' ScriptForge.SF_UI.Maximize
618 REM -----------------------------------------------------------------------------
619 Public Sub Minimize(Optional ByVal WindowName As Variant)
620 ''' Minimizes the current window or the given window
621 ''' Args:
622 ''' WindowName: see definitions. If absent the current window is considered
623 ''' Examples:
625 ''' ...
627 Dim oEnum As Object ' com.sun.star.container.XEnumeration
628 Dim oComp As Object ' com.sun.star.lang.XComponent
629 Dim vWindow As Window ' A single component
630 Dim oContainer As Object ' com.sun.star.awt.XWindow
631 Dim bFound As Boolean ' True if window found
635 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
637 Check:
638 If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
639 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
641 End If
643 Try:
644 bFound = False
646 Set oEnum = StarDesktop.Components().createEnumeration
647 Do While oEnum.hasMoreElements And Not bFound
648 Set oComp = oEnum.nextElement
649 vWindow = SF_UI._IdentifyWindow(oComp)
650 With vWindow
651 ' Does the current window match the arguments ?
655 End With
656 Loop
657 Else
658 vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
659 bFound = True
660 End If
662 If bFound Then
663 Set oContainer = vWindow.Frame.ContainerWindow
664 oContainer.IsMinimized = True
665 End If
667 Finally:
668 SF_Utils._ExitFunction(cstThisSub)
669 Exit Sub
670 Catch:
671 GoTo Finally
672 End Sub ' ScriptForge.SF_UI.Minimize
674 REM -----------------------------------------------------------------------------
675 Public Function Methods() As Variant
676 ''' Return the list of public methods of the UI service as an array
692 )
694 End Function ' ScriptForge.SF_UI.Methods
696 REM -----------------------------------------------------------------------------
697 Public Function OpenBaseDocument(Optional ByVal FileName As Variant _
698 , Optional ByVal RegistrationName As Variant _
699 , Optional ByVal MacroExecution As Variant _
700 ) As Object
701 ''' Open an existing LibreOffice Base document and return a SFDocuments.Document object
702 ''' Args:
703 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
704 ''' RegistrationName: the name of a registered database
706 ''' MacroExecution: one of the MACROEXECxxx constants
707 ''' Returns:
708 ''' A SFDocuments.SF_Base object
709 ''' Null if the opening failed, including when due to a user decision
710 ''' Exceptions:
711 ''' BASEDOCUMENTOPENERROR Wrong arguments
712 ''' Examples:
713 ''' Dim mBasec As Object, FSO As Object
714 ''' Set myBase = ui.OpenBaseDocument("C:\Temp\myDB.odb", MacroExecution := ui.MACROEXECNEVER)
716 Dim oOpen As Variant ' Return value
717 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
718 Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
719 Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
720 Dim sFile As String ' Alias for FileName
721 Dim iMacro As Integer ' Alias for MacroExecution
723 Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], [MacroExecution=0|1|2]"
725 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
726 Set oOpen = Nothing
728 Check:
729 If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = ""
730 If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
731 If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL
733 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
735 If Not SF_Utils._Validate(RegistrationName, "RegistrationName", V_STRING) Then GoTo Finally
737 , Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally
738 End If
740 ' Check the existence of FileName
742 If Len(RegistrationName) = 0 Then GoTo CatchError
744 If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError
745 FileName = SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName))
746 End If
747 If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError
749 Try:
750 With com.sun.star.document.MacroExecMode
751 Select Case MacroExecution
752 Case 0 : iMacro = .USE_CONFIG
753 Case 1 : iMacro = .NEVER_EXECUTE
754 Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN
755 End Select
756 End With
760 sFile = SF_FileSystem._ConvertToUrl(FileName)
762 If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp)
764 Finally:
765 Set OpenBaseDocument = oOpen
766 SF_Utils._ExitFunction(cstThisSub)
767 Exit Function
768 Catch:
769 GoTo Finally
770 CatchError:
771 SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName)
772 GoTo Finally
773 End Function ' ScriptForge.SF_UI.OpenBaseDocument
775 REM -----------------------------------------------------------------------------
776 Public Function OpenDocument(Optional ByVal FileName As Variant _
777 , Optional ByVal Password As Variant _
778 , Optional ByVal ReadOnly As Variant _
779 , Optional ByVal Hidden As Variant _
780 , Optional ByVal MacroExecution As Variant _
781 , Optional ByVal FilterName As Variant _
782 , Optional ByVal FilterOptions As Variant _
783 ) As Object
784 ''' Open an existing LibreOffice document with the given options
785 ''' Args:
786 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
787 ''' Password: To use when the document is protected
788 ''' If wrong or absent while the document is protected, the user will be prompted to enter a password
789 ''' ReadOnly: Default = False
790 ''' Hidden: if True, open in the background (default = False)
791 ''' To use with caution: activation or closure can only happen programmatically
792 ''' MacroExecution: one of the MACROEXECxxx constants
793 ''' FilterName: the name of a filter that should be used for loading the document
794 ''' If present, the filter must exist
795 ''' FilterOptions: an optional string of options associated with the filter
796 ''' Returns:
797 ''' A SFDocuments.SF_Document object or one of its subclasses
798 ''' Null if the opening failed, including when due to a user decision
799 ''' Exceptions:
800 ''' DOCUMENTOPENERROR Wrong arguments
801 ''' Examples:
802 ''' Dim myDoc As Object, FSO As Object
803 ''' Set myDoc = ui.OpenDocument("C:\Temp\myFile.odt", MacroExecution := ui.MACROEXECNEVER)
805 Dim oOpen As Variant ' Return value
806 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
807 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
808 Dim oComp As Object ' Loaded component com.sun.star.lang.XComponent
809 Dim sFile As String ' Alias for FileName
810 Dim iMacro As Integer ' Alias for MacroExecution
812 Const cstSubArgs = "FileName, [Password=""""], [ReadOnly=False], [Hidden=False], [MacroExecution=0|1|2], [FilterName=""""], [FilterOptions=""""]"
814 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
815 Set oOpen = Nothing
817 Check:
818 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
819 If IsMissing(ReadOnly) Or IsEmpty(ReadOnly) Then ReadOnly = False
820 If IsMissing(Hidden) Or IsEmpty(Hidden) Then Hidden = False
821 If IsMissing(MacroExecution) Or IsEmpty(MacroExecution) Then MacroExecution = MACROEXECNORMAL
822 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
823 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
825 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
831 , Array(MACROEXECNORMAL, MACROEXECNEVER, MACROEXECALWAYS)) Then GoTo Finally
834 End If
836 ' Check the existence of FileName and FilterName
837 If Not SF_FileSystem.FileExists(FileName) Then GoTo CatchError
840 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
841 End If
843 Try:
844 With com.sun.star.document.MacroExecMode
845 Select Case MacroExecution
846 Case 0 : iMacro = .USE_CONFIG
847 Case 1 : iMacro = .NEVER_EXECUTE
848 Case 2 : iMacro = .ALWAYS_EXECUTE_NO_WARN
849 End Select
850 End With
852 vProperties = Array( _
858 )
860 vProperties = SF_Array.Append(vProperties, SF_Utils._MakePropertyValue("Password", Password))
861 End If
863 sFile = SF_FileSystem._ConvertToUrl(FileName)
865 If Not IsNull(oComp) Then Set oOpen = CreateScriptService("SFDocuments.Document", oComp)
867 Finally:
868 Set OpenDocument = oOpen
869 SF_Utils._ExitFunction(cstThisSub)
870 Exit Function
871 Catch:
872 GoTo Finally
873 CatchError:
874 SF_Exception.RaiseFatal(DOCUMENTOPENERROR, "FileName", FileName, "Password", Password, "FilterName", FilterName)
875 GoTo Finally
876 End Function ' ScriptForge.SF_UI.OpenDocument
878 REM -----------------------------------------------------------------------------
879 Public Function Properties() As Variant
880 ''' Return the list or properties of the Timer class as an array
882 Properties = Array( _
888 )
890 End Function ' ScriptForge.SF_UI.Properties
892 REM -----------------------------------------------------------------------------
893 Public Sub Resize(Optional ByVal Left As Variant _
894 , Optional ByVal Top As Variant _
895 , Optional ByVal Width As Variant _
896 , Optional ByVal Height As Variant _
897 )
898 ''' Resizes and/or moves the active window. Negative arguments are ignored.
899 ''' If the window was minimized or without arguments, it is restored
900 ''' Args:
901 ''' Left, Top: Distances from top and left edges of the screen
902 ''' Width, Height: Dimensions of the window
903 ''' Examples:
905 ''' ...
907 Dim vWindow As Window ' A single component
908 Dim oContainer As Object ' com.sun.star.awt.XWindow
913 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
915 Check:
916 If IsMissing(Left) Or IsEmpty(Left) Then Left = -1
917 If IsMissing(Top) Or IsEmpty(Top) Then Top = -1
918 If IsMissing(Width) Or IsEmpty(Width) Then Width = -1
919 If IsMissing(Height) Or IsEmpty(Height) Then Height = -1
920 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
925 End If
927 Try:
928 vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
929 If Not IsNull(vWindow.Frame) Then
930 Set oContainer = vWindow.Frame.ContainerWindow
931 iPosSize = 0
936 With oContainer
937 .IsMaximized = False
938 .IsMinimized = False
939 .setPosSize(Left, Top, Width, Height, iPosSize)
940 End With
941 End If
943 Finally:
944 SF_Utils._ExitFunction(cstThisSub)
945 Exit Sub
946 Catch:
947 GoTo Finally
948 End Sub ' ScriptForge.SF_UI.Resize
950 REM -----------------------------------------------------------------------------
951 Public Sub RunCommand(Optional ByVal Command As Variant _
952 , ParamArray Args As Variant _
953 )
954 ''' Run on the current window the given menu command. The command is executed with or without arguments
955 ''' A few typical commands:
956 ''' About, Delete, Edit, Undo, Copy, Paste, ...
957 ''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
958 ''' Args:
959 ''' Command: Case-sensitive. The command itself is not checked.
961 ''' If nothing happens, then the command is probably wrong
962 ''' Args: Pairs of arguments name (string), value (any)
963 ''' Returns:
964 ''' Examples:
971 Dim oDispatch ' com.sun.star.frame.DispatchHelper
972 Dim vProps As Variant ' Array of PropertyValues
973 Dim vValue As Variant ' A single value argument
974 Dim sCommand As String ' Alias of Command
975 Dim i As Long
981 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
983 Check:
984 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
988 If Not SF_Utils._Validate(Args(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
989 Next i
990 End If
992 Try:
993 ' Build array of property values
994 vProps = Array()
997 vProps = SF_Array.Append(vProps, SF_Utils._MakePropertyValue(Args(i), vValue))
998 Next i
1000 If SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
1003 Finally:
1004 SF_Utils._ExitFunction(cstThisSub)
1005 Exit Sub
1006 Catch:
1007 GoTo Finally
1008 End Sub ' ScriptForge.SF_UI.RunCommand
1010 REM -----------------------------------------------------------------------------
1011 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1012 , Optional ByRef Value As Variant _
1013 ) As Boolean
1014 ''' Set a new value to the given property
1015 ''' Args:
1016 ''' PropertyName: the name of the property as a string
1017 ''' Value: its new value
1018 ''' Exceptions
1019 ''' ARGUMENTERROR The property does not exist
1024 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1025 SetProperty = False
1027 Check:
1028 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1029 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1030 End If
1032 Try:
1033 Select Case UCase(PropertyName)
1034 Case Else
1035 End Select
1037 Finally:
1038 SF_Utils._ExitFunction(cstThisSub)
1039 Exit Function
1040 Catch:
1041 GoTo Finally
1042 End Function ' ScriptForge.SF_UI.SetProperty
1044 REM -----------------------------------------------------------------------------
1045 Public Sub SetStatusbar(Optional ByVal Text As Variant _
1046 , Optional ByVal Percentage As Variant _
1047 )
1048 ''' Display a text and a progressbar in the status bar of the active window
1049 ''' Any subsequent calls in the same macro run refer to the same status bar of the same window,
1050 ''' even if the window is not active anymore
1051 ''' A call without arguments resets the status bar to its normal state.
1052 ''' Args:
1053 ''' Text: the optional text to be displayed before the progress bar
1055 ''' Examples:
1056 ''' Dim i As Integer
1060 ''' Next i
1061 ''' ui.SetStatusbar
1063 Dim oComp As Object
1064 Dim oControl As Object
1065 Dim oStatusbar As Object
1069 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1071 Check:
1072 If IsMissing(Text) Or IsEmpty(Text) Then Text = ""
1073 If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1
1074 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1077 End If
1079 Try:
1080 Set oStatusbar = _SF_.Statusbar
1081 If IsNull(oStatusbar) Then ' Initial call
1082 Set oComp = StarDesktop.CurrentComponent
1083 If Not IsNull(oComp) Then
1084 Set oControl = Nothing
1085 If SF_Session.HasUnoProperty(oComp, "CurrentController") Then Set oControl = oComp.CurrentController
1086 If Not IsNull(oControl) Then
1087 If SF_Session.HasUnoMethod(oControl, "getStatusIndicator") Then oStatusbar = oControl.getStatusIndicator()
1088 End If
1089 End If
1091 End If
1092 If Not IsNull(oStatusbar) Then
1093 With oStatusbar
1095 .end()
1096 Set oStatusbar = Nothing
1097 Else
1100 End If
1101 End With
1102 End If
1104 Finally:
1105 Set _SF_.Statusbar = oStatusbar
1106 SF_Utils._ExitFunction(cstThisSub)
1107 Exit Sub
1108 Catch:
1109 GoTo Finally
1110 End Sub ' ScriptForge.SF_UI.SetStatusbar
1112 REM -----------------------------------------------------------------------------
1113 Public Sub ShowProgressBar(Optional Title As Variant _
1114 , Optional ByVal Text As Variant _
1115 , Optional ByVal Percentage As Variant _
1116 , Optional ByRef _Context As Variant _
1117 )
1118 ''' Display a non-modal dialog box. Specify its title, an explicatory text and the progress on a progressbar
1119 ''' A call without arguments erases the progress bar dialog.
1120 ''' The box will anyway vanish at the end of the macro run.
1121 ''' Args:
1122 ''' Title: the title appearing on top of the dialog box (Default = "ScriptForge")
1123 ''' Text: the optional text to be displayed above the progress bar (default = zero-length string)
1125 ''' _Context: from Python, the XComponentXontext (FOR INTERNAL USE ONLY)
1126 ''' Examples:
1127 ''' Dim i As Integer
1129 ''' ui.ShowProgressBar(, "Progress ... " & i & "/100", i)
1131 ''' Next i
1132 ''' ui.ShowProgressBar
1134 Dim bFirstCall As Boolean ' True at first invocation of method
1135 Dim oDialog As Object ' SFDialogs.Dialog object
1136 Dim oFixedText As Object ' SFDialogs.DialogControl object
1137 Dim oProgressBar As Object ' SFDialogs.DialogControl object
1138 Dim sTitle As String ' Alias of Title
1142 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1144 Check:
1145 If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
1146 If IsMissing(Text) Or IsEmpty(Text) Then Text = ""
1147 If IsMissing(Percentage) Or IsEmpty(Percentage) Then Percentage = -1
1148 If IsMissing(_Context) Or IsEmpty(_Context) Then _Context = Nothing
1149 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1153 End If
1155 Try:
1156 With _SF_
1157 Set oDialog = .ProgressBarDialog
1158 Set oFixedText = .ProgressBarText
1159 Set oProgressBar = .ProgressBarBar
1160 End With
1162 bFirstCall = ( IsNull(oDialog) )
1163 If Not bFirstCall Then bFirstCall = Not oDialog._IsStillAlive(False) ' False to not raise an error
1164 If bFirstCall Then Set oDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "ScriptForge", "dlgProgress", _Context)
1165 With oDialog
1166 If Not IsNull(oDialog) Then
1168 Set oDialog = .Dispose()
1169 Else
1171 If bFirstCall Then
1174 .Execute(Modal := False)
1175 End If
1178 End If
1179 End If
1180 End With
1182 Finally:
1183 With _SF_
1184 Set .ProgressBarDialog = oDialog
1185 Set .ProgressBarText = oFixedText
1186 Set .ProgressBarBar = oProgressBar
1187 End With
1188 SF_Utils._ExitFunction(cstThisSub)
1189 Exit Sub
1190 Catch:
1191 GoTo Finally
1192 End Sub ' ScriptForge.SF_UI.ShowProgressBar
1194 REM -----------------------------------------------------------------------------
1195 Public Function WindowExists(Optional ByVal WindowName As Variant) As Boolean
1196 ''' Returns True if the specified window exists
1197 ''' Args:
1198 ''' WindowName: see definitions
1199 ''' Returns:
1200 ''' True if the given window is found
1201 ''' Examples:
1204 Dim bWindowExists As Boolean ' Return value
1205 Dim oEnum As Object ' com.sun.star.container.XEnumeration
1206 Dim oComp As Object ' com.sun.star.lang.XComponent
1207 Dim vWindow As Window ' A single component
1208 Dim oContainer As Object ' com.sun.star.awt.XWindow
1212 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1213 bWindowExists = False
1215 Check:
1216 If IsMissing(WindowName) Or IsEmpty(WindowName) Then WindowName = ""
1217 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1219 End If
1221 Try:
1222 Set oEnum = StarDesktop.Components().createEnumeration
1223 Do While oEnum.hasMoreElements
1224 Set oComp = oEnum.nextElement
1225 vWindow = SF_UI._IdentifyWindow(oComp)
1226 With vWindow
1227 ' Does the current window match the arguments ?
1228 If (Len(.WindowFileName) > 0 And .WindowFileName = SF_FileSystem.ConvertToUrl(WindowName)) _
1231 bWindowExists = True
1232 Exit Do
1233 End If
1234 End With
1235 Loop
1237 Finally:
1238 WindowExists = bWindowExists
1239 SF_Utils._ExitFunction(cstThisSub)
1240 Exit Function
1241 Catch:
1242 GoTo Finally
1243 End Function ' ScriptForge.SF_UI.WindowExists
1245 REM =========================================================== PRIVATE FUNCTIONS
1247 REM -----------------------------------------------------------------------------
1248 Public Sub _CloseProgressBar(Optional ByRef poEvent As Object)
1249 ''' Triggered by the Close button in the dlgProgress dialog
1250 ''' to simply close the dialog
1254 End Sub ' ScriptForge.SF_UI._CloseProgressBar
1256 REM -----------------------------------------------------------------------------
1257 Function _GetConfigurationManager(ByRef poComponent) As String
1258 ''' Derives the argument to be passed to a configuration manager
1259 ''' (managing the user interface elements like menus, toolbars, ...)
1260 ''' from the nature of the component
1261 ''' Args:
1262 ''' poComponent: any component in desktop, typically a document but not only
1264 Dim sConfigurationManager As String ' Return value
1265 Dim oWindow As Object ' Window type
1267 Check:
1268 ' On Local Error GoTo Catch
1269 If IsNull(poComponent) Then GoTo Catch
1271 Try:
1272 Set oWindow = _IdentifyWindow(poComponent)
1274 ' Derive the name of the UI configuration manager from the component type
1275 With oWindow
1276 Select Case .WindowName
1279 Case Else
1280 Select Case .DocumentType
1281 Case BASEDOCUMENT : sConfigurationManager = "com.sun.star.sdb.OfficeDatabaseDocument"
1285 Case IMPRESSDOCUMENT : sConfigurationManager = "com.sun.star.presentation.PresentationDocument"
1288 Case TABLEDATA, QUERYDATA, SQLDATA
1290 Case Else : sConfigurationManager = ""
1291 End Select
1292 End Select
1293 End With
1295 Finally:
1296 _GetConfigurationManager = sConfigurationManager
1297 Exit Function
1298 Catch:
1299 On Local Error GoTo 0
1300 GoTo Finally
1301 End Function ' ScriptForge.SF_UI._GetConfigurationManager
1303 REM -----------------------------------------------------------------------------
1304 Public Function _IdentifyWindow(ByRef poComponent As Object) As Object
1305 ''' Return a Window object (definition on top of module) based on component given as argument
1306 ''' Is a shortcut to explore the most relevant properties or objects bound to a UNO component
1308 Dim oWindow As Window ' Return value
1311 Dim vSelection As Variant ' Array of poCOmponent.Selection property values
1312 Dim iCommandType As Integer ' Datasheet type
1313 Dim FSO As Object ' Alias for SF_FileSystem
1315 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1316 Set _IdentifyWindow = Nothing
1319 Set FSO = SF_FileSystem
1320 With oWindow
1321 Set .Frame = Nothing
1322 Set .Component = Nothing
1323 .WindowName = ""
1324 .WindowTitle = ""
1325 .WindowFileName = ""
1326 .DocumentType = ""
1327 .ParentName = ""
1328 If IsNull(poComponent) Then GoTo Finally
1329 If SF_Session.HasUnoProperty(poComponent, "ImplementationName") Then sImplementation = poComponent.ImplementationName
1330 If SF_Session.HasUnoProperty(poComponent, "Identifier") Then sIdentifier = poComponent.Identifier
1331 Set .Component = poComponent
1332 Select Case sImplementation
1334 .WindowName = BASICIDE
1337 If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
1338 .DocumentType = BASEDOCUMENT
1339 Case "org.openoffice.comp.dbu.ODatasourceBrowser" ' Base datasheet (table, query or sql) in read mode
1340 Set .Frame = poComponent.Frame
1341 If Not IsEmpty(poComponent.Selection) Then ' Empty for (F4) DatasourceBrowser !!
1342 vSelection = poComponent.Selection
1345 Select Case iCommandType
1346 Case com.sun.star.sdb.CommandType.TABLE : .DocumentType = TABLEDATA
1347 Case com.sun.star.sdb.CommandType.QUERY : .DocumentType = QUERYDATA
1348 Case com.sun.star.sdb.CommandType.COMMAND : .DocumentType = SQLDATA
1349 End Select
1351 .WindowTitle = .WindowName
1352 End If
1353 Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign" ' Table or Query in Edit mode
1356 Set .Frame = poComponent.Frame
1357 .WindowName = WELCOMESCREEN
1358 Case Else
1360 ' Do not use URL : it contains the TemplateFile when new documents are created from a template
1361 .WindowFileName = poComponent.Location
1362 If Len(.WindowFileName) > 0 Then .WindowName = FSO.GetName(FSO._ConvertFromUrl(.WindowFileName))
1363 If SF_Session.HasUnoProperty(poComponent, "Title") Then .WindowTitle = poComponent.Title
1364 Select Case sIdentifier
1366 .DocumentType = FORMDOCUMENT
1369 .DocumentType = WRITERDOCUMENT
1371 .DocumentType = CALCDOCUMENT
1373 .DocumentType = IMPRESSDOCUMENT
1375 .DocumentType = DRAWDOCUMENT
1377 .DocumentType = MATHDOCUMENT
1378 Case Else
1379 End Select
1380 End If
1381 End Select
1382 If IsNull(.Frame) Then
1383 If Not IsNull(poComponent.CurrentController) Then Set .Frame = poComponent.CurrentController.Frame
1384 End If
1385 End With
1387 Finally:
1388 Set _IdentifyWindow = oWindow
1389 Exit Function
1390 Catch:
1391 GoTo Finally
1392 End Function ' ScriptForge.SF_UI._IdentifyWindow
1394 REM -----------------------------------------------------------------------------
1395 Public Function _ListToolbars(ByRef poComponent As Object) As Object
1396 ''' Returns a SF_Dictionary object containing a list of all available
1397 ''' toolbars in the given component
1398 ''' A toolbar may be located:
1399 ''' - builtin in the LibreOffice configuration, but dependent on the component type
1400 ''' - added by the user and stored in the LibreOffice configuration of the user
1401 ''' - added by the user and stored in the component/document itself
1402 ''' The output dictionary has as
1403 ''' key: the UIName of the toolbar when not blank, otherwise the last component of its ResourceURL
1404 ''' item: a _Toolbar object (see top of module)
1405 ''' Menubar, statusbar and popup menus are ignored.
1406 ''' Args:
1407 ''' poComponent: any component in desktop, typically a document but not only
1409 Dim oToolbarsDict As Object ' Return value
1410 Dim oConfigMgr As Object ' com.sun.star.ui.ModuleUIConfigurationManagerSupplier
1412 Dim oUIConfigMgr As Object ' com.sun.star.comp.framework.ModuleUIConfigurationManager
1413 Dim vCommandBars As Variant ' Array of bars in component
1414 Dim vCommandBar As Variant ' Array of PropertyValue about a single bar
1415 Dim oToolbar As Object ' Toolbar description as a _Toolbar object
1416 Dim sResourceURL As String ' Toolbar internal name as "private:resource/toolbar/..."
1417 Dim sUIName As String ' Toolbar external name, may be zero-length string
1418 Dim sBarName As String ' External bar name: either UIName or last component of resource URL
1419 Dim i As Long
1423 Check:
1424 ' On Local Error GoTo Catch
1425 If IsNull(poComponent) Then GoTo Catch
1427 Try:
1428 Set oToolbarsDict = CreateScriptService("Dictionary", True) ' with case-sensitive comparison of keys
1430 ' 1. Collect all builtin and custom toolbars stored in the LibreOffice configuration files
1432 ' Derive the name of the UI configuration manager from the component type
1433 sConfigurationManager = _GetConfigurationManager(poComponent)
1436 Set oUIConfigMgr = oConfigMgr.getUIConfigurationManager(sConfigurationManager)
1437 vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
1439 ' Ignore statusbar, menubar and popup menus. Store toolbars in dictionary
1440 For i = 0 To UBound(vCommandBars)
1441 vCommandBar = vCommandBars(i)
1444 If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
1445 ' Store a new entry in the returned dictionary
1446 If Not oToolbarsDict.Exists(sBarName) Then
1447 Set oToolbar = New _Toolbar
1448 With oToolbar
1449 Set .Component = poComponent
1450 .ResourceURL = sResourceURL
1451 .UIName = sUIName
1452 Set .UIConfigurationManager = oUIConfigMgr
1453 .ElementsInfoIndex = i
1454 ' Distinguish builtin and custom toolbars stored in the application
1455 If SF_String.StartsWith(sBarName, cstCUSTOM, CaseSensitive := True) Then
1456 .Storage = cstCUSTOMTOOLBAR
1457 sBarName = Mid(sBarName, Len(cstCUSTOM) + 1)
1458 Else
1459 .Storage = cstBUILTINTOOLBAR
1460 End If
1461 End With
1462 oToolbarsDict.Add(sBarName, oToolbar)
1463 End If
1464 Next i
1468 ' Some components (e.g. datasheets) cannot contain own toolbars
1470 Set oUIConfigMgr = poComponent.getUIConfigurationManager
1471 vCommandBars = oUIConfigMgr.getUIElementsInfo(com.sun.star.ui.UIElementType.TOOLBAR)
1472 For i = 0 To UBound(vCommandBars)
1473 vCommandBar = vCommandBars(i)
1476 If Len(sUIName) > 0 Then sBarName = sUIName Else sBarName = Split(sResourceURL, "/")(2)
1477 ' Store a new entry in the returned dictionary
1478 If Not oToolbarsDict.Exists(sBarName) Then
1479 Set oToolbar = New _Toolbar
1480 With oToolbar
1481 Set .Component = poComponent
1482 .ResourceURL = sResourceURL
1483 .UIName = sUIName
1484 Set .UIConfigurationManager = oUIConfigMgr
1485 .ElementsInfoIndex = i
1486 .Storage = cstCUSTOMDOCTOOLBAR
1487 End With
1488 oToolbarsDict.Add(sBarName, oToolbar)
1489 End If
1490 Next i
1491 End If
1493 Finally:
1494 Set _ListToolbars = oToolbarsDict
1495 Exit Function
1496 Catch:
1497 Set oToolbarsDict = Nothing
1498 GoTo Finally
1499 End Function ' ScriptForge.SF_UI._ListToolbars
1501 REM -----------------------------------------------------------------------------
1502 Public Function _PosSize() As Object
1503 ''' Returns the PosSize structure of the active window
1505 Dim vWindow As Window ' A single component
1506 Dim oContainer As Object ' com.sun.star.awt.XWindow
1507 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
1509 Set oPosSize = Nothing
1511 Try:
1512 vWindow = SF_UI._IdentifyWindow(StarDesktop.CurrentComponent)
1513 If Not IsNull(vWindow.Frame) Then
1514 Set oContainer = vWindow.Frame.ContainerWindow
1515 Set oPosSize = oContainer.getPosSize()
1516 End If
1518 Finally:
1519 Set _PosSize = oPosSize
1520 Exit Function
1521 End Function ' ScriptForge.SF_UI._PosSize
1523 REM -----------------------------------------------------------------------------
1524 Private Function _Repr() As String
1525 ''' Convert the UI instance to a readable string, typically for debugging purposes (DebugPrint ...)
1526 ''' Args:
1527 ''' Return:
1532 End Function ' ScriptForge.SF_UI._Repr
1534 REM ============================================ END OF SCRIPTFORGE.SF_UI
1535 </script:module>