?prevdifflink? - Blame
<?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="ClassSheet" script:language="StarBasic">REM ***** BASIC *****
Option Explicit
Global Colors
' =====================================
Dim oDialog As Object
Const PropertyName = "ClassSheet"
Const PropertyExpName = "ClassSheetExp"
' =====================================
Sub NotImplemented
msgbox "Not Implemented."
End Sub
' =====================================
Sub Init
Colors = Array( rgb(255,211, 32),_
rgb(174,207, 0),_
rgb(204,255,255),_
rgb(255,255,204),_
rgb(153,153,255),_
rgb( 61,235, 61),_
rgb(153,204,255),_
rgb(255,153,102),_
rgb( 35,184,220),_
rgb(230,230, 76) )
Dim oDoc, oUserProperties As Object
oDoc = ThisComponent
REM check if the ClassSheet Property exists
oUserProperties = GetUserProperties(oDoc)
If Not oUserProperties.getPropertySetInfo().hasPropertyByName( PropertyClasses ) Then
REM create the ClassSheet property
oUserProperties.addProperty( PropertyClasses, com.sun.star.beans.PropertyAttribute.REMOVEABLE, "" )
End If
'If Not oUserProperties.getPropertySetInfo().hasPropertyByName( PropertyExpName ) Then
' REM create the ClassSheetExp property
' oUser
'End If
End Sub
' =====================================
Sub AddClass
msgbox "Warning [AddClass]: feature incomplete."
' TEMP
If IsNull( Colors ) Or IsEmpty( Colors ) Then Init
REM check sheet selection
' FIXME check the existing classes to see if the addition of this one is valid
Dim oDoc As Object
oDoc = ThisComponent
Dim oRange As Object
oRange = GetSelectedRange(oDoc)
If IsNull( oRange ) Then
msgbox "Error: invalid selection."
Exit Sub
End If
REM create dialog control
oDialog = CreateUnoDialog( DialogLibraries.HaExcelDev.NewClass )
REM show the dialog
oDialog.execute()
oDialog.dispose()
End Sub
' =====================================
Sub DelClass
msgbox "Warning [DelClass]: feature incomplete."
' TEMP
If IsNull( Colors ) Or IsEmpty( Colors ) Then Init
Dim oDoc As Object
oDoc = ThisComponent
REM create dialog control
oDialog = CreateUnoDialog( DialogLibraries.HaExcelDev.DelClass )
REM initialize dialog data
Dim classes As Object
classes = GetClasses( oDoc )
' TODO
' The button delete is only enabled if one of the classes is selected,
' and is disabled when the root is selected or there is no selected node.
REM initialize the tree
Dim treeClasses As Object
Dim oTreeDataModel As Object
treeClasses = oDialog.getControl( "treeClasses" )
oTreeDataModel = createUnoService( "com.sun.star.awt.tree.MutableTreeDataModel" )
REM create root node ("ClassSheets")
Dim oRootNode As Object
oRootNode = oTreeDataModel.createNode( PropertyName , true )
oTreeDataModel.setRoot(oRootNode)
REM add the classes to the tree
DelClassAux( oTreeDataModel, classes, 0, oRootNode )
treeClasses.Model.DataModel = oTreeDataModel
REM show the dialog
oDialog.execute()
oDialog.dispose()
End Sub
' =====================================
Function DelClassAux (oTreeDataModel As Object, classes As Object, i As Integer, oParentNode As Object) As Integer
Dim c As Object
Dim c2 As String
Dim res As Integer
Dim n, rn As String
Dim cdepth As Long
Dim oNode As Object
If i > UBound( classes ) Then
DelClassAux = i
Exit Function
End If
c = classes(i)
n = GetClassName( c ) ' n - c Name
rn = GetClassRangeName( c ) ' rn - c Range Name
cdepth = GetClassDepth( c ) ' cdepth - c Depth
oNode = oTreeDataModel.createNode( n & " (" & rn & ")" , true )
oParentNode.appendChild(oNode)
res = i+1
REM check if there are more classes, and process them (deeper level)
If res <= UBound( classes ) Then
c2 = classes( res )
cdepth2 = GetClassDepth( c2 ) ' cdepth2 - c2 Depth
REM check if the next class is an inner class
If cdepth < cdepth2 Then
res = DelClassAux( oTreeDataModel, classes, res, oNode)
End If
End If
REM check if there are more classes, and process them (same level)
If res <= UBound( classes ) Then
c2 = classes( res )
cdepth2 = GetClassDepth( c2 ) ' cdepth2 - c2 Depth
REM continue with the remaining classes on the same level
If cdepth = cdepth2 Then
res = DelClassAux( oTreeDataModel, classes, res, oParentNode )
End If
End If
DelClassAux = res
End Function
' =====================================
Sub SetColsRepeatable
msgbox "SetColsRepeatable not implemented"
' TEMP
If IsNull( Colors ) Or IsEmpty( Colors ) Then Init
End Sub
' =====================================
Sub SetRowsRepeatable
msgbox "SetRowsRepeatable not implemented"
' TEMP
If IsNull( Colors ) Or IsEmpty( Colors ) Then Init
End Sub
' =====================================
Function GetUserProperties (oDoc As Object) As Object
GetUserProperties = oDoc.DocumentProperties.UserDefinedProperties
End Function
' =====================================
Sub NewClass_btnOk_Click
Dim oDoc As Object
Dim oUserProperties As Object
Dim classes,newClass As String
oDoc = ThisComponent
oUserProperties = GetUserProperties(oDoc)
REM get the range of the selection
Dim oRange As Object
Dim range$
oRange = GetSelectedRange(oDoc)
If IsNull(oRange) Then
Exit Sub
End If
REM get the new class' name
newClass = oDialog.Model.txtClassName.Text
REM add the new class and update the list
classes = AddClassToList( oDoc, newClass, oRange )
If classes = "" Then
msgbox "Error: invalid selection."
oDialog.endExecute()
Exit Sub
End If
classes = oUserProperties.setPropertyValue( PropertyName, classes )
REM stop the dialog's execution
oDialog.endExecute()
End Sub
' =====================================
Sub NewClass_txtClassName_Changed
Dim oButton As Object
oButton = oDialog.getControl("btnOk")
If (oDialog.Model.txtClassName.Text <> "") Then
oButton.setEnable(True)
Else
oButton.setEnable(False)
End If
End Sub
' =====================================
Function GetSelectedRange (oDoc As Object) As Object
Dim oSelection As Object
oSelection = oDoc.getCurrentSelection
if HasUnoInterfaces(oSelection, "com.sun.star.lang.XServiceInfo") then
if oSelection.supportsService("com.sun.star.sheet.SheetCellRanges") then
'More than one range selected
'msgbox "Multiple selection not supported."
elseif oSelection.supportsService("com.sun.star.table.CellRange") then
'Only one range but more than one cell
GetSelectedRange = oSelection
elseif oSelection.supportsService("com.sun.star.sheet.SheetCell") then
'only one cell selected
GetSelectedRange = oSelection
end if
end if
End Function
' =====================================
' Return the new list or empty on error
' TODO
' - suport for multi-class classes (classes that are spread across other classes)
Function AddClassToList (oDoc As Object, className As String, oRange As Object) As String
Dim classes As Object
classes = GetClasses( oDoc )
Dim newList(0) As String
If LBound( classes ) <= UBound( classes ) Then
ReDim newList(UBound(classes) + 1) As String
End If
Dim color As Long
color = Colors( (UBound(classes) - LBound(classes) + 1) MOD (UBound(Colors) - LBound(Colors) + 1) )
Dim depth As Long
Dim newClass As String
depth = 1
newClass = ""
Dim i As Integer
Dim c, rn, n As String
Dim cdepth As Long
Dim r As Object ' Range
Dim sn As Object ' array of strings
i = LBound( classes )
While newClass = "" And i <= UBound( classes )
c = classes(i) ' c - Class
rn = GetClassRangeName( c ) ' rn - Class' Range Name
n = GetClassName( c ) ' n - Class' Name
sn = Split(rn,".") ' sn - Class' Sheet Name (with '$' in the name)
r = oDoc.Sheets.getByName( Replace( sn(0), "$", "" ) ).getCellRangeByName( sn(1) ) ' r - Class Range
cdepth = GetClassDepth( c ) ' cdepth - Class Depth
If cdepth < depth Then
REM create new class
newClass = CreateClass( oDoc, className, oRange, depth, color )
REM add class
' copy array until the spot for the new class
for j = LBound( classes ) to (i - 1)
newList(j) = classes(j)
next j
' add the new class to the right place
newList(i) = newClass
' copy the remaining items of the initial array
for j = i to (UBound( classes ))
newList(j+1) = classes(j)
next j
End If
If RangesOverlap( oDoc, oRange, r ) Then
If InRange( oDoc, oRange, r ) Then
REM check sub-classes
depth = depth + 1
Else
REM Invalid
AddClassToList = ""
Exit Function
End If
End If
i = i + 1
WEnd
If newClass = "" Then
REM the new class is a root class: add at the end
for i = LBound( classes ) to UBound( classes )
newList(i) = classes(i)
next i
If UBound( classes ) < LBound( classes ) Then
' the list is empty
oDoc = oDoc
className = className
oRange = oRange
depth = depth
color = color
newList( 0 ) = CreateClass( oDoc, className, oRange, depth, color )
Else
for i = LBound( classes ) to UBound( classes )
newList(i) = classes(i)
next i
newList(i) = CreateClass( oDoc, className, oRange, depth, color )
End If
End If
AddClassToList = join(newList, ";")
End Function
' =====================================
Function CreateClass (oDoc As Object, class As String, oRange As Object, depth As Integer, color As Long) As String
Dim addr, range, newClass
addr = oRange.getRangeAddress()
range = "$" & oDoc.Sheets( addr.Sheet ).getName() _
& ".$" & oDoc.Sheets( addr.Sheet ).Columns( addr.StartColumn ).getName() _
& "$" & ( addr.StartRow + 1 ) & ":$" _
& oDoc.Sheets( addr.Sheet ).Columns( addr.EndColumn ).getName() & "$" & ( addr.EndRow + 1 )
CreateClass = class & "," & range & "," & depth & "," & color
' update spreadsheet
oRange.CellBackColor = color
End Function
' =====================================
Function GetClasses (oDoc As Object) As Object
Dim oUserProperties, classes As Object
Dim strClasses As String
oUserProperties = GetUserProperties( oDoc )
strClasses = oUserProperties.getPropertyValue( PropertyName )
classes = Split( strClasses, ";" )
GetClasses = classes
End Function
' =====================================
Function GetRootClasses (oDoc As Object) As Object
Dim allClasses
Dim classes(0) As String
Dim count,i As Integer
count = 0
allClasses = GetClasses( oDoc )
ReDim classes( UBound(allClasses) )
For i = LBound( allClasses ) To UBound( allClasses )
If GetClassDepth( allclasses(i) ) = 1 Then
classes(count) = allClasses(i)
count = count + 1
End If
Next i
ReDim Preserve classes( count-1 )
GetRootClasses = classes
End Function
' =====================================
Function InRangeByNames (oDoc As Object, inner As String, outer As String) As Boolean
i = Split(inner,".")
o = Split(outer,".")
oInner = oDoc.Sheets.getByName( Replace( i(0), "$", "" ) ).getCellRangeByName( i(1) )
oOuter = oDoc.Sheets.getByName( Replace( o(0), "$", "" ) ).getCellRangeByName( o(1) )
InRangeByNames = InRange( oDoc, oInner, oOuter )
End Function
' =====================================
Function InRange (oDoc As Object, oInner As Object, oOuter As Object) As Boolean
InRange = False
Dim aI, aO As Object
aI = oInner.getRangeAddress()
aO = oOuter.getRangeAddress()
If aI.Sheet <> aO.Sheet Then Exit Function
If aI.StartColumn >= aO.StartColumn _
And aI.EndColumn <= aO.EndColumn _
And aI.StartRow >= aO.StartRow _
And aI.EndRow <= aO.EndRow Then
InRange = True
End If
End Function
' =====================================
Function RangesOverlap (oDoc As Object, oLeft As Object, oRight As Object) As Boolean
RangesOverlap = False
Dim aL, aR As Object
aL = oLeft.RangeAddress
aR = oRight.RangeAddress
If aL.Sheet <> aR.Sheet Then Exit Function
If RangesOverlapTest( aL, aR ) Or RangesOverlapTest( aR, aL ) Then
RangesOverlap = True
End If
End Function
' =====================================
Function RangesOverlapTest (addrLeft As Object, addrRight As Object) As Boolean
RangesOverlapTest = True
Dim aL, aR As Object
aL = addrLeft
aR = addrRight
If (aL.StartRow > aR.EndRow Or aL.EndRow < aR.StartRow) Then
RangesOverlapTest = False
End If
If (aL.StartColumn > aR.EndColumn Or aL.EndColumn < aR.StartColumn) Then
RangesOverlapTest = False
End If
End Function
' =====================================
Function GetClassName (class As String) As String
Dim values As Object
values = Split( class, "," )
GetClassName = values(0)
End Function
' =====================================
Function GetClassRangeName (class As String) As String
Dim values As Object
values = Split( class, "," )
GetClassRangeName = values(1)
End Function
' =====================================
Function GetClassDepth (class As String) As Integer
Dim values As Object
values = Split( class, "," )
GetClassDepth = CInt(values(2))
End Function
' =====================================
Function GetClassColor (class As String) As Long
Dim values As Object
values = Split( class, "," )
GetClassRangeName = CLng(values(3))
End Function
' =====================================
' iModel -> index of model's sheet
' iData -> index of data's sheet
Sub CreateDataTemplate (oDoc as Object, iModel As Integer, iData As Integer)
modelsheet = oDoc.Sheets( iModel )
datasheet = oDoc.Sheets( iData )
classes = GetRootClasses( oDoc )
For i=LBound( classes ) To UBound( classes )
' get range from class
rangeName = GetClassRangeName( classes(i) )
'oRange =
' copy the cells from the model sheet to the data sheet
' -------------------------------------------------------------------------
' For later:
' - load the cells from the model
' - process the cells from the model
' - write the processed cells to the data sheet
Next i
End Sub
' =====================================
Function RangeToString (oRange As Object) As String
addr = oRange.getRangeAddress()
range = "$" & oDoc.Sheets( addr.Sheet ).getName() _
& ".$" & oDoc.Sheets( addr.Sheet ).Columns( addr.StartColumn ).getName() _
& "$" & ( addr.StartRow + 1 ) & ":$" _
& oDoc.Sheets( addr.Sheet ).Columns( addr.EndColumn ).getName() & "$" & ( addr.EndRow + 1 )
RangeToString = range
End Function
' =====================================
' TESTED (1/1 OK)
Function StringToRange (oDoc As Object, range As String) As Object ' com.sun.star.table.CellRangeAddress
Dim oSheet, oRange As Object
Dim sheetTail As Object
Dim sheet As String
sheetTail = Split( range, "." )
sheet = sheetTail(0)
sheet = Replace( sheet, "$", "" )
oSheet = oDoc.getSheets.getByName( sheet )
oRange = oSheet.getCellRangeByName( sheetTail(1) )
StringToRange = oRange
' ' Old version
' Dim addr As New com.sun.star.table.CellRangeAddress
'
' Dim sheet As String
' sheetTail = Split( range, "." )
' sheet = sheetTail(0)
' startCellTail = Split( sheetTail(1) , ":" )
' startCell = startCellTail(0)
' endCell = startCellTail(1)
'
' startCellElems = Replace( startCell, "$", " " )
' startCellElems = Trim( startCellElems )
' startCellValues = Split( startCellElems, " " )
'
' endCellElems = Replace( endCell, "$", " " )
' endCellElems = Trim( endCellElems )
' endCellValues = Split( endCellElems, " " )
'
' ' TODO sheet name to sheet index
' addr.StartColumn = startCellValues(0)
' addr.StartRow = CInt( startCellValues(1) ) - 1
' addr.EndColumn = endCellValues(0)
' addr.EndRow = CInt( endCellValues(1) ) - 1
'
' StringToRange = addr
End Function
' =====================================
' Instantiates a model.
' Arguments:
' - oDoc -- the document with the model and data sheet
' - dataSheet -- the index of the data sheet in the document data sheets
'
Sub InstantiateModel (oDoc As Object, dataSheet As Integer)
Dim classes, exps As Object
Dim i As Integer
' iterate over classes and instantiate them
classes = GetRootClasses( oDoc )
For i=LBound( classes ) To UBound( classes )
InstantiateClass( oDoc, classes(i), dataSheet )
Next i
' iterate over expansions and instantiate them
exps = GetExpansions( oDoc )
For i=LBound( exps ) To UBound( exps )
InstantiateExpansion( oDoc, exps(i), dataSheet )
Next i
End Sub
' =====================================
' Creates an instance of a model class.
' Arguments:
' - class -- string representation of the class
'
Sub InstantiateClass (oDoc As Object, class As String, dataSheet As Integer)
Dim rangeName As String
Dim oRange, oAddr, i , j, oCell, oDest
rangeName = GetClassRangeName( class )
oRange = StringToRange( oDoc, rangeName )
oAddr = oRange.getRangeAddress()
For i=oAddr.StartColumn To oAddr.EndColumn
For j=oAddr.StartRow To oAddr.EndRow
oCell = oDoc.Sheets(oAddr.Sheet).getCellByPosition( i, j )
oDest = oDoc.Sheets(dataSheet).getCellByPosition( i, j )
InstantiateCell( oCell, oDest )
Next j
Next i
End Sub
' =====================================
' Creates an instance of a model cell.
' Arguments:
' - oCell -- the model cell
' - oDest -- the destination cell
'
' TODO maybe name the destination cell
'
Sub InstantiateCell (oCell As com.sun.star.sheet.SheetCell, oDest As com.sun.star.sheet.SheetCell)
' determine the type of the cell, and instantiate it
' types of cells:
' - label (just alphanumeric characters)
' - formula (label '=' [Class '.'] ( cell ref | cell label ))
Dim parts As Object
Dim label, formula As String
If (oCell.String = "") Then
oDest.String = ""
Exit Sub
EndIf
parts = Split( oCell.String, "=" )
label = parts(0)
If (UBound(parts) > 0) _
Then
oDest.Formula = "=" & parts(1)
Else
oDest.String = label
EndIf
End Sub
' =====================================
' Creates an instance of a expansion.
' Arguments:
' - oCell -- the model cell
' - exp -- string representation of the expansion
' - dataSheet -- index of the data sheet
'
Sub InstantiateExpansion (oDoc As Object, exp As String, dataSheet As Integer)
Dim oForm, oButton, oShape As Object
Dim oSheet, oRange, oAddr As Object
Dim str_name, str_range, form_name, btn_name As String
Dim etype As Integer
str_name = GetExpansionName( exp )
str_range = GetExpansionRangeName( exp )
etype = GetExpansionType( exp )
oRange = StringToRange( oDoc, str_range )
oAddr = oRange.getRangeAddress()
'oSheet = oDoc.Sheets( oAddr.Sheet )
oSheet = oDoc.Sheets( dataSheet )
' ===== FORM =====
form_name = "HaExcel_" & str_name & "_" & etype
btn_name = form_name & "_button"
oForm = GetForm( oSheet, form_name )
If oForm <> Null Then ' form exists
'
' TODO check if button exists
'
Else ' form does not exist
' create the form
'oForm = createUnoService("com.sun.star.form.FormComponent")
oForm = createUnoService("com.sun.star.form.component.Form")
oForm.Name = form_name
'AddForm( oSheet, oForm )
AddFormWithName( oSheet, oForm, form_name )
End If
' ===== BUTTON =====
' positionShape( oShape, 1000, 1000 + 800, 5000, 600 ) 'http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Forms/Programmatic_Assignment_of_Scripts_to_Events
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStartCell, oEndCell As Object
If etype <> 0 Then
oButton = CreateExpandButton ( btn_name, True )
' calculate the position and the size of the button
oStartCell = oSheet.getCellByPosition( oAddr.StartColumn, oAddr.EndRow + 1 )
oEndCell = oSheet.getCellByPosition( oAddr.EndColumn , oAddr.EndRow + 1 )
oPos.X = oStartCell.Position.X
oPos.Y = oStartCell.Position.Y
oSize.Width = oEndCell.Position.X + oEndCell.Size.Width
oSize.Height = oEndCell.Size.Height - 100 ' or oStartCell.Size.Height ... it's all in the same row
Else
oButton = CreateExpandButton ( btn_name, False )
' calculate the position and the size of the button
oStartCell = oSheet.getCellByPosition( oAddr.EndColumn+1, oAddr.StartRow )
oEndCell = oSheet.getCellByPosition( oAddr.EndColumn+1, oAddr.EndRow )
oPos.X = oStartCell.Position.X
oPos.Y = oStartCell.Position.Y
oSize.Width = oEndCell.Size.Width - 100 ' or oStartCell.Size.Width ... it's all in the same column
oSize.Height = oEndCell.Position.Y + oEndCell.Size.Height
End If
oForm.insertByIndex( etype, oButton )
' ===== SHAPE =====
'oShape = createUnoService( "com.sun.star.drawing.ControlShape" )
oShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
oShape.setPosition( oPos )
oShape.setSize( oSize )
Erase oPos
Erase oSize
oShape.Control = oButton
oSheet.DrawPage.add( oShape )
' ===== EVENT =====
' http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Forms/Programmatic_Assignment_of_Scripts_to_Events
' we want to add the equivalent of an com.sun.star.awt.XItemListener
Dim sListenerInterfaceName As String
sListenerInterfaceName = "XActionListener" ' "com.sun.star.awt.XItemListener"
Dim sListenerMethodName As String
sListenerMethodName = "actionPerformed"
' we want the onColorChange function in this module to be called
Dim sMacroLocation As String
' TODO correct the path to the macro
'sMacroLocation = "application:HaExcelDev.ClassSheet.NotImplemented"
sMacroLocation = "vnd.sun.star.script:HaExcelDev.ClassSheet.NotImplemented?language=Basic&location=application"
' note that this assumes that the module is called macro_assignment, and
' resides in the "Standard" library of the application-wide Basic macros
' bind a macro to the "stateChanged" event
Dim oEvent as new com.sun.star.script.ScriptEventDescriptor
oEvent.AddListenerParam = ""
oEvent.ListenerType = sListenerInterfaceName
oEvent.EventMethod = sListenerMethodName
oEvent.ScriptType = "Script"
oEvent.ScriptCode = sMacroLocation
oForm.registerScriptEvent( 0, oEvent )
Erase oEvent
End Sub
' =====================================
' Checks if a form exists.
' Arguments:
' - oSheet -- the sheet to search in
' - str -- the name of the form
' Returns: true if form exists; otherwise false
'
Function FormExists (oSheet As Object, str As String) As Boolean
FormExists = oSheet.DrawPage.Forms.hasByName( str )
End Function
' =====================================
' Gets a form from a sheet
' Arguments:
' - oSheet -- the sheet to search in
' - str -- the name of the form
' Returns: the form if it exists; otherwise Nothing
'
Function GetForm (oSheet As Object, str As String) As com.sun.star.form.Form
If FormExists( oSheet, str ) Then
GetForm = oSheet.DrawPage.Forms.getByName( str )
Else
GetForm = Nothing
End If
End Function
' =====================================
' Appends a form to a sheet.
' Arguments:
' - oSheet -- the sheet where to append the form
' - oForm -- the form to append
'
Sub AddForm (oSheet As Object, oForm As com.sun.star.form.Form)
Dim count As Long
count = oSheet.DrawPage.Forms.getCount
oSheet.DrawPage.Forms.insertByIndex( count+1, oForm )
End Sub
' =====================================
' Inserts a form with a given name to a sheet.
' Arguments:
' - oSheet -- the sheet where to append the form
' - oForm -- the form to append
' - str -- the name of the form
'
Sub AddFormWithName (oSheet As Object, oForm As com.sun.star.form.Form, str As String)
Dim oForms as Object
oForms = oSheet.DrawPage.Forms
oForms.insertByName( str, oForm )
'oSheet.DrawPage.Forms.insertByName( str, oForm )
End Sub
' =====================================
' Creates a button to expand columns/rows.
' Arguments:
' - str -- the name of the button to create
' - h -- true for horizontal button (expand rows); otherwise false.
' Returns: the created button
'
Function CreateExpandButton (str As String, h As Boolean) As com.sun.star.form.component.CommandButton
Dim oControlModel As Object
oControlModel = createUnoService("com.sun.star.form.component.CommandButton")
oControlModel.Name = str
If h Then
oControlModel.Label = "⋮"
Else
oControlModel.Label = "⋯"
End If
CreateExpandButton = oControlModel
End Function
' =====================================
' Event function for the expand button press
' Arguments:
' - oEvent -- the event information
'
Sub doExpandRows (oEvent As Object)
Dim oSrc As Object
oSrc = oEvent.Source
' TODO get info from button and its respective form
' and call ExpanRows with the right arguments
End Sub
' =====================================
' Creates an expansion of rows.
' Arguments:
' - oDoc -- the document where to make the changes
' - oModelRange -- the range of the cells from the model to instantiate
' - oDest -- the address of the top left cell where to insert the instantiation
'
Sub ExpandRows(oDoc As Object , _
oModelRange As com.sun.star.table.CellRangeAddress , _
oDest As com.sun.star.table.CellAddress )
Dim oDestSheet As Object
Dim oDestRange As New com.sun.star.table.CellRangeAddress
oDestSheet = oDoc.Sheets(oDest.Sheet)
With oDestRange
.Sheet = oDest.Sheet
.StartColumn = oDest.Column
.StartRow = oDest.Row
.EndColumn = oDest.Column + ( oModelRange.EndColumn - oModelRange.StartColumn )
.EndRow = oDest.Row + ( oModelRange.EndRow - oModelRange.StartRow )
End With
oDestSheet.insertCells(oDestRange, com.sun.star.sheet.CellInsertMode.DOWN)
' TODO intantiate the cells
End Sub
' =====================================
</script:module>
Generated by GNU Enscript 1.6.5.90.
|