diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2021-08-27 15:03:14 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2021-08-27 17:01:26 +0200 |
commit | e4a3c4ba511724bcc8997249a921da609345410b (patch) | |
tree | 053b9df2f23dfca8676017670200484ed2f5accc | |
parent | d9e7a8dd1cb4859a4d2252a2baf697eea56fecea (diff) |
ScriptForge - (SF_DialogControl) add management of table controls in dialogs
With the method SetTableData(), feed a tablecontrol
with a sortable and selectable array of data.
Columns and rows may receive a header.
Column widths are adjusted manually by the user or
with the same method.
Alignments can be set as well by script.
oControl.SetTableData(DataArray, Widths, Alignments)
DataArray: the set of data to display in the table control,
including optional column/row headers
Is a 2D array in Basic, is a tuple of tuples inPython
Widths: the column's relative widths as a 1D array,
each element corresponding with a column.
If the array is shorter than the number of columns,
the last value is kept for the next columns.
Example:
Widths := Array(1, 2)
means that the first column is half as wide as all
the other columns.
When the argument is absent, the columns are evenly
spreaded over the control.
Alignments: the column's horizontal alignment as a string
with length = number of columns.
Possible characters are:
L(EFT), C(ENTER), R(IGHT) or space (default behaviour)
Default: LEFT for strings, RIGHT for numbers
Impact on existing properties: ListIndex, Value
New properties: XGridColumnModel, XGridDataModel
All properties and methods are available from user
scripts written either in Basic or in Python.
Change-Id: I70582cd0ba48ee3b9b9a292d8a47dbc1229b1fe6
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/121148
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
-rw-r--r-- | wizards/source/scriptforge/SF_PythonHelper.xba | 2 | ||||
-rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 6 | ||||
-rw-r--r-- | wizards/source/sfdialogs/SF_DialogControl.xba | 298 |
3 files changed, 298 insertions, 8 deletions
diff --git a/wizards/source/scriptforge/SF_PythonHelper.xba b/wizards/source/scriptforge/SF_PythonHelper.xba index 62ce902b2091..5b919ba5abe1 100644 --- a/wizards/source/scriptforge/SF_PythonHelper.xba +++ b/wizards/source/scriptforge/SF_PythonHelper.xba @@ -764,6 +764,8 @@ Try: If Script = "GetRows" Then vReturn = vBasicObject.GetRows(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "SFDialogs.Dialog" If Script = "Controls" Then vReturn = vBasicObject.Controls(vArgs(0)) + Case "SFDialogs.DialogControl" + If Script = "SetTableData" Then vReturn = vBasicObject.SetTableData(vArgs(0), vArgs(1), vArgs(2)) Case "SFDocuments.Document" If Script = "Forms" Then vReturn = vBasicObject.Forms(vArgs(0)) Case "SFDocuments.Base" diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index 714418ffd09c..498da0637dd7 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -1687,7 +1687,8 @@ class SFDialogs: OnTextChanged = False, Page = True, Parent = False, Picture = True, RootNode = False, RowSource = True, Text = False, TipText = True, TripleState = True, Value = True, Visible = True, - XControlModel = False, XControlView = False, XTreeDataModel = False) + XControlModel = False, XControlView = False, XGridColumnModel = False, + XGridDataModel = False, XTreeDataModel = False) # Root related properties do not start with X and, nevertheless, return a UNO object @property @@ -1713,6 +1714,9 @@ class SFDialogs: def SetFocus(self): return self.ExecMethod(self.vbMethod, 'SetFocus') + def SetTableData(self, dataarray, widths = (1,), alignments = ''): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetTableData', dataarray, widths, alignments) + def WriteLine(self, line = ''): return self.ExecMethod(self.vbMethod, 'WriteLine', line) diff --git a/wizards/source/sfdialogs/SF_DialogControl.xba b/wizards/source/sfdialogs/SF_DialogControl.xba index 71ef6a3ce201..e6d6b8571af3 100644 --- a/wizards/source/sfdialogs/SF_DialogControl.xba +++ b/wizards/source/sfdialogs/SF_DialogControl.xba @@ -23,11 +23,15 @@ Option Explicit ''' Essentially a single property "Value" maps many alternative UNO properties depending each on ''' the control type. ''' -''' A special attention is given to controls with type TreeControl. -''' It is easy with the API proposed in the current class to populate a tree, either -''' - branch by branch (CreateRoot and AddSubNode), or -''' - with a set of branches at once (AddSubtree) -''' Additionally populating a TreeControl can be done statically or dynamically +''' A special attention is given to controls with types TreeControl and TableControl +''' It is easy with the API proposed in the current class to populate a tree, either +''' - branch by branch (CreateRoot and AddSubNode), or +''' - with a set of branches at once (AddSubtree) +''' Additionally populating a TreeControl can be done statically or dynamically +''' +''' With the method SetTableData(), feed a tablecontrol with a sortable and selectable +''' array of data. Columns and rows may receive a header. Column widths are adjusted manually by the user or +''' with the same method. Alignments can be set as well by script. ''' ''' Service invocation: ''' Dim myDialog As Object, myControl As Object @@ -64,6 +68,8 @@ Private _DialogName As String ' Parent dialog name Private _ControlModel As Object ' com.sun.star.awt.XControlModel Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl Private _TreeDataModel As Object ' com.sun.star.awt.tree.MutableTreeDataModel +Private _GridColumnModel As Object ' com.sun.star.awt.grid.XGridColumnModel +Private _GridDataModel As Object ' com.sun.star.awt.grid.XGridDataModel ' Control attributes Private _ImplementationName As String @@ -76,6 +82,9 @@ Private _OnNodeExpanded As String ' Script to invoke when a node is expan Private _SelectListener As Object ' com.sun.star.view.XSelectionChangeListener Private _ExpandListener As Object ' com.sun.star.awt.tree.XTreeExpansionListener +' Table control attributes +Private _ColumnWidths As Variant ' Array of column widths + REM ============================================================ MODULE CONSTANTS Private Const CTLBUTTON = "Button" @@ -95,6 +104,7 @@ Private Const CTLPATTERNFIELD = "PatternField" Private Const CTLPROGRESSBAR = "ProgressBar" Private Const CTLRADIOBUTTON = "RadioButton" Private Const CTLSCROLLBAR = "ScrollBar" +Private Const CTLTABLECONTROL = "TableControl" Private Const CTLTEXTFIELD = "TextField" Private Const CTLTIMEFIELD = "TimeField" Private Const CTLTREECONTROL = "TreeControl" @@ -113,12 +123,15 @@ Private Sub Class_Initialize() Set _ControlModel = Nothing Set _ControlView = Nothing Set _TreeDataModel = Nothing + Set _GridColumnModel = Nothing + Set _GridDataModel = Nothing _ImplementationName = "" _ControlType = "" _OnNodeSelected = "" _OnNodeExpanded = "" Set _SelectListener = Nothing Set _ExpandListener = Nothing + _ColumnWidths = Array() End Sub ' SFDialogs.SF_DialogControl Constructor REM ----------------------------------------------------------------------------- @@ -493,6 +506,18 @@ Property Get XControlView() As Object End Property ' SFDialogs.SF_DialogControl.XControlView (get) REM ----------------------------------------------------------------------------- +Property Get XGridColumnModel() As Object +''' The XGridColumnModel property returns the mutable data model UNO object of the tree control + XGridColumnModel = _PropertyGet("XGridColumnModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XGridColumnModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XGridDataModel() As Object +''' The XGridDataModel property returns the mutable data model UNO object of the tree control + XGridDataModel = _PropertyGet("XGridDataModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XGridDataModel (get) + +REM ----------------------------------------------------------------------------- Property Get XTreeDataModel() As Object ''' The XTreeDataModel property returns the mutable data model UNO object of the tree control XTreeDataModel = _PropertyGet("XTreeDataModel", Nothing) @@ -895,6 +920,8 @@ Public Function Properties() As Variant , "Visible" _ , "XControlModel" _ , "XControlView" _ + , "XGridColumnModel" _ + , "XGridDataModel" _ , "XTreeDataModel" _ ) @@ -972,6 +999,216 @@ Catch: End Function ' SFDialogs.SF_DialogControl.SetProperty REM ----------------------------------------------------------------------------- +Public Function SetTableData(Optional ByRef DataArray As Variant _ + , Optional ByRef Widths As Variant _ + , Optional ByRef Alignments As Variant _ + ) As Boolean +''' Fill a table control with the given data. Preexisting data is erased +''' The Basic IDE allows to define if the control has a row and/or a column header +''' When it is the case, the array in argument should contain those headers resp. in the first +''' column and/or in the first row +''' A column in the control shall be sortable when the data (headers excluded) in that column +''' is homogeneously filled either with numbers or with strings +''' Columns containing strings will be left-aligned, those with numbers will be right-aligned +''' Args: +''' DataArray: the set of data to display in the table control, including optional column/row headers +''' Is a 2D array in Basic, is a tuple of tuples when called from Python +''' Widths: the column's relative widths as a 1D array, each element corresponding with a column +''' If the array is shorter than the number of columns, the last value is kept for the next columns. +''' Example: +''' Widths := Array(1, 2) +''' means that the first column is half as wide as all the other columns +''' When the argument is absent, the columns are evenly spreaded over the control +''' Alignments: the column's horizontal alignment as a string with length = number of columns. +''' Possible characters are: +''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour) +''' Returns: +''' True when successful +''' Examples: +''' Dim myTable As Object, bSet As Boolean, vData As Variant +''' Set myTable = myDialog.Controls("myTableControl") ' This control has only column headers +''' vData = Array("Col1", "Col2", "Col3") +''' vData = SF_Array.AppendRow(vData, Array(1, 2, 3)) +''' vData = SF_Array.AppendRow(vData, Array(4, 5, 6)) +''' vData = SF_Array.AppendRow(vData, Array(7, 8, 9)) +''' bSet = myTable.SetTableData(vData, Alignments := " C ") + +Dim bData As Boolean ' Return value +Dim iDims As Integer ' Number of dimensions of DataArray +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lControlWidth As Long ' Width of the table control +Dim lMinW As Long ' lBound of Widths +Dim lMaxW As Long ' UBound of vWidths +Dim lMinRow As Long ' Row index of effective data subarray +Dim lMinCol As Long ' Column index of effective data subarray +Dim vRowHeaders As Variant ' Array of row headers +Dim sRowHeader As String ' A single row header +Dim vColHeaders As Variant ' Array of column headers +Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn +Dim dWidth As Double ' A single item of Widths +Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns +Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths +Dim vDataRow As Variant ' A single row content in the tablecontrol +Dim vDataItem As Variant ' A single DataArray item +Dim sAlign As String ' Column's hprizontal alignments (single chars: L, C, R, space) +Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX +Dim i As Long, j As Long, k As Long + +Const cstRowHdrWidth = 12 ' Estimated width of the row header + +Const cstThisSub = "SFDialogs.DialogControl.SetTableData" +Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bData = False + +Check: + If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array(1) + If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTABLECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below + If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch + End If + +Try: + ' Erase any pre-existing data and columns + _GridDataModel.removeAllRows() + For i = _GridColumnModel.ColumnCount - 1 To 0 Step -1 + _GridColumnModel.removeColumn(i) + Next i + + ' LBounds, UBounds - Basic or Pytho + iDims = ScriptForge.SF_Array.CountDims(DataArray) + Select Case iDims + Case -1, 0 : GoTo Catch + Case 1 ' Called probably from Python + lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1) + If Not IsArray(DataArray(0)) Then GoTo Catch + If UBound(DataArray(0)) < LBound(DataArray(0)) Then GoTo Catch ' No columns + lMin2 = LBound(DataArray(0)) : lMax2 = UBound(DataArray(0)) + Case 2 + lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1) + lMin2 = LBound(DataArray, 2) : lMax2 = UBound(DataArray, 2) + Case Else : GoTo Catch + End Select + + ' Extract headers from data array + lMinW = LBound(Widths) : lMaxW = UBound(Widths) + With _ControlModel + If .ShowColumnHeader Then + lMinRow = lMin1 + 1 + If iDims = 1 Then + vColHeaders = DataArray(lMin1) + Else + vColHeaders = ScriptForge.SF_Array.ExtractRow(DataArray, lMin1) + End If + Else + lMinRow = lMin1 + vColHeaders = Array() + End If + If .ShowRowHeader Then + lMinCol = lMin2 + 1 + If iDims = 1 Then + vRowHeaders = Array() + ReDim vRowHeaders(lMin1 To lMax1) + For i = lMin1 To lMax1 + vRowHeaders(i) = DataArray(i)(lMin2) + Next i + Else + vRowHeaders = ScriptForge.SF_Array.ExtractColumn(DataArray, lMin2) + End If + Else + lMinCol = lMin2 + vRowHeaders = Array() + End If + End With + + ' Create the columns + For j = lMinCol To lMax2 + Set oColumn = _GridColumnModel.createColumn() + If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j) + _GridColumnModel.addColumn(oColumn) + Next j + ' Size the columns. Column sizing cannot be done before all the columns are added + If lMaxW >= lMinW Then ' There must be at least 1 width given as argument + ' Size the columns proportionally with their relative widths + dRelativeWidth = 0.0 + i = lMinW - 1 + ' Compute the sum of the relative widths + For j = 0 To lMax2 - lMinCol + i = i + 1 + If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW) + Next j + ' Set absolute widths + If dRelativeWidth > 0.0 Then dWidthFactor = CDbl((_ControlModel.Width - cstRowHdrWidth) / dRelativeWidth) Else dWidthFactor = 1.0 + i = lMinW - 1 + For j = 0 To lMax2 - lMinCol + i = i + 1 + If i >= lMinW And i <= lMaxW Then dWidth = CDbl(Widths(i)) Else dWidth = CDbl(Widths(lMaxW)) + _GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth) + Next j + Else + ' Size all columns evenly + For j = 0 To lMax2 - lMinCol + _GridColumnModel.Columns(j).ColumnWidth = (_ControlModel.Width - cstRowHdrWidth) / (lMax2 - lMonCol + 1) + Next j + End If + + ' Initialize the column alignment + If Len(Alignments) >= lMax2 - lMinCol + 1 Then sAlign = Alignments Else sAlign = Alignments & Space(lMax2 - lMinCol + 1 - Len(Alignments)) + + ' Feed the table with data and define/confirm the column alignment + vDataRow = Array() + For i = lMinRow To lMax1 + ReDim vDataRow(0 To lMax2 - lMinCol) + For j = lMinCol To lMax2 + If iDims = 1 Then vDataItem = DataArray(i)(j) Else vDataItem = DataArray(i, j) + If VarType(vDataItem) = V_STRING Then + ElseIf ScriptForge.SF_Utils._VarTypeExt(vDataItem) = ScriptForge.V_NUMERIC Then + Else + vDataItem = ScriptForge.SF_String.Represent(vDataItem) + End If + vDataRow(j - lMinCol) = vDataItem + ' Store alignment while processing the first row of the array + If i = lMinRow Then + k = j - lMinCol + 1 + If Mid(sAlign, k, 1) = " " Then Mid(sAlign, k, 1) = Iif(VarType(vDataItem) = V_STRING, "L", "R") + End If + Next j + If _ControlModel.ShowRowHeader Then sRowHeader = vRowHeaders(i) Else sRowHeader = "" + _GridDataModel.addRow(sRowHeader, vDataRow) + Next i + + ' Determine alignments of each column + For j = 0 To lMax2 - lMinCol + Select Case Mid(sAlign, j + 1, 1) + Case "L", " " : lAlign = com.sun.star.style.HorizontalAlignment.LEFT + Case "R" : lAlign = com.sun.star.style.HorizontalAlignment.RIGHT + Case "C" : lAlign = com.sun.star.style.HorizontalAlignment.CENTER + Case Else + End Select + _GridColumnModel.Columns(j).HorizontalAlign = lAlign + Next j + + bData = True + +Finally: + SetTableData = bData + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "SetTableData") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.SetTableData + +REM ----------------------------------------------------------------------------- Public Function WriteLine(Optional ByVal Line As Variant) As Boolean ''' Add a new line to a multiline TextField control ''' Args: @@ -1204,7 +1441,11 @@ Try: ' Initialize the data model _ControlType = CTLTREECONTROL Set _ControlModel.DataModel = ScriptForge.SF_Utils._GetUNOService("TreeDataModel") - _TreeDataModel = _ControlModel.DataModel + Set _TreeDataModel = _ControlModel.DataModel + Case "UnoControlGridModel" + _ControlType = CTLTABLECONTROL + Set _GridColumnModel = _ControlModel.ColumnModel + Set _GridDataModel = _ControlModel.GridDataModel Case Else : _ControlType = sType End Select @@ -1305,6 +1546,8 @@ Const cstSubArgs = "" Select Case _ControlType Case CTLCOMBOBOX, CTLLISTBOX If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1 + Case CTLTABLECONTROL ' Returns zero when no table data yet + If oSession.HasUNOProperty(_GridDataModel, "RowCount") Then _PropertyGet = _GridDataModel.RowCount Case Else : GoTo CatchType End Select Case UCase("ListIndex") @@ -1320,6 +1563,19 @@ Const cstSubArgs = "" vSelection = _ControlModel.SelectedItems If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0) End If + Case CTLTABLECONTROL + _PropertyGet = -1 ' No row selected, no data, multiselection + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then + lIndex = _ControlView.CurrentRow + If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then + If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0) + End If + _PropertyGet = lIndex + End If + End If Case Else : GoTo CatchType End Select Case UCase("Locked") @@ -1456,6 +1712,19 @@ Const cstSubArgs = "" If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False Case CTLSCROLLBAR 'Numeric If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0 + Case CTLTABLECONTROL + vGet = Array() ' Default value when no row selected, no data, multiselection + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then + lIndex = _ControlView.CurrentRow + If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then + If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0) + End If + If lIndex >= 0 Then vGet = _GridDataModel.getRowData(lIndex) + End If + End If Case CTLTIMEFIELD vGet = CDate(0) If oSession.HasUnoProperty(_ControlModel, "Time") Then @@ -1473,6 +1742,10 @@ Const cstSubArgs = "" Set _PropertyGet = _ControlModel Case UCase("XControlView") Set _PropertyGet = _ControlView + Case UCase("XGridColumnModel") + Set _PropertyGet = _GridColumnModel + Case UCase("XGridDataModel") + Set _PropertyGet = _GridDataModel Case UCase("XTreeDataModel") Set _PropertyGet = _TreeDataModel Case Else @@ -1587,6 +1860,15 @@ Const cstSubArgs = "Value" End If Case CTLLISTBOX If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue)) + Case CTLTABLECONTROL + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOMethod(_ControlView, "selectRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE _ + And pvValue >= 0 And pvValue <= _GridDataModel.RowCount - 1 Then + _ControlView.selectRow(pvValue) + End If + End If Case Else : GoTo CatchType End Select Case UCase("Locked") @@ -1768,7 +2050,9 @@ Const cstSubArgs = "Value" Case UCase("Visible") If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally If oSession.HasUnoMethod(_ControlView, "setVisible") Then - If pvValue Then _ControlModel.EnableVisible = True + If pvValue Then + If oSession.HasUnoProperty(_ControlModel, "EnableVisible") Then _ControlModel.EnableVisible = True + End If _ControlView.setVisible(pvValue) End If Case Else |