diff options
Diffstat (limited to 'wizards/source/sfdatabases/SF_Datasheet.xba')
| -rw-r--r-- | wizards/source/sfdatabases/SF_Datasheet.xba | 952 |
1 files changed, 952 insertions, 0 deletions
diff --git a/wizards/source/sfdatabases/SF_Datasheet.xba b/wizards/source/sfdatabases/SF_Datasheet.xba new file mode 100644 index 0000000000..89e66aefd6 --- /dev/null +++ b/wizards/source/sfdatabases/SF_Datasheet.xba @@ -0,0 +1,952 @@ +<?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 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" _ + , "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 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 +</script:module>
\ No newline at end of file |