Quelle  SF_Datasheet.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Datasheet" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM ===   The ScriptForge library and its associated libraries are part of the LibreOffice project.    ===
REM ===      The SFDatabases library is one of the associated libraries.         ===
REM ===     Full documentation is available on https://help.libreoffice.org/        ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Datasheet
''' ============
'''  A datasheet is the visual representation of tabular data produced by a database.
'''  In the user interface of LibreOffice it is the result of the opening of
'''  a table or a query. In this case the concerned Base document must be open.
'''
'''  In the context of ScriptForge, a datasheet may be opened automatically by script code :
'''   - either by reproducing the behaviour of the user interface
'''   - or at any moment. In this case the Base document may or may not be opened.
'''     Additionally, any SELECT SQL statement may define the datasheet display.
'''
'''  The proposed API allows for either datasheets (opened manually of by code) in particular
'''  to know which cell is selected and its content.
'''
'''  Service invocation:
'''   1) From an open Base document
'''    Set ui = CreateScriptService("UI")
'''    Set oBase = ui.getDocument("/home/user/Documents/myDb.odb")
'''    Set oSheet = oBase.OpenTable("Customers") ' or OpenQuery(...)
'''      ' May be executed also when the given table is already open
'''   2) Independently from a Base document
'''    Set oDatabase = CreateScriptService("Database", "/home/user/Documents/myDb.odb")
'''    Set oSheet = oDatabase.OpenTable("Customers")
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_datasheet.html?DbPAR=BASIC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

REM ================================================================== EXCEPTIONS

Private Const DOCUMENTDEADERROR  = "DOCUMENTDEADERROR"

REM ============================================================= PRIVATE MEMBERS

Private [Me]    As Object
Private [_Parent]   As Object  ' Base instance when opened from a Base document by code
           ' or Database instance when opened without Base document
Private ObjectType   As String  ' Must be DATASHEET
Private ServiceName   As String

Private _Component   As Object  ' com.sun.star.lang.XComponent - org.openoffice.comp.dbu.ODatasourceBrowser
Private _Frame    As Object  ' com.sun.star.frame.XFrame
Private _ParentBase   As Object  ' The parent SF_Base instance (may be void)
Private _ParentDatabase  As Object  ' The parent SF_Database instance (must not be void)
Private _SheetType   As String  ' TABLE, QUERY or SQL
Private _ParentType   As String  ' BASE or DATABASE
Private _BaseFileName  As String  ' URL format of parent Base file
Private _Command   As String  ' Table name, query name or SQL statement
Private _DirectSql   As Boolean  ' When True, SQL processed by RDBMS
Private _TabControllerModel As Object  ' com.sun.star.awt.XTabControllerModel - com.sun.star.comp.forms.ODatabaseForm
Private _ControlModel  As Object  ' com.sun.star.awt.XControlModel - com.sun.star.form.OGridControlModel
Private _ControlView  As Object  ' com.sun.star.awt.XControl - org.openoffice.comp.dbu.ODatasourceBrowser
Private _ColumnHeaders  As Variant  ' List of column headers as an array of strings

' Cache for static toolbar descriptions
Private _Toolbars    As Object ' SF_Dictionary instance to hold toolbars stored in application or in document

REM ============================================================ MODULE CONSTANTS

REM ====================================================== CONSTRUCTOR/DESTRUCTOR

REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
 Set [Me] = Nothing
 Set [_Parent] = Nothing
 ObjectType = "DATASHEET"
 ServiceName = "SFDatabases.Datasheet"
 Set _Component = Nothing
 Set _Frame = Nothing
 Set _ParentBase = Nothing
 Set _ParentDatabase = Nothing
 _SheetType = ""
 _ParentType = ""
 _BaseFileName = ""
 _Command = ""
 _DirectSql = False
 Set _TabControllerModel = Nothing
 Set _ControlModel = Nothing
 Set _ControlView = Nothing
 _ColumnHeaders = Array()
 Set _Toolbars = Nothing
End Sub  ' SFDatabases.SF_Datasheet Constructor

REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
 Call Class_Initialize()
End Sub  ' SFDatabases.SF_Datasheet Destructor

REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
 Call Class_Terminate()
 Set Dispose = Nothing
End Function ' SFDatabases.SF_Datasheet Explicit Destructor

REM ================================================================== PROPERTIES

REM -----------------------------------------------------------------------------
Property Get ColumnHeaders() As Variant
''' Returns the list of column headers of the datasheet as an array of strings
 ColumnHeaders = _PropertyGet("ColumnHeaders")
End Property ' SFDatabases.SF_Datasheet.ColumnHeaders

REM -----------------------------------------------------------------------------
Property Get CurrentColumn() As String
''' Returns the currently selected column by its name
 CurrentColumn = _PropertyGet("CurrentColumn")
End Property ' SFDatabases.SF_Datasheet.CurrentColumn

REM -----------------------------------------------------------------------------
Property Get CurrentRow() As Long
''' Returns the currently selected row by its number >= 1
 CurrentRow = _PropertyGet("CurrentRow")
End Property ' SFDatabases.SF_Datasheet.CurrentRow

REM -----------------------------------------------------------------------------
Property Get DatabaseFileName() As String
''' Returns the file name of the Base file in FSO.FileNaming format
 DatabaseFileName = _PropertyGet("DatabaseFileName")
End Property ' SFDatabases.SF_Datasheet.DatabaseFileName

REM -----------------------------------------------------------------------------
Property Get Filter() As Variant
''' The Filter is a SQL WHERE clause without the WHERE keyword
 Filter = _PropertyGet("Filter")
End Property ' SFDatabases.SF_Datasheet.Filter (get)

REM -----------------------------------------------------------------------------
Property Let Filter(Optional ByVal pvFilter As Variant)
''' Set the updatable property Filter
''' Table and field names may be surrounded by square brackets
''' When the argument is the zero-length string, the actual filter is removed
 _PropertySet("Filter", pvFilter)
End Property ' SFDatabases.SF_Datasheet.Filter (let)

REM -----------------------------------------------------------------------------
Property Get IsAlive() As Boolean
 IsAlive = _PropertyGet("IsAlive")
End Property ' SFDatabases.SF_Datasheet.IsAlive

REM -----------------------------------------------------------------------------
Property Get LastRow() As Long
''' Returns the total number of rows
''' The process may imply to move the cursor to the last available row.
''' Afterwards the cursor is reset to the current row.
 LastRow = _PropertyGet("LastRow")
End Property ' SFDatabases.SF_Datasheet.LastRow

REM -----------------------------------------------------------------------------
Property Get MenuHeaders() As Variant
''' Returns the list, as an array of strings, of the menu headers present in the menubar
 MenuHeaders = _PropertyGet("MenuHeaders")
End Property ' SFDocuments.SF_Datasheet.MenuHeaders

REM -----------------------------------------------------------------------------
Property Get OrderBy() As Variant
''' The Order is a SQL ORDER BY clause without the ORDER BY keywords
 OrderBy = _PropertyGet("OrderBy")
End Property ' SFDocuments.SF_Form.OrderBy (get)

REM -----------------------------------------------------------------------------
Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
''' Set the updatable property OrderBy
''' Table and field names may be surrounded by square brackets
''' When the argument is the zero-length string, the actual sort is removed
 _PropertySet("OrderBy", pvOrderBy)
End Property ' SFDocuments.SF_Form.OrderBy (let)

REM -----------------------------------------------------------------------------
Property Get ParentDatabase() As Object
''' Returns the database instance to which the datasheet belongs
 Set ParentDatabase = _PropertyGet("ParentDatabase")
End Property ' SFDatabases.SF_Datasheet.ParentDatabase

REM -----------------------------------------------------------------------------
Property Get Source() As String
''' Returns the source of the data: table name, query name or sql statement
 Source = _PropertyGet("Source")
End Property ' SFDatabases.SF_Datasheet.Source

REM -----------------------------------------------------------------------------
Property Get SourceType() As String
''' Returns thetype of source of the data: TABLE, QUERY or SQL
 SourceType = _PropertyGet("SourceType")
End Property ' SFDatabases.SF_Datasheet.SourceType

REM -----------------------------------------------------------------------------
Property Get XComponent() As Object
''' Returns the com.sun.star.lang.XComponent UNO object representing the datasheet
 XComponent = _PropertyGet("XComponent")
End Property ' SFDocuments.SF_Document.XComponent

REM -----------------------------------------------------------------------------
Property Get XControlModel() As Object
''' Returns the com.sun.star.lang.XControl UNO object representing the datasheet
 XControlModel = _PropertyGet("XControlModel")
End Property ' SFDocuments.SF_Document.XControlModel

REM -----------------------------------------------------------------------------
Property Get XTabControllerModel() As Object
''' Returns the com.sun.star.lang.XTabControllerModel UNO object representing the datasheet
 XTabControllerModel = _PropertyGet("XTabControllerModel")
End Property ' SFDocuments.SF_Document.XTabControllerModel

REM ===================================================================== METHODS

REM -----------------------------------------------------------------------------
Public Sub Activate()
''' Make the actual datasheet active
''' Args:
''' Returns:
''' Examples:
'''  oSheet.Activate()

Dim oContainer As Object   ' com.sun.star.awt.XWindow
Const cstThisSub = "SFDatabases.Datasheet.Activate"
Const cstSubArgs = ""

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If Not _IsStillAlive() Then GoTo Finally

Try:
 Set oContainer = _Component.Frame.ContainerWindow
 With oContainer
  If .isVisible() = False Then .setVisible(True)
  .IsMinimized = False
  .setFocus()
  .toFront()    ' Force window change in Linux
  Wait 1     ' Bypass desynchro issue in Linux
 End With

Finally:
 SF_Utils._ExitFunction(cstThisSub)
 Exit Sub
Catch:
 GoTo Finally
End Sub   '   SFDatabases.SF_Datasheet.Activate

REM -----------------------------------------------------------------------------
Public Function CloseDatasheet() As Boolean
''' Close the actual datasheet
''' Args:
''' Returns:
'''  True when successful
''' Examples:
'''  oSheet.CloseDatasheet()

Dim bClose As Boolean  ' Return value
Const cstThisSub = "SFDatabases.Datasheet.CloseDatasheet"
Const cstSubArgs = ""

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bClose = False

Check:
 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If Not _IsStillAlive() Then GoTo Finally

Try:
 With _TabControllerModel
  .ApplyFilter = False
  .Filter = ""
  .close()
 End With
 _Frame.close(True)
 _Frame.dispose()
 Dispose()
 bClose = True

Finally:
 CloseDatasheet = bClose
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function '   SFDatabases.SF_Datasheet.CloseDatasheet

REM -----------------------------------------------------------------------------
Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
        , Optional ByVal Before As Variant _
        , Optional ByVal SubmenuChar As Variant _
        ) As Object
''' Create a new menu entry in the datasheet's menubar
''' The menu is not intended to be saved neither in the LibreOffice global environment, nor elsewhere
''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
''' Args:
'''  MenuHeader: the name/header of the menu
'''  Before: the place where to put the new menu on the menubar (string or number >= 1)
'''   When not found => last position
'''  SubmenuChar: the delimiter used in menu trees. Default = ">"
''' Returns:
'''  A SFWidgets.Menu instance or Nothing
''' Examples:
'''  Dim oMenu As Object
'''  Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
'''  With oMenu
'''   .AddItem("Item 1", Command := ".uno:About")
'''   '...
'''   .Dispose() ' When definition is complete, the menu instance may be disposed
'''  End With
'''   ' ...

Dim oMenu As Object   ' return value
Const cstThisSub = "SFDatabases.Datasheet.CreateMenu"
Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 Set oMenu = Nothing

Check:
 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""

 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
 End If

Try:
 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Component, MenuHeader, Before, SubmenuChar)

Finally:
 Set CreateMenu = oMenu
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function   '   SFDatabases.SF_Document.CreateMenu

REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
'''  PropertyName: the name of the property as a string
''' Returns:
'''  The actual value of the propRATTCerty
'''  If the property does not exist, returns Null

Const cstThisSub = "SFDatabases.Datasheet.GetProperty"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 GetProperty = Null

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 GetProperty = _PropertyGet(PropertyName)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDatabases.SF_Datasheet.GetProperty

REM -----------------------------------------------------------------------------
Public Function GetText(Optional ByVal Column As Variant) As String
''' Get the text in the given column of the current row.
''' Args:
'''  Column: the name of the column as a string or its position (>= 1). Default = the current column
'''    If the argument exceeds the number of columns, the last column is selected.
''' Returns:
'''  The text in the cell as a string as how it is displayed
'''  Note that the position of the cursor is left unchanged.
''' Examples:
'''  oSheet.GetText("ShipCity")) ' Extract the text on the current row from the column "ShipCity"

Dim sText As String    ' Return Text
Dim lCol As Long     ' Numeric index of Column in lists of columns
Dim lMaxCol As Long    ' Index of last column
Const cstThisSub = "SFDatabases.Datasheet.GetText"
Const cstSubArgs = "[Column=0]"

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 sText = ""

Check:
 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If VarType(Column) <> V_STRING Then
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
  Else
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
  End If
 End If

Try:
 ' Position the column - The index to be passed starts at 0
 With _ControlView
  If VarType(Column) = V_STRING Then
   lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
  Else
   lCol = -1
   If Column >= 1 Then
    lMaxCol = .Count - 1
    If Column > lMaxCol + 1 Then lCol = lMaxCol Else lCol = Column - 1
   Else
    lCol = .getCurrentColumnPosition()
   End If
  End If

  If lCol >= 0 Then sText = .getByIndex(lCol).Text
 End With

Finally:
 GetText = sText
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function '   SFDatabases.SF_Datasheet.GetText

REM -----------------------------------------------------------------------------
Public Function GetValue(Optional ByVal Column As Variant) As Variant
''' Get the value in the given column of the current row.
''' Args:
'''  Column: the name of the column as a string or its position (>= 1). Default = the current column
'''    If the argument exceeds the number of columns, the last column is selected.
''' Returns:
'''  The value in the cell as a valid Basic type
'''  Typical types are: STRING, INTEGER, LONG, FLOAT, DOUBLE, DATE, NULL
'''  Binary types are returned as a LONG giving their length, not their content
'''  An EMPTY return value means that the value could not be retrieved.
'''  Note that the position of the cursor is left unchanged.
''' Examples:
'''  oSheet.GetValue("ShipCity")) ' Extract the value on the current row from the column "ShipCity"

Dim vValue As Variant    ' Return value
Dim lCol As Long     ' Numeric index of Column in lists of columns
Dim lMaxCol As Long    ' Index of last column
Const cstThisSub = "SFDatabases.Datasheet.GetValue"
Const cstSubArgs = "[Column=0]"

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 vValue = Empty

Check:
 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If VarType(Column) <> V_STRING Then
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
  Else
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
  End If
 End If

Try:
 ' Position the column - The index to be passed starts at 1
 If VarType(Column) = V_STRING Then
  lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False) + 1
 Else
  With _ControlView
   lCol = 0
   If Column >= 1 Then
    lMaxCol = .Count
    If Column > lMaxCol Then lCol = lMaxCol Else lCol = Column
   Else
    lCol = .getCurrentColumnPosition() + 1
   End If
  End With
 End If

 ' The _TabControllerModel acts exactly as a result set, from which the generic _GetColumnValue can extract the searched value
 If lCol >= 1 Then vValue = _ParentDatabase._GetColumnValue(_TabControllerModel, lCol)

Finally:
 GetValue = vValue
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function '   SFDatabases.SF_Datasheet.GetValue

REM -----------------------------------------------------------------------------
Public Function GoToCell(Optional ByVal Row As Variant _
       , Optional ByVal Column As Variant _
       ) As Boolean
''' Set the cursor on the given row and the given column.
''' If the requested row exceeds the number of available rows, the cursor is set on the last row.
''' If the requested column exceeds the number of available columns, the selected column is the last one.
''' Args:
'''  Row: the row number (>= 1) as a numeric value. Default= no change
'''  Column: the name of the column as a string or its position (>= 1). Default = the current column
''' Returns:
'''  True when successful
''' Examples:
'''  oSheet.GoToCell(1000000, "ShipCity")) ' Set the cursor on he last row, column "ShipCity"

Dim bGoTo As Boolean    ' Return value
Dim lCol As Long     ' Numeric index of Column in list of columns
Dim lMaxCol As Long    ' Index of last column
Const cstThisSub = "SFDatabases.Datasheet.GoToCell"
Const cstSubArgs = "[Row=0], [Column=0]"

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bGoTo = False

Check:
 If IsMissing(Row) Or IsEmpty(Row) Then Row = 0
 If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Row, "Row", ScriptForge.V_NUMERIC) Then GoTo Catch
  If VarType(Column) <> V_STRING Then
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
  Else
   If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
  End If
 End If

Try:
 ' Position the row
 With _TabControllerModel
  If Row <= 0 Then Row = .Row Else .absolute(Row)
  ' Does Row exceed the total number of rows ?
  If .IsRowCountFinal And Row > .RowCount Then .absolute(.RowCount)
 End With

 ' Position the column
 With _ControlView
  If VarType(Column) = V_STRING Then
   lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
  Else
   lCol = -1
   If Column >= 1 Then
    lMaxCol = .Count - 1
    If Column > lMaxCol + 1 Then lCol = lMaxCol Else lCol = Column - 1
   End If
  End If
  If lCol >= 0 Then .setCurrentColumnPosition(lCol)
 End With

 bGoTo = True

Finally:
 GoToCell = bGoTo
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function '   SFDatabases.SF_Datasheet.GoToCell

REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the Model service as an array

 Methods = Array( _
     "Activate" _
     , "CloseDatasheet" _
     , "CreateMenu" _
     , "GetText" _
     , "GetValue" _
     , "GoToCell" _
     , "RemoveMenu" _
     )

End Function ' SFDatabases.SF_Datasheet.Methods

REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Model class as an array

 Properties = Array( _
     "ColumnHeaders" _
     , "CurrentColumn" _
     , "CurrentRow" _
     , "DatabaseFileName" _
     , "Filter" _
     , "IsAlive" _
     , "LastRow" _
     , "MenuHeaders" _
     , "OrderBy" _
     , "ParentDatabase" _
     , "Source" _
     , "SourceType" _
     , "XComponent" _
     , "XControlModel" _
     , "XTabControllerModel" _
     )

End Function ' SFDatabases.SF_Datasheet.Properties

REM -----------------------------------------------------------------------------
Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
''' Remove a menu entry in the document's menubar
''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
''' Args:
'''  MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
''' Returns:
'''  True when successful
''' Examples:
'''  oDoc.RemoveMenu("File")
'''   ' ...

Dim bRemove As Boolean   ' Return value
Dim oLayout As Object   ' com.sun.star.comp.framework.LayoutManager
Dim oMenuBar As Object   ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
Dim sName As String    ' Menu name
Dim iMenuId As Integer   ' Menu identifier
Dim iMenuPosition As Integer ' Menu position >= 0
Dim i As Integer
Const cstTilde = "~"

Const cstThisSub = "SFDatabases.Datasheet.RemoveMenu"
Const cstSubArgs = "MenuHeader"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bRemove = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
 End If

Try:
 Set oLayout = _Component.Frame.LayoutManager
 Set oMenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar

 ' Search the menu identifier to remove by its name, Mark its position
 With oMenuBar
  iMenuPosition = -1
  For i = 0 To .ItemCount - 1
   iMenuId = .getItemId(i)
   sName = Replace(.getItemText(iMenuId), cstTilde, "")
   If MenuHeader= sName Then
    iMenuPosition = i
    Exit For
   End If
  Next i
  ' Remove the found menu item
  If iMenuPosition >= 0 Then
   .removeItem(iMenuPosition, 1)
   bRemove = True
  End If
 End With

Finally:
 RemoveMenu = bRemove
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function   '   SFDatabases.SF_Datasheet.RemoveMenu

REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
        , Optional ByRef Value As Variant _
        ) As Boolean
''' Set a new value to the given property
''' Args:
'''  PropertyName: the name of the property as a string
'''  Value: its new value
''' Exceptions
'''  ARGUMENTERROR  The property does not exist

Const cstThisSub = "SFDatabases.Datasheet.SetProperty"
Const cstSubArgs = "PropertyName, Value"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 SetProperty = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 SetProperty = _PropertySet(PropertyName, Value)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDatabases.SF_Datasheet.SetProperty

REM -----------------------------------------------------------------------------
Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
''' Returns either a list of the available toolbar names in the actual document
''' or a Toolbar object instance.
''' [Function identical with SFDocuments.SF_Document.Toolbars()]
''' Args:
'''  ToolbarName: the usual name of one of the available toolbars
''' Returns:
'''  A zero-based array of toolbar names when the argument is absent,
'''  or a new Toolbar object instance from the SF_Widgets library.

Const cstThisSub = "SFDatabases.Datasheet.Toolbars"
Const cstSubArgs = "[ToolbarName=""""]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
 If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If VarType(ToolbarName) = V_STRING Then
   If Len(ToolbarName) > 0 Then
    If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
   End If
  Else
   If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
  End If
 End If

Try:
 If Len(ToolbarName) = 0 Then
  Toolbars = _Toolbars.Keys()
 Else
  Toolbars = CreateScriptService("SFWidgets.Toolbar", _Toolbars.Item(ToolbarName))
 End If

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SF_Databases.SF_Datasheet.Toolbars

REM =========================================================== PRIVATE FUNCTIONS

REM -----------------------------------------------------------------------------
Public Sub _Initialize()
''' Called immediately after instance creation to complete the initial values
''' An eventual error must be trapped in the calling routine to cancel the instance creation

Dim iType As Integer   ' One of the com.sun.star.sdb.CommandType constants
Dim oColumn As Object   ' A single column
Dim oColumnDescriptor As Object ' A single column descriptor
Dim FSO As Object    : Set FSO = ScriptForge.SF_FileSystem
Dim i As Long

Try:
 If IsNull([_Parent]) Then _ParentType = "" Else _ParentType = [_Parent].ObjectType

 With _Component
  ' The existence of _Component.Selection must be checked upfront
  _Command = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "Command")

  iType = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "CommandType")
  Select Case iType
   Case com.sun.star.sdb.CommandType.TABLE  : _SheetType = "TABLE"
   Case com.sun.star.sdb.CommandType.QUERY  : _SheetType = "QUERY"
   Case com.sun.star.sdb.CommandType.COMMAND : _SheetType = "SQL"
  End Select

  _BaseFileName = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "DataSourceName")
  _DirectSql = Not ScriptForge.SF_Utils._GetPropertyValue(.Selection, "EscapeProcessing")

  ' Useful UNO objects
  Set _Frame = .Frame
  Set _ControlView = .CurrentControl
  Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel()
  Set _ControlModel = _ControlView.getModel()
 End With

 With _TabControllerModel
  ' Retrieve the parent database instance
  Select Case _ParentType
   Case "BASE"
    Set _ParentDatabase = [_Parent].GetDatabase(.User, .Password)
    Set _ParentBase = [_Parent]
   Case "DATABASE"
    Set _ParentDatabase = [_Parent]
    Set _ParentBase = Nothing
   Case ""    ' Derive the DATABASE instance from what can be found in the Component
    Set _ParentDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
      , FSO._ConvertFromUrl(_BaseFileName), , , .User, .Password)
    _ParentType = "DATABASE"
    Set _ParentBase = Nothing
  End Select
  ' Load column headers
  _ColumnHeaders = .getColumns().getElementNames()
 End With

Finally:
 Exit Sub
End Sub   ' SFDatabases.SF_Datasheet._Initialize

REM -----------------------------------------------------------------------------
Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
''' Returns True if the datasheet has not been closed manually or incidentally since the last use
''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
''' Args:
'''  pbError: if True (default), raise a fatal error

Dim bAlive As Boolean   ' Return value
Dim sName As String    ' Used in error message

 On Local Error GoTo Catch  ' Anticipate DisposedException errors or alike
 If IsMissing(pbError) Then pbError = True

Try:
 ' Check existence of datasheet
 bAlive = Not IsNull(_Component.ComponentWindow)

Finally:
 If pbError And Not bAlive Then
  sName = _Command
  Dispose()
  If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sName)
 End If
 _IsStillAlive = bAlive
 Exit Function
Catch:
 bAlive = False
 On Error GoTo 0
 GoTo Finally
End Function ' SFDatabases.SF_Datasheet._IsStillAlive

REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
''' Return the value of the named property
''' Args:
'''  psProperty: the name of the property

Dim lRow As Long    ' Actual row number
Dim oMenuBar As Object    ' com.sun.star.awt.XMenuBar
Dim sMenus As String    ' List of menus in the menubar
Dim i As Long, j As Long
Dim cstThisSub As String
Const cstSubArgs = ""

 cstThisSub = "SFDatabases.Datasheet.get" & psProperty
 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If psProperty <> "IsAlive" Then
  If Not _IsStillAlive() Then GoTo Finally
 End If

 Select Case UCase(psProperty)
  Case UCase("ColumnHeaders")
   _PropertyGet = _ColumnHeaders
  Case UCase("CurrentColumn")
   _PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition())
  Case UCase("CurrentRow")
   _PropertyGet = _TabControllerModel.Row
  Case UCase("DatabaseFileName")
   _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName)
  Case UCase("Filter")
   _PropertyGet = _TabControllerModel.Filter
  Case UCase("IsAlive")
   _PropertyGet = _IsStillAlive(False)
  Case UCase("LastRow")
   With _TabControllerModel
    If .IsRowCountFinal Then
     _PropertyGet = .RowCount
    Else
     lRow = .Row
     If lRow > 0 Then
      .last()
      _PropertyGet = .RowCount
      .absolute(lRow)
     Else
      _PropertyGet = 0
     End If
    End If
   End With
  Case UCase("MenuHeaders")
   Set oMenuBar = _Component.Frame.LayoutManager.getElement("private:resource/menubar/menubar").XMenuBar
   ' Join all menu headers, then split the whole string
   sMenus = ""
   With oMenuBar
    For i = 0 To .ItemCount - 1
     j = .getItemId(i)
     sMenus = sMenus & .getItemText(j) & ","
    Next i
   End With
   If Len(sMenus) > 0 Then sMenus = Left(sMenus, Len(sMenus) - 1)  ' Suppress final comma
   _PropertyGet = Split(Replace(sMenus, "~", ""), ",")
  Case UCase("OrderBy")
   _PropertyGet = _TabControllerModel.Order
  Case UCase("ParentDatabase")
   Set _PropertyGet = _ParentDatabase
  Case UCase("Source")
   _PropertyGet = _Command
  Case UCase("SourceType")
   _PropertyGet = _SheetType
  Case UCase("XComponent")
   Set _PropertyGet = _Component
  Case UCase("XControlModel")
   Set _PropertyGet = _ControlModel
  Case UCase("XTabControllerModel")
   Set _PropertyGet = _TabControllerModel
  Case Else
   _PropertyGet = Null
 End Select

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDatabases.SF_Datasheet._PropertyGet

REM -----------------------------------------------------------------------------
Private Function _PropertySet(Optional ByVal psProperty As String _
        , Optional ByVal pvValue As Variant _
        ) As Boolean
''' Set the new value of the named property
''' Args:
'''  psProperty: the name of the property
'''  pvValue: the new value of the given property
''' Returns:
'''  True if successful

Dim bSet As Boolean       ' Return value
Dim cstThisSub As String
Const cstSubArgs = "Value"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bSet = False

 cstThisSub = "SFDatabases.Datasheet.set" & psProperty
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If Not _IsStillAlive() Then GoTo Finally

 bSet = True
 Select Case UCase(psProperty)
  Case UCase("Filter")
   If Not ScriptForge.SF_Utils._Validate(pvValue, "Filter", V_STRING) Then GoTo Finally
   With _TabControllerModel
    If Len(pvValue) > 0 Then .Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = ""
    .ApplyFilter = ( Len(pvValue) > 0 )
    .reload()
   End With
  Case UCase("OrderBy")
   If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
   With _TabControllerModel
    If Len(pvValue) > 0 Then .Order = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Order = ""
    .reload()
   End With
  Case Else
   bSet = False
 End Select

Finally:
 _PropertySet = bSet
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDatabases.SF_Datasheet._PropertySet

REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the Datasheet instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
'''  "[DATASHEET]: tablename,base file url"

 _Repr = "[DATASHEET]: " & _Command & "," & _BaseFileName

End Function ' SFDatabases.SF_Datasheet._Repr

REM ============================================ END OF SFDATABASES.SF_DATASHEET
</script:module>