| blob | 775984f60d6f26a608ede7e0a076e67fc4b7c7f5 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Datasheet" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDatabases library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Datasheet
16 ''' ============
17 ''' A datasheet is the visual representation of tabular data produced by a database.
18 ''' In the user interface of LibreOffice it is the result of the opening of
19 ''' a table or a query. In this case the concerned Base document must be open.
20 '''
21 ''' In the context of ScriptForge, a datasheet may be opened automatically by script code :
22 ''' - either by reproducing the behaviour of the user interface
23 ''' - or at any moment. In this case the Base document may or may not be opened.
24 ''' Additionally, any SELECT SQL statement may define the datasheet display.
25 '''
26 ''' The proposed API allows for either datasheets (opened manually of by code) in particular
27 ''' to know which cell is selected and its content.
28 '''
29 ''' Service invocation:
34 ''' ' May be executed also when the given table is already open
36 ''' Set oDatabase = CreateScriptService("Database", "/home/user/Documents/myDb.odb")
38 '''
39 ''' Detailed user documentation:
40 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_datasheet.html?DbPAR=BASIC
41 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
43 REM ================================================================== EXCEPTIONS
47 REM ============================================================= PRIVATE MEMBERS
49 Private [Me] As Object
50 Private [_Parent] As Object ' Base instance when opened from a Base document by code
51 ' or Database instance when opened without Base document
52 Private ObjectType As String ' Must be DATASHEET
53 Private ServiceName As String
55 Private _Component As Object ' com.sun.star.lang.XComponent - org.openoffice.comp.dbu.ODatasourceBrowser
56 Private _Frame As Object ' com.sun.star.frame.XFrame
57 Private _ParentBase As Object ' The parent SF_Base instance (may be void)
58 Private _ParentDatabase As Object ' The parent SF_Database instance (must not be void)
59 Private _SheetType As String ' TABLE, QUERY or SQL
60 Private _ParentType As String ' BASE or DATABASE
61 Private _BaseFileName As String ' URL format of parent Base file
62 Private _Command As String ' Table name, query name or SQL statement
63 Private _DirectSql As Boolean ' When True, SQL processed by RDBMS
64 Private _TabControllerModel As Object ' com.sun.star.awt.XTabControllerModel - com.sun.star.comp.forms.ODatabaseForm
65 Private _ControlModel As Object ' com.sun.star.awt.XControlModel - com.sun.star.form.OGridControlModel
66 Private _ControlView As Object ' com.sun.star.awt.XControl - org.openoffice.comp.dbu.ODatasourceBrowser
67 Private _ColumnHeaders As Variant ' List of column headers as an array of strings
69 ' Cache for static toolbar descriptions
70 Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document
72 REM ============================================================ MODULE CONSTANTS
74 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
76 REM -----------------------------------------------------------------------------
77 Private Sub Class_Initialize()
78 Set [Me] = Nothing
79 Set [_Parent] = Nothing
82 Set _Component = Nothing
83 Set _Frame = Nothing
84 Set _ParentBase = Nothing
85 Set _ParentDatabase = Nothing
86 _SheetType = ""
87 _ParentType = ""
88 _BaseFileName = ""
89 _Command = ""
90 _DirectSql = False
91 Set _TabControllerModel = Nothing
92 Set _ControlModel = Nothing
93 Set _ControlView = Nothing
94 _ColumnHeaders = Array()
95 Set _Toolbars = Nothing
96 End Sub ' SFDatabases.SF_Datasheet Constructor
98 REM -----------------------------------------------------------------------------
99 Private Sub Class_Terminate()
100 Call Class_Initialize()
101 End Sub ' SFDatabases.SF_Datasheet Destructor
103 REM -----------------------------------------------------------------------------
104 Public Function Dispose() As Variant
105 Call Class_Terminate()
106 Set Dispose = Nothing
107 End Function ' SFDatabases.SF_Datasheet Explicit Destructor
109 REM ================================================================== PROPERTIES
111 REM -----------------------------------------------------------------------------
112 Property Get ColumnHeaders() As Variant
113 ''' Returns the list of column headers of the datasheet as an array of strings
115 End Property ' SFDatabases.SF_Datasheet.ColumnHeaders
117 REM -----------------------------------------------------------------------------
118 Property Get CurrentColumn() As String
119 ''' Returns the currently selected column by its name
121 End Property ' SFDatabases.SF_Datasheet.CurrentColumn
123 REM -----------------------------------------------------------------------------
124 Property Get CurrentRow() As Long
127 End Property ' SFDatabases.SF_Datasheet.CurrentRow
129 REM -----------------------------------------------------------------------------
130 Property Get DatabaseFileName() As String
131 ''' Returns the file name of the Base file in FSO.FileNaming format
133 End Property ' SFDatabases.SF_Datasheet.DatabaseFileName
135 REM -----------------------------------------------------------------------------
136 Property Get Filter() As Variant
137 ''' The Filter is a SQL WHERE clause without the WHERE keyword
139 End Property ' SFDatabases.SF_Datasheet.Filter (get)
141 REM -----------------------------------------------------------------------------
142 Property Let Filter(Optional ByVal pvFilter As Variant)
143 ''' Set the updatable property Filter
144 ''' Table and field names may be surrounded by square brackets
145 ''' When the argument is the zero-length string, the actual filter is removed
147 End Property ' SFDatabases.SF_Datasheet.Filter (let)
149 REM -----------------------------------------------------------------------------
150 Property Get LastRow() As Long
151 ''' Returns the total number of rows
152 ''' The process may imply to move the cursor to the last available row.
153 ''' Afterwards the cursor is reset to the current row.
155 End Property ' SFDatabases.SF_Datasheet.LastRow
157 REM -----------------------------------------------------------------------------
158 Property Get OrderBy() As Variant
159 ''' The Order is a SQL ORDER BY clause without the ORDER BY keywords
161 End Property ' SFDocuments.SF_Form.OrderBy (get)
163 REM -----------------------------------------------------------------------------
164 Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
165 ''' Set the updatable property OrderBy
166 ''' Table and field names may be surrounded by square brackets
167 ''' When the argument is the zero-length string, the actual sort is removed
169 End Property ' SFDocuments.SF_Form.OrderBy (let)
171 REM -----------------------------------------------------------------------------
172 Property Get ParentDatabase() As Object
173 ''' Returns the database instance to which the datasheet belongs
175 End Property ' SFDatabases.SF_Datasheet.ParentDatabase
177 REM -----------------------------------------------------------------------------
178 Property Get Source() As String
179 ''' Returns the source of the data: table name, query name or sql statement
181 End Property ' SFDatabases.SF_Datasheet.Source
183 REM -----------------------------------------------------------------------------
184 Property Get SourceType() As String
185 ''' Returns thetype of source of the data: TABLE, QUERY or SQL
187 End Property ' SFDatabases.SF_Datasheet.SourceType
189 REM -----------------------------------------------------------------------------
190 Property Get XComponent() As Object
191 ''' Returns the com.sun.star.lang.XComponent UNO object representing the datasheet
193 End Property ' SFDocuments.SF_Document.XComponent
195 REM -----------------------------------------------------------------------------
196 Property Get XControlModel() As Object
197 ''' Returns the com.sun.star.lang.XControl UNO object representing the datasheet
199 End Property ' SFDocuments.SF_Document.XControlModel
201 REM -----------------------------------------------------------------------------
202 Property Get XTabControllerModel() As Object
203 ''' Returns the com.sun.star.lang.XTabControllerModel UNO object representing the datasheet
205 End Property ' SFDocuments.SF_Document.XTabControllerModel
207 REM ===================================================================== METHODS
209 REM -----------------------------------------------------------------------------
210 Public Sub Activate()
211 ''' Make the actual datasheet active
212 ''' Args:
213 ''' Returns:
214 ''' Examples:
215 ''' oSheet.Activate()
217 Dim oContainer As Object ' com.sun.star.awt.XWindow
219 Const cstSubArgs = ""
221 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
223 Check:
224 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
225 If Not _IsStillAlive() Then GoTo Finally
227 Try:
228 Set oContainer = _Component.Frame.ContainerWindow
229 With oContainer
230 If .isVisible() = False Then .setVisible(True)
231 .IsMinimized = False
232 .setFocus()
233 .toFront() ' Force window change in Linux
235 End With
237 Finally:
238 SF_Utils._ExitFunction(cstThisSub)
239 Exit Sub
240 Catch:
241 GoTo Finally
242 End Sub ' SFDatabases.SF_Datasheet.Activate
244 REM -----------------------------------------------------------------------------
245 Public Function CloseDatasheet() As Boolean
246 ''' Close the actual datasheet
247 ''' Args:
248 ''' Returns:
249 ''' True when successful
250 ''' Examples:
251 ''' oSheet.CloseDatasheet()
253 Dim bClose As Boolean ' Return value
255 Const cstSubArgs = ""
257 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
258 bClose = False
260 Check:
261 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
262 If Not _IsStillAlive() Then GoTo Finally
264 Try:
265 With _TabControllerModel
266 .ApplyFilter = False
267 .Filter = ""
268 .close()
269 End With
270 _Frame.close(True)
271 _Frame.dispose()
272 Dispose()
273 bClose = True
275 Finally:
276 CloseDatasheet = bClose
277 SF_Utils._ExitFunction(cstThisSub)
278 Exit Function
279 Catch:
280 GoTo Finally
281 End Function ' SFDatabases.SF_Datasheet.CloseDatasheet
283 REM -----------------------------------------------------------------------------
284 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
285 , Optional ByVal Before As Variant _
286 , Optional ByVal SubmenuChar As Variant _
287 ) As Object
289 ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor elsewhere
290 ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
291 ''' Args:
292 ''' MenuHeader: the name/header of the menu
293 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
296 ''' Returns:
297 ''' A SFWidgets.Menu instance or Nothing
298 ''' Examples:
299 ''' Dim oMenu As Object
300 ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
301 ''' With oMenu
303 ''' '...
304 ''' .Dispose() ' When definition is complete, the menu instance may be disposed
305 ''' End With
306 ''' ' ...
308 Dim oMenu As Object ' return value
310 Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"
312 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
313 Set oMenu = Nothing
315 Check:
316 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
317 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""
319 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
320 If Not _IsStillAlive() Then GoTo Finally
321 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
323 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
324 End If
326 Try:
327 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Component, MenuHeader, Before, SubmenuChar)
329 Finally:
330 Set CreateMenu = oMenu
331 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
332 Exit Function
333 Catch:
334 GoTo Finally
335 End Function ' SFDatabases.SF_Document.CreateMenu
337 REM -----------------------------------------------------------------------------
338 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
339 ''' Return the actual value of the given property
340 ''' Args:
341 ''' PropertyName: the name of the property as a string
342 ''' Returns:
343 ''' The actual value of the propRATTCerty
344 ''' If the property does not exist, returns Null
347 Const cstSubArgs = ""
349 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
350 GetProperty = Null
352 Check:
353 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
354 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
355 End If
357 Try:
358 GetProperty = _PropertyGet(PropertyName)
360 Finally:
361 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
362 Exit Function
363 Catch:
364 GoTo Finally
365 End Function ' SFDatabases.SF_Datasheet.GetProperty
367 REM -----------------------------------------------------------------------------
368 Public Function GetText(Optional ByVal Column As Variant) As String
369 ''' Get the text in the given column of the current row.
370 ''' Args:
371 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
372 ''' If the argument exceeds the number of columns, the last column is selected.
373 ''' Returns:
374 ''' The text in the cell as a string as how it is displayed
375 ''' Note that the position of the cursor is left unchanged.
376 ''' Examples:
377 ''' oSheet.GetText("ShipCity")) ' Extract the text on the current row from the column "ShipCity"
379 Dim sText As String ' Return Text
380 Dim lCol As Long ' Numeric index of Column in lists of columns
381 Dim lMaxCol As Long ' Index of last column
385 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
386 sText = ""
388 Check:
389 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
390 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
391 If Not _IsStillAlive() Then GoTo Finally
392 If VarType(Column) <> V_STRING Then
393 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
394 Else
395 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
396 End If
397 End If
399 Try:
401 With _ControlView
402 If VarType(Column) = V_STRING Then
403 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
404 Else
405 lCol = -1
407 lMaxCol = .Count - 1
409 Else
410 lCol = .getCurrentColumnPosition()
411 End If
412 End If
415 End With
417 Finally:
418 GetText = sText
419 SF_Utils._ExitFunction(cstThisSub)
420 Exit Function
421 Catch:
422 GoTo Finally
423 End Function ' SFDatabases.SF_Datasheet.GetText
425 REM -----------------------------------------------------------------------------
426 Public Function GetValue(Optional ByVal Column As Variant) As Variant
427 ''' Get the value in the given column of the current row.
428 ''' Args:
429 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
430 ''' If the argument exceeds the number of columns, the last column is selected.
431 ''' Returns:
432 ''' The value in the cell as a valid Basic type
433 ''' Typical types are: STRING, INTEGER, LONG, FLOAT, DOUBLE, DATE, NULL
434 ''' Binary types are returned as a LONG giving their length, not their content
435 ''' An EMPTY return value means that the value could not be retrieved.
436 ''' Note that the position of the cursor is left unchanged.
437 ''' Examples:
438 ''' oSheet.GetValue("ShipCity")) ' Extract the value on the current row from the column "ShipCity"
440 Dim vValue As Variant ' Return value
441 Dim lCol As Long ' Numeric index of Column in lists of columns
442 Dim lMaxCol As Long ' Index of last column
446 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
447 vValue = Empty
449 Check:
450 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
451 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
452 If Not _IsStillAlive() Then GoTo Finally
453 If VarType(Column) <> V_STRING Then
454 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
455 Else
456 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
457 End If
458 End If
460 Try:
462 If VarType(Column) = V_STRING Then
463 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False) + 1
464 Else
465 With _ControlView
466 lCol = 0
468 lMaxCol = .Count
469 If Column > lMaxCol Then lCol = lMaxCol Else lCol = Column
470 Else
471 lCol = .getCurrentColumnPosition() + 1
472 End If
473 End With
474 End If
476 ' The _TabControllerModel acts exactly as a result set, from which the generic _GetColumnValue can extract the searched value
479 Finally:
480 GetValue = vValue
481 SF_Utils._ExitFunction(cstThisSub)
482 Exit Function
483 Catch:
484 GoTo Finally
485 End Function ' SFDatabases.SF_Datasheet.GetValue
487 REM -----------------------------------------------------------------------------
488 Public Function GoToCell(Optional ByVal Row As Variant _
489 , Optional ByVal Column As Variant _
490 ) As Boolean
491 ''' Set the cursor on the given row and the given column.
492 ''' If the requested row exceeds the number of available rows, the cursor is set on the last row.
493 ''' If the requested column exceeds the number of available columns, the selected column is the last one.
494 ''' Args:
496 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
497 ''' Returns:
498 ''' True when successful
499 ''' Examples:
500 ''' oSheet.GoToCell(1000000, "ShipCity")) ' Set the cursor on he last row, column "ShipCity"
502 Dim bGoTo As Boolean ' Return value
503 Dim lCol As Long ' Numeric index of Column in list of columns
504 Dim lMaxCol As Long ' Index of last column
508 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
509 bGoTo = False
511 Check:
512 If IsMissing(Row) Or IsEmpty(Row) Then Row = 0
513 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
514 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
515 If Not _IsStillAlive() Then GoTo Finally
516 If Not ScriptForge.SF_Utils._Validate(Row, "Row", ScriptForge.V_NUMERIC) Then GoTo Catch
517 If VarType(Column) <> V_STRING Then
518 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
519 Else
520 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
521 End If
522 End If
524 Try:
525 ' Position the row
526 With _TabControllerModel
528 ' Does Row exceed the total number of rows ?
529 If .IsRowCountFinal And Row > .RowCount Then .absolute(.RowCount)
530 End With
532 ' Position the column
533 With _ControlView
534 If VarType(Column) = V_STRING Then
535 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
536 Else
537 lCol = -1
539 lMaxCol = .Count - 1
541 End If
542 End If
544 End With
546 bGoTo = True
548 Finally:
549 GoToCell = bGoTo
550 SF_Utils._ExitFunction(cstThisSub)
551 Exit Function
552 Catch:
553 GoTo Finally
554 End Function ' SFDatabases.SF_Datasheet.GoToCell
556 REM -----------------------------------------------------------------------------
557 Public Function Methods() As Variant
558 ''' Return the list of public methods of the Model service as an array
560 Methods = Array( _
568 )
570 End Function ' SFDatabases.SF_Datasheet.Methods
572 REM -----------------------------------------------------------------------------
573 Public Function Properties() As Variant
574 ''' Return the list or properties of the Model class as an array
576 Properties = Array( _
590 )
592 End Function ' SFDatabases.SF_Datasheet.Properties
594 REM -----------------------------------------------------------------------------
595 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
597 ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
598 ''' Args:
599 ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
600 ''' Returns:
601 ''' True when successful
602 ''' Examples:
604 ''' ' ...
606 Dim bRemove As Boolean ' Return value
607 Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
608 Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
609 Dim sName As String ' Menu name
610 Dim iMenuId As Integer ' Menu identifier
612 Dim i As Integer
618 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
619 bRemove = False
621 Check:
622 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
623 If Not _IsStillAlive() Then GoTo Finally
624 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
625 End If
627 Try:
628 Set oLayout = _Component.Frame.LayoutManager
631 ' Search the menu identifier to remove by its name, Mark its position
632 With oMenuBar
633 iMenuPosition = -1
635 iMenuId = .getItemId(i)
636 sName = Replace(.getItemText(iMenuId), cstTilde, "")
637 If MenuHeader= sName Then
638 iMenuPosition = i
639 Exit For
640 End If
641 Next i
642 ' Remove the found menu item
644 .removeItem(iMenuPosition, 1)
645 bRemove = True
646 End If
647 End With
649 Finally:
650 RemoveMenu = bRemove
651 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
652 Exit Function
653 Catch:
654 GoTo Finally
655 End Function ' SFDatabases.SF_Datasheet.RemoveMenu
657 REM -----------------------------------------------------------------------------
658 Public Function SetProperty(Optional ByVal PropertyName As Variant _
659 , Optional ByRef Value As Variant _
660 ) As Boolean
661 ''' Set a new value to the given property
662 ''' Args:
663 ''' PropertyName: the name of the property as a string
664 ''' Value: its new value
665 ''' Exceptions
666 ''' ARGUMENTERROR The property does not exist
671 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
672 SetProperty = False
674 Check:
675 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
676 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
677 End If
679 Try:
680 SetProperty = _PropertySet(PropertyName, Value)
682 Finally:
683 SF_Utils._ExitFunction(cstThisSub)
684 Exit Function
685 Catch:
686 GoTo Finally
687 End Function ' SFDatabases.SF_Datasheet.SetProperty
689 REM -----------------------------------------------------------------------------
690 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
691 ''' Returns either a list of the available toolbar names in the actual document
692 ''' or a Toolbar object instance.
693 ''' [Function identical with SFDocuments.SF_Document.Toolbars()]
694 ''' Args:
695 ''' ToolbarName: the usual name of one of the available toolbars
696 ''' Returns:
697 ''' A zero-based array of toolbar names when the argument is absent,
698 ''' or a new Toolbar object instance from the SF_Widgets library.
703 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
705 Check:
706 If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
707 If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
708 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
709 If Not _IsStillAlive() Then GoTo Finally
710 If VarType(ToolbarName) = V_STRING Then
712 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
713 End If
714 Else
715 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
716 End If
717 End If
719 Try:
720 If Len(ToolbarName) = 0 Then
721 Toolbars = _Toolbars.Keys()
722 Else
724 End If
726 Finally:
727 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
728 Exit Function
729 Catch:
730 GoTo Finally
731 End Function ' SF_Databases.SF_Datasheet.Toolbars
733 REM =========================================================== PRIVATE FUNCTIONS
735 REM -----------------------------------------------------------------------------
736 Public Sub _Initialize()
737 ''' Called immediately after instance creation to complete the initial values
738 ''' An eventual error must be trapped in the calling routine to cancel the instance creation
740 Dim iType As Integer ' One of the com.sun.star.sdb.CommandType constants
741 Dim oColumn As Object ' A single column
742 Dim oColumnDescriptor As Object ' A single column descriptor
743 Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem
744 Dim i As Long
746 Try:
747 If IsNull([_Parent]) Then _ParentType = "" Else _ParentType = [_Parent].ObjectType
749 With _Component
750 ' The existence of _Component.Selection must be checked upfront
754 Select Case iType
758 End Select
761 _DirectSql = Not ScriptForge.SF_Utils._GetPropertyValue(.Selection, "EscapeProcessing")
763 ' Useful UNO objects
764 Set _Frame = .Frame
765 Set _ControlView = .CurrentControl
766 Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel()
767 Set _ControlModel = _ControlView.getModel()
768 End With
770 With _TabControllerModel
771 ' Retrieve the parent database instance
772 Select Case _ParentType
774 Set _ParentDatabase = [_Parent].GetDatabase(.User, .Password)
775 Set _ParentBase = [_Parent]
777 Set _ParentDatabase = [_Parent]
778 Set _ParentBase = Nothing
779 Case "" ' Derive the DATABASE instance from what can be found in the Component
780 Set _ParentDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
781 , FSO._ConvertFromUrl(_BaseFileName), , , .User, .Password)
783 Set _ParentBase = Nothing
784 End Select
785 ' Load column headers
786 _ColumnHeaders = .getColumns().getElementNames()
787 End With
789 Finally:
790 Exit Sub
791 End Sub ' SFDatabases.SF_Datasheet._Initialize
793 REM -----------------------------------------------------------------------------
794 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
795 ''' Returns True if the datasheet has not been closed manually or incidentally since the last use
796 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
797 ''' Args:
798 ''' pbError: if True (default), raise a fatal error
800 Dim bAlive As Boolean ' Return value
801 Dim sName As String ' Used in error message
803 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
804 If IsMissing(pbError) Then pbError = True
806 Try:
807 ' Check existence of datasheet
808 bAlive = Not IsNull(_Component.ComponentWindow)
810 Finally:
811 If pbError And Not bAlive Then
812 sName = _Command
813 Dispose()
814 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sName)
815 End If
816 _IsStillAlive = bAlive
817 Exit Function
818 Catch:
819 bAlive = False
820 On Error GoTo 0
821 GoTo Finally
822 End Function ' SFDatabases.SF_Datasheet._IsStillAlive
824 REM -----------------------------------------------------------------------------
825 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
826 ''' Return the value of the named property
827 ''' Args:
828 ''' psProperty: the name of the property
830 Dim lRow As Long ' Actual row number
831 Dim cstThisSub As String
832 Const cstSubArgs = ""
835 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
837 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
838 If Not _IsStillAlive(False) Then GoTo Finally
840 Select Case psProperty
842 _PropertyGet = _ColumnHeaders
844 _PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition())
846 _PropertyGet = _TabControllerModel.Row
848 _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName)
850 _PropertyGet = _TabControllerModel.Filter
852 With _TabControllerModel
853 If .IsRowCountFinal Then
854 _PropertyGet = .RowCount
855 Else
856 lRow = .Row
858 .last()
859 _PropertyGet = .RowCount
860 .absolute(lRow)
861 Else
862 _PropertyGet = 0
863 End If
864 End If
865 End With
867 _PropertyGet = _TabControllerModel.Order
869 Set _PropertyGet = _ParentDatabase
871 _PropertyGet = _Command
873 _PropertyGet = _SheetType
875 Set _PropertyGet = _Component
877 Set _PropertyGet = _ControlModel
879 Set _PropertyGet = _TabControllerModel
880 Case Else
881 _PropertyGet = Null
882 End Select
884 Finally:
885 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
886 Exit Function
887 Catch:
888 GoTo Finally
889 End Function ' SFDatabases.SF_Datasheet._PropertyGet
891 REM -----------------------------------------------------------------------------
892 Private Function _PropertySet(Optional ByVal psProperty As String _
893 , Optional ByVal pvValue As Variant _
894 ) As Boolean
895 ''' Set the new value of the named property
896 ''' Args:
897 ''' psProperty: the name of the property
898 ''' pvValue: the new value of the given property
899 ''' Returns:
900 ''' True if successful
902 Dim bSet As Boolean ' Return value
903 Dim cstThisSub As String
906 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
907 bSet = False
910 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
911 If Not _IsStillAlive() Then GoTo Finally
913 bSet = True
914 Select Case UCase(psProperty)
917 With _TabControllerModel
918 If Len(pvValue) > 0 Then .Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = ""
920 .reload()
921 End With
924 With _TabControllerModel
925 If Len(pvValue) > 0 Then .Order = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Order = ""
926 .reload()
927 End With
928 Case Else
929 bSet = False
930 End Select
932 Finally:
933 _PropertySet = bSet
934 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
935 Exit Function
936 Catch:
937 GoTo Finally
938 End Function ' SFDatabases.SF_Datasheet._PropertySet
940 REM -----------------------------------------------------------------------------
941 Private Function _Repr() As String
942 ''' Convert the Datasheet instance to a readable string, typically for debugging purposes (DebugPrint ...)
943 ''' Args:
944 ''' Return:
949 End Function ' SFDatabases.SF_Datasheet._Repr
951 REM ============================================ END OF SFDATABASES.SF_DATASHEET
952 </script:module>