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 trigger 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 oSheet1 = oBase.OpenTable("Customers") ' or OpenQuery(...) ''' Set oSheet2 = oBase.Datasheets("Products") ' when the datasheet has been opened manually ''' 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 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() 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 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 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: _TabControllerModel.close() _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 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 lCol = 0 If Column >= 1 Then lMaxCol = _ControlView.Count If Column > lMaxCol Then lCol = lMaxCol Else lCol = Column End If 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" _ , "LastRow" _ , "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 SF_Utils._ErrorHandling() Then On Local Error GoTo Catch SetProperty = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: SetProperty = _PropertySet(PropertyName, Value) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDatabases.SF_Datasheet.SetProperty 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 ' Retrieve the parent database instance With _TabControllerModel 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 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 Not _IsStillAlive(False) Then GoTo Finally Select Case psProperty Case "ColumnHeaders" _PropertyGet = _ColumnHeaders Case "CurrentColumn" _PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition()) Case "CurrentRow" _PropertyGet = _TabControllerModel.Row Case "DatabaseFileName" _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName) Case "Filter" _PropertyGet = _TabControllerModel.Filter Case "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 "OrderBy" _PropertyGet = _TabControllerModel.Order Case "ParentDatabase" Set _PropertyGet = _ParentDatabase Case "Source" _PropertyGet = _Command Case "SourceType" _PropertyGet = _SheetType Case "XComponent" Set _PropertyGet = _Component Case "XControlModel" Set _PropertyGet = _ControlModel Case "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