| blob | c505dd45f1042d7895a6aab1dc4f2998e4a5e80d |
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 IsAlive() As Boolean
152 End Property ' SFDatabases.SF_Datasheet.IsAlive
154 REM -----------------------------------------------------------------------------
155 Property Get LastRow() As Long
156 ''' Returns the total number of rows
157 ''' The process may imply to move the cursor to the last available row.
158 ''' Afterwards the cursor is reset to the current row.
160 End Property ' SFDatabases.SF_Datasheet.LastRow
162 REM -----------------------------------------------------------------------------
163 Property Get OrderBy() As Variant
164 ''' The Order is a SQL ORDER BY clause without the ORDER BY keywords
166 End Property ' SFDocuments.SF_Form.OrderBy (get)
168 REM -----------------------------------------------------------------------------
169 Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
170 ''' Set the updatable property OrderBy
171 ''' Table and field names may be surrounded by square brackets
172 ''' When the argument is the zero-length string, the actual sort is removed
174 End Property ' SFDocuments.SF_Form.OrderBy (let)
176 REM -----------------------------------------------------------------------------
177 Property Get ParentDatabase() As Object
178 ''' Returns the database instance to which the datasheet belongs
180 End Property ' SFDatabases.SF_Datasheet.ParentDatabase
182 REM -----------------------------------------------------------------------------
183 Property Get Source() As String
184 ''' Returns the source of the data: table name, query name or sql statement
186 End Property ' SFDatabases.SF_Datasheet.Source
188 REM -----------------------------------------------------------------------------
189 Property Get SourceType() As String
190 ''' Returns thetype of source of the data: TABLE, QUERY or SQL
192 End Property ' SFDatabases.SF_Datasheet.SourceType
194 REM -----------------------------------------------------------------------------
195 Property Get XComponent() As Object
196 ''' Returns the com.sun.star.lang.XComponent UNO object representing the datasheet
198 End Property ' SFDocuments.SF_Document.XComponent
200 REM -----------------------------------------------------------------------------
201 Property Get XControlModel() As Object
202 ''' Returns the com.sun.star.lang.XControl UNO object representing the datasheet
204 End Property ' SFDocuments.SF_Document.XControlModel
206 REM -----------------------------------------------------------------------------
207 Property Get XTabControllerModel() As Object
208 ''' Returns the com.sun.star.lang.XTabControllerModel UNO object representing the datasheet
210 End Property ' SFDocuments.SF_Document.XTabControllerModel
212 REM ===================================================================== METHODS
214 REM -----------------------------------------------------------------------------
215 Public Sub Activate()
216 ''' Make the actual datasheet active
217 ''' Args:
218 ''' Returns:
219 ''' Examples:
220 ''' oSheet.Activate()
222 Dim oContainer As Object ' com.sun.star.awt.XWindow
224 Const cstSubArgs = ""
226 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
228 Check:
229 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
230 If Not _IsStillAlive() Then GoTo Finally
232 Try:
233 Set oContainer = _Component.Frame.ContainerWindow
234 With oContainer
235 If .isVisible() = False Then .setVisible(True)
236 .IsMinimized = False
237 .setFocus()
238 .toFront() ' Force window change in Linux
240 End With
242 Finally:
243 SF_Utils._ExitFunction(cstThisSub)
244 Exit Sub
245 Catch:
246 GoTo Finally
247 End Sub ' SFDatabases.SF_Datasheet.Activate
249 REM -----------------------------------------------------------------------------
250 Public Function CloseDatasheet() As Boolean
251 ''' Close the actual datasheet
252 ''' Args:
253 ''' Returns:
254 ''' True when successful
255 ''' Examples:
256 ''' oSheet.CloseDatasheet()
258 Dim bClose As Boolean ' Return value
260 Const cstSubArgs = ""
262 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
263 bClose = False
265 Check:
266 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
267 If Not _IsStillAlive() Then GoTo Finally
269 Try:
270 With _TabControllerModel
271 .ApplyFilter = False
272 .Filter = ""
273 .close()
274 End With
275 _Frame.close(True)
276 _Frame.dispose()
277 Dispose()
278 bClose = True
280 Finally:
281 CloseDatasheet = bClose
282 SF_Utils._ExitFunction(cstThisSub)
283 Exit Function
284 Catch:
285 GoTo Finally
286 End Function ' SFDatabases.SF_Datasheet.CloseDatasheet
288 REM -----------------------------------------------------------------------------
289 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
290 , Optional ByVal Before As Variant _
291 , Optional ByVal SubmenuChar As Variant _
292 ) As Object
294 ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor elsewhere
295 ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
296 ''' Args:
297 ''' MenuHeader: the name/header of the menu
298 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
301 ''' Returns:
302 ''' A SFWidgets.Menu instance or Nothing
303 ''' Examples:
304 ''' Dim oMenu As Object
305 ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
306 ''' With oMenu
308 ''' '...
309 ''' .Dispose() ' When definition is complete, the menu instance may be disposed
310 ''' End With
311 ''' ' ...
313 Dim oMenu As Object ' return value
315 Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"
317 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
318 Set oMenu = Nothing
320 Check:
321 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
322 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""
324 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
325 If Not _IsStillAlive() Then GoTo Finally
326 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
328 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
329 End If
331 Try:
332 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Component, MenuHeader, Before, SubmenuChar)
334 Finally:
335 Set CreateMenu = oMenu
336 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
337 Exit Function
338 Catch:
339 GoTo Finally
340 End Function ' SFDatabases.SF_Document.CreateMenu
342 REM -----------------------------------------------------------------------------
343 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
344 ''' Return the actual value of the given property
345 ''' Args:
346 ''' PropertyName: the name of the property as a string
347 ''' Returns:
348 ''' The actual value of the propRATTCerty
349 ''' If the property does not exist, returns Null
352 Const cstSubArgs = ""
354 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
355 GetProperty = Null
357 Check:
358 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
359 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
360 End If
362 Try:
363 GetProperty = _PropertyGet(PropertyName)
365 Finally:
366 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
367 Exit Function
368 Catch:
369 GoTo Finally
370 End Function ' SFDatabases.SF_Datasheet.GetProperty
372 REM -----------------------------------------------------------------------------
373 Public Function GetText(Optional ByVal Column As Variant) As String
374 ''' Get the text in the given column of the current row.
375 ''' Args:
376 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
377 ''' If the argument exceeds the number of columns, the last column is selected.
378 ''' Returns:
379 ''' The text in the cell as a string as how it is displayed
380 ''' Note that the position of the cursor is left unchanged.
381 ''' Examples:
382 ''' oSheet.GetText("ShipCity")) ' Extract the text on the current row from the column "ShipCity"
384 Dim sText As String ' Return Text
385 Dim lCol As Long ' Numeric index of Column in lists of columns
386 Dim lMaxCol As Long ' Index of last column
390 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
391 sText = ""
393 Check:
394 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
395 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
396 If Not _IsStillAlive() Then GoTo Finally
397 If VarType(Column) <> V_STRING Then
398 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
399 Else
400 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
401 End If
402 End If
404 Try:
406 With _ControlView
407 If VarType(Column) = V_STRING Then
408 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
409 Else
410 lCol = -1
412 lMaxCol = .Count - 1
414 Else
415 lCol = .getCurrentColumnPosition()
416 End If
417 End If
420 End With
422 Finally:
423 GetText = sText
424 SF_Utils._ExitFunction(cstThisSub)
425 Exit Function
426 Catch:
427 GoTo Finally
428 End Function ' SFDatabases.SF_Datasheet.GetText
430 REM -----------------------------------------------------------------------------
431 Public Function GetValue(Optional ByVal Column As Variant) As Variant
432 ''' Get the value in the given column of the current row.
433 ''' Args:
434 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
435 ''' If the argument exceeds the number of columns, the last column is selected.
436 ''' Returns:
437 ''' The value in the cell as a valid Basic type
438 ''' Typical types are: STRING, INTEGER, LONG, FLOAT, DOUBLE, DATE, NULL
439 ''' Binary types are returned as a LONG giving their length, not their content
440 ''' An EMPTY return value means that the value could not be retrieved.
441 ''' Note that the position of the cursor is left unchanged.
442 ''' Examples:
443 ''' oSheet.GetValue("ShipCity")) ' Extract the value on the current row from the column "ShipCity"
445 Dim vValue As Variant ' Return value
446 Dim lCol As Long ' Numeric index of Column in lists of columns
447 Dim lMaxCol As Long ' Index of last column
451 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
452 vValue = Empty
454 Check:
455 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
456 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
457 If Not _IsStillAlive() Then GoTo Finally
458 If VarType(Column) <> V_STRING Then
459 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
460 Else
461 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
462 End If
463 End If
465 Try:
467 If VarType(Column) = V_STRING Then
468 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False) + 1
469 Else
470 With _ControlView
471 lCol = 0
473 lMaxCol = .Count
474 If Column > lMaxCol Then lCol = lMaxCol Else lCol = Column
475 Else
476 lCol = .getCurrentColumnPosition() + 1
477 End If
478 End With
479 End If
481 ' The _TabControllerModel acts exactly as a result set, from which the generic _GetColumnValue can extract the searched value
484 Finally:
485 GetValue = vValue
486 SF_Utils._ExitFunction(cstThisSub)
487 Exit Function
488 Catch:
489 GoTo Finally
490 End Function ' SFDatabases.SF_Datasheet.GetValue
492 REM -----------------------------------------------------------------------------
493 Public Function GoToCell(Optional ByVal Row As Variant _
494 , Optional ByVal Column As Variant _
495 ) As Boolean
496 ''' Set the cursor on the given row and the given column.
497 ''' If the requested row exceeds the number of available rows, the cursor is set on the last row.
498 ''' If the requested column exceeds the number of available columns, the selected column is the last one.
499 ''' Args:
501 ''' Column: the name of the column as a string or its position (>= 1). Default = the current column
502 ''' Returns:
503 ''' True when successful
504 ''' Examples:
505 ''' oSheet.GoToCell(1000000, "ShipCity")) ' Set the cursor on he last row, column "ShipCity"
507 Dim bGoTo As Boolean ' Return value
508 Dim lCol As Long ' Numeric index of Column in list of columns
509 Dim lMaxCol As Long ' Index of last column
513 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
514 bGoTo = False
516 Check:
517 If IsMissing(Row) Or IsEmpty(Row) Then Row = 0
518 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
519 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
520 If Not _IsStillAlive() Then GoTo Finally
521 If Not ScriptForge.SF_Utils._Validate(Row, "Row", ScriptForge.V_NUMERIC) Then GoTo Catch
522 If VarType(Column) <> V_STRING Then
523 If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
524 Else
525 If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
526 End If
527 End If
529 Try:
530 ' Position the row
531 With _TabControllerModel
533 ' Does Row exceed the total number of rows ?
534 If .IsRowCountFinal And Row > .RowCount Then .absolute(.RowCount)
535 End With
537 ' Position the column
538 With _ControlView
539 If VarType(Column) = V_STRING Then
540 lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
541 Else
542 lCol = -1
544 lMaxCol = .Count - 1
546 End If
547 End If
549 End With
551 bGoTo = True
553 Finally:
554 GoToCell = bGoTo
555 SF_Utils._ExitFunction(cstThisSub)
556 Exit Function
557 Catch:
558 GoTo Finally
559 End Function ' SFDatabases.SF_Datasheet.GoToCell
561 REM -----------------------------------------------------------------------------
562 Public Function Methods() As Variant
563 ''' Return the list of public methods of the Model service as an array
565 Methods = Array( _
573 )
575 End Function ' SFDatabases.SF_Datasheet.Methods
577 REM -----------------------------------------------------------------------------
578 Public Function Properties() As Variant
579 ''' Return the list or properties of the Model class as an array
581 Properties = Array( _
596 )
598 End Function ' SFDatabases.SF_Datasheet.Properties
600 REM -----------------------------------------------------------------------------
601 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
603 ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
604 ''' Args:
605 ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
606 ''' Returns:
607 ''' True when successful
608 ''' Examples:
610 ''' ' ...
612 Dim bRemove As Boolean ' Return value
613 Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
614 Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
615 Dim sName As String ' Menu name
616 Dim iMenuId As Integer ' Menu identifier
618 Dim i As Integer
624 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
625 bRemove = False
627 Check:
628 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
629 If Not _IsStillAlive() Then GoTo Finally
630 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
631 End If
633 Try:
634 Set oLayout = _Component.Frame.LayoutManager
637 ' Search the menu identifier to remove by its name, Mark its position
638 With oMenuBar
639 iMenuPosition = -1
641 iMenuId = .getItemId(i)
642 sName = Replace(.getItemText(iMenuId), cstTilde, "")
643 If MenuHeader= sName Then
644 iMenuPosition = i
645 Exit For
646 End If
647 Next i
648 ' Remove the found menu item
650 .removeItem(iMenuPosition, 1)
651 bRemove = True
652 End If
653 End With
655 Finally:
656 RemoveMenu = bRemove
657 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
658 Exit Function
659 Catch:
660 GoTo Finally
661 End Function ' SFDatabases.SF_Datasheet.RemoveMenu
663 REM -----------------------------------------------------------------------------
664 Public Function SetProperty(Optional ByVal PropertyName As Variant _
665 , Optional ByRef Value As Variant _
666 ) As Boolean
667 ''' Set a new value to the given property
668 ''' Args:
669 ''' PropertyName: the name of the property as a string
670 ''' Value: its new value
671 ''' Exceptions
672 ''' ARGUMENTERROR The property does not exist
677 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
678 SetProperty = False
680 Check:
681 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
682 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
683 End If
685 Try:
686 SetProperty = _PropertySet(PropertyName, Value)
688 Finally:
689 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
690 Exit Function
691 Catch:
692 GoTo Finally
693 End Function ' SFDatabases.SF_Datasheet.SetProperty
695 REM -----------------------------------------------------------------------------
696 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
697 ''' Returns either a list of the available toolbar names in the actual document
698 ''' or a Toolbar object instance.
699 ''' [Function identical with SFDocuments.SF_Document.Toolbars()]
700 ''' Args:
701 ''' ToolbarName: the usual name of one of the available toolbars
702 ''' Returns:
703 ''' A zero-based array of toolbar names when the argument is absent,
704 ''' or a new Toolbar object instance from the SF_Widgets library.
709 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
711 Check:
712 If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
713 If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
714 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
715 If Not _IsStillAlive() Then GoTo Finally
716 If VarType(ToolbarName) = V_STRING Then
718 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
719 End If
720 Else
721 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
722 End If
723 End If
725 Try:
726 If Len(ToolbarName) = 0 Then
727 Toolbars = _Toolbars.Keys()
728 Else
730 End If
732 Finally:
733 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
734 Exit Function
735 Catch:
736 GoTo Finally
737 End Function ' SF_Databases.SF_Datasheet.Toolbars
739 REM =========================================================== PRIVATE FUNCTIONS
741 REM -----------------------------------------------------------------------------
742 Public Sub _Initialize()
743 ''' Called immediately after instance creation to complete the initial values
744 ''' An eventual error must be trapped in the calling routine to cancel the instance creation
746 Dim iType As Integer ' One of the com.sun.star.sdb.CommandType constants
747 Dim oColumn As Object ' A single column
748 Dim oColumnDescriptor As Object ' A single column descriptor
749 Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem
750 Dim i As Long
752 Try:
753 If IsNull([_Parent]) Then _ParentType = "" Else _ParentType = [_Parent].ObjectType
755 With _Component
756 ' The existence of _Component.Selection must be checked upfront
760 Select Case iType
764 End Select
767 _DirectSql = Not ScriptForge.SF_Utils._GetPropertyValue(.Selection, "EscapeProcessing")
769 ' Useful UNO objects
770 Set _Frame = .Frame
771 Set _ControlView = .CurrentControl
772 Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel()
773 Set _ControlModel = _ControlView.getModel()
774 End With
776 With _TabControllerModel
777 ' Retrieve the parent database instance
778 Select Case _ParentType
780 Set _ParentDatabase = [_Parent].GetDatabase(.User, .Password)
781 Set _ParentBase = [_Parent]
783 Set _ParentDatabase = [_Parent]
784 Set _ParentBase = Nothing
785 Case "" ' Derive the DATABASE instance from what can be found in the Component
786 Set _ParentDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
787 , FSO._ConvertFromUrl(_BaseFileName), , , .User, .Password)
789 Set _ParentBase = Nothing
790 End Select
791 ' Load column headers
792 _ColumnHeaders = .getColumns().getElementNames()
793 End With
795 Finally:
796 Exit Sub
797 End Sub ' SFDatabases.SF_Datasheet._Initialize
799 REM -----------------------------------------------------------------------------
800 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
801 ''' Returns True if the datasheet has not been closed manually or incidentally since the last use
802 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
803 ''' Args:
804 ''' pbError: if True (default), raise a fatal error
806 Dim bAlive As Boolean ' Return value
807 Dim sName As String ' Used in error message
809 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
810 If IsMissing(pbError) Then pbError = True
812 Try:
813 ' Check existence of datasheet
814 bAlive = Not IsNull(_Component.ComponentWindow)
816 Finally:
817 If pbError And Not bAlive Then
818 sName = _Command
819 Dispose()
820 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sName)
821 End If
822 _IsStillAlive = bAlive
823 Exit Function
824 Catch:
825 bAlive = False
826 On Error GoTo 0
827 GoTo Finally
828 End Function ' SFDatabases.SF_Datasheet._IsStillAlive
830 REM -----------------------------------------------------------------------------
831 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
832 ''' Return the value of the named property
833 ''' Args:
834 ''' psProperty: the name of the property
836 Dim lRow As Long ' Actual row number
837 Dim cstThisSub As String
838 Const cstSubArgs = ""
841 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
843 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
845 If Not _IsStillAlive() Then GoTo Finally
846 End If
848 Select Case psProperty
850 _PropertyGet = _ColumnHeaders
852 _PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition())
854 _PropertyGet = _TabControllerModel.Row
856 _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName)
858 _PropertyGet = _TabControllerModel.Filter
860 _PropertyGet = _IsStillAlive(False)
862 With _TabControllerModel
863 If .IsRowCountFinal Then
864 _PropertyGet = .RowCount
865 Else
866 lRow = .Row
868 .last()
869 _PropertyGet = .RowCount
870 .absolute(lRow)
871 Else
872 _PropertyGet = 0
873 End If
874 End If
875 End With
877 _PropertyGet = _TabControllerModel.Order
879 Set _PropertyGet = _ParentDatabase
881 _PropertyGet = _Command
883 _PropertyGet = _SheetType
885 Set _PropertyGet = _Component
887 Set _PropertyGet = _ControlModel
889 Set _PropertyGet = _TabControllerModel
890 Case Else
891 _PropertyGet = Null
892 End Select
894 Finally:
895 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
896 Exit Function
897 Catch:
898 GoTo Finally
899 End Function ' SFDatabases.SF_Datasheet._PropertyGet
901 REM -----------------------------------------------------------------------------
902 Private Function _PropertySet(Optional ByVal psProperty As String _
903 , Optional ByVal pvValue As Variant _
904 ) As Boolean
905 ''' Set the new value of the named property
906 ''' Args:
907 ''' psProperty: the name of the property
908 ''' pvValue: the new value of the given property
909 ''' Returns:
910 ''' True if successful
912 Dim bSet As Boolean ' Return value
913 Dim cstThisSub As String
916 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
917 bSet = False
920 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
921 If Not _IsStillAlive() Then GoTo Finally
923 bSet = True
924 Select Case UCase(psProperty)
927 With _TabControllerModel
928 If Len(pvValue) > 0 Then .Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = ""
930 .reload()
931 End With
934 With _TabControllerModel
935 If Len(pvValue) > 0 Then .Order = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Order = ""
936 .reload()
937 End With
938 Case Else
939 bSet = False
940 End Select
942 Finally:
943 _PropertySet = bSet
944 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
945 Exit Function
946 Catch:
947 GoTo Finally
948 End Function ' SFDatabases.SF_Datasheet._PropertySet
950 REM -----------------------------------------------------------------------------
951 Private Function _Repr() As String
952 ''' Convert the Datasheet instance to a readable string, typically for debugging purposes (DebugPrint ...)
953 ''' Args:
954 ''' Return:
959 End Function ' SFDatabases.SF_Datasheet._Repr
961 REM ============================================ END OF SFDATABASES.SF_DATASHEET
962 </script:module>