609a6dc2df
When a document is closed inadvertently by the user during a macro run, or between two macros triggered by events, the actual behaviour is an error message and a stop of the execution of the macro. As this can be counter-productive, the macro may test at any moment if everything is ok with the IsAlive As Boolean (True = OK) property applied on next service instances: Document Base Calc FormDocument Writer Datasheet Dialog The functionality is available both for Basic and Python user scripts. The user documentation should be completed accordingly. Change-Id: I0b055dacc06c9da70c611dbb4e7bf841160168fd Reviewed-on: https://gerrit.libreoffice.org/c/core/+/172970 Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jean-Pierre Ledure <jp@ledure.be>
962 lines
No EOL
40 KiB
XML
962 lines
No EOL
40 KiB
XML
<?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 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" _
|
|
, "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 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 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 "IsAlive"
|
|
_PropertyGet = _IsStillAlive(False)
|
|
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
|
|
</script:module> |