ScriptForge: AddSubNode/AddSubTree for tree controls

A new dialog control is is introduced: the tree control

The proposed methods let create a root node
and build a tree, either branch by branch
or many branches at once when they are issued from a sorted array

Change-Id: I4265fd6e413be383a7b6df3b9cd754d657066c19
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/107154
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>

wizards/source/scriptforge/SF_Array.xba

@@ -2546,4 +2546,4 @@ Dim iCompare As Integer, iVarType1 As Integer, iVarType2 As Integer
 End Function	'	ScriptForge.SF_Array._ValCompare
 
 REM ================================================= END OF SCRIPTFORGE.SF_ARRAY
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_Dictionary.xba

@@ -949,4 +949,4 @@ Const cstSeparator = ", "
 End Function	'	ScriptForge.SF_Dictionary._Repr
 
 REM ============================================ END OF SCRIPTFORGE.SF_DICTIONARY
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_Exception.xba

@@ -1104,4 +1104,4 @@ Private Function _Repr() As String
 End Function	'	ScriptForge.SF_Exception._Repr
 
 REM ============================================ END OF SCRIPTFORGE.SF_EXCEPTION
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_L10N.xba

@@ -693,4 +693,4 @@ Private Function _Repr() As String
 End Function	'	ScriptForge.SF_L10N._Repr
 
 REM ============================================ END OF SCRIPTFORGE.SF_L10N
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_Root.xba

@@ -64,6 +64,7 @@ Private DatabaseContext		As Object	' com.sun.star.sdb.DatabaseContext
 Private ConfigurationProvider _
 							As Object	' com.sun.star.configuration.ConfigurationProvider
 Private MailService			As Object	' com.sun.star.system.SimpleCommandMail or com.sun.star.system.SimpleSystemMail
+Private TreeDataModel		As Object	' com.sun.star.awt.tree.MutableTreeDataModel
 
 '	Specific persistent services objects or properties
 Private FileSystemNaming	As String	' If "SYS", file and folder naming is based on operating system notation
@@ -114,6 +115,7 @@ Private Sub Class_Initialize()
 	Set DatabaseContext = Nothing
 	Set ConfigurationProvider = Nothing
 	Set MailService = Nothing
+	Set TreeDataModel = Nothing
 	OSName = ""
 	SFDialogs = Empty
 End Sub		'	ScriptForge.SF_Root Constructor

wizards/source/scriptforge/SF_Services.xba

@@ -604,4 +604,4 @@ Catch:
 End Function	'	ScriptForge.SF_Services._NewTimer
 
 REM ============================================== END OF SCRIPTFORGE.SF_SERVICES
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_String.xba

@@ -2639,4 +2639,4 @@ Dim i As Long
 End Function	'	ScriptForge.SF_String._Repr
 
 REM ================================================ END OF SCRIPTFORGE.SF_STRING
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_Timer.xba

@@ -460,4 +460,4 @@ Const cstMaxLength = 50	'	Maximum length for items
 End Function	'	ScriptForge.SF_Timer._Repr
 
 REM ============================================ END OF SCRIPTFORGE.SF_TIMER
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_UI.xba

@@ -1172,4 +1172,4 @@ Private Function _Repr() As String
 End Function	'	ScriptForge.SF_UI._Repr
 
 REM ============================================ END OF SCRIPTFORGE.SF_UI
-</script:module>
+</script:module>

wizards/source/scriptforge/SF_Utils.xba

@@ -427,6 +427,11 @@ Dim vNodePath As Variant
 					Set .TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
 				End If
 				Set _GetUNOService = .TextSearch
+			Case "TreeDataModel"
+				If IsEmpty(.TreeDataModel) Or IsNull(.TreeDataModel) Then
+					Set .TreeDataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel")
+				End If
+				Set _GetUNOService = .TreeDataModel
 			Case "URLTransformer"
 				If IsEmpty(.URLTransformer) Or IsNull(.URLTransformer) Then
 					Set .URLTransformer = CreateUnoService("com.sun.star.util.URLTransformer")

wizards/source/sfdialogs/SF_Dialog.xba

@@ -70,6 +70,14 @@ Private _DialogModel		As Object		' com.sun.star.awt.XControlModel - stardiv
 Private _Displayed			As Boolean		' True after Execute()
 Private _Modal				As Boolean		' Set by Execute()
 
+'	Cache for TreeControl events
+Private _TreeCache			As Object		' Dictionary: key = control name, item = _TreeControl
+
+Type _TreeControl
+	OnNodeSelected			As String
+	OnNodeExpanded			As String
+End Type
+
 REM ============================================================ MODULE CONSTANTS
 
 Private Const OKBUTTON		= 1
@@ -92,6 +100,7 @@ Private Sub Class_Initialize()
 	Set _DialogModel = Nothing
 	_Displayed = False
 	_Modal = True
+	Set _TreeCache = ScriptForge.SF_Services.CreateScriptService("Dictionary")
 End Sub		'	SFDialogs.SF_Dialog Constructor
 
 REM -----------------------------------------------------------------------------

wizards/source/sfdialogs/SF_DialogControl.xba

@@ -23,6 +23,12 @@ 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 AddChild), or
+'''			- with a set of branches at once (AddSubtree)
+'''		Additionally populating a TreeConctrol can be done statically or dynamically
+'''
 '''		Service invocation:
 '''			Dim myDialog As Object, myControl As Object
 '''				Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName)
@@ -53,6 +59,7 @@ Private _DialogName			As String		' Parent dialog name
 '	Control UNO references
 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
 
 '	Control attributes
 Private	_ImplementationName	As String
@@ -79,6 +86,7 @@ Private Const CTLRADIOBUTTON	= "RadioButton"
 Private Const CTLSCROLLBAR		= "ScrollBar"
 Private Const CTLTEXTFIELD		= "TextField"
 Private Const CTLTIMEFIELD		= "TimeField"
+Private Const CTLTREECONTROL	= "TreeControl"
 
 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
 
@@ -92,6 +100,7 @@ Private Sub Class_Initialize()
 	_DialogName = ""
 	Set _ControlModel = Nothing
 	Set _ControlView = Nothing
+	Set _TreeDataModel = Nothing
 	_ImplementationName = ""
 	_ControlType = ""
 End Sub		'	SFDialogs.SF_DialogControl Constructor
@@ -381,6 +390,30 @@ Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
 	_PropertySet("OnMouseReleased", pvOnMouseReleased)
 End Property	'	SFDialogs.SF_DialogControl.OnMouseReleased (let)
 
+REM -----------------------------------------------------------------------------
+Property Get OnNodeExpanded() As Variant
+'''	Get the script associated with the OnNodeExpanded event
+	OnNodeExpanded = _PropertyGet("OnNodeExpanded")
+End Property	'	SFDialogs.SF_DialogControl.OnNodeExpanded (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnNodeExpanded(Optional ByVal pvOnNodeExpanded As Variant)
+'''	Set the updatable property OnNodeExpanded
+	_PropertySet("OnNodeExpanded", pvOnNodeExpanded)
+End Property	'	SFDialogs.SF_DialogControl.OnNodeExpanded (let)
+
+REM -----------------------------------------------------------------------------
+Property Get OnNodeSelected() As Variant
+'''	Get the script associated with the OnNodeSelected event
+	OnNodeSelected = _PropertyGet("OnNodeSelected")
+End Property	'	SFDialogs.SF_DialogControl.OnNodeSelected (get)
+
+REM -----------------------------------------------------------------------------
+Property Let OnNodeSelected(Optional ByVal pvOnNodeSelected As Variant)
+'''	Set the updatable property OnNodeSelected
+	_PropertySet("OnNodeSelected", pvOnNodeSelected)
+End Property	'	SFDialogs.SF_DialogControl.OnNodeSelected (let)
+
 REM -----------------------------------------------------------------------------
 Property Get OnTextChanged() As Variant
 '''	Get the script associated with the OnTextChanged event
@@ -507,8 +540,220 @@ Property Get XControlView() As Object
 	XControlView = _PropertyGet("XControlView", Nothing)
 End Property	'	SFDialogs.SF_DialogControl.XControlView (get)
 
+REM -----------------------------------------------------------------------------
+Property Get XTreeDataModel() As Object
+'''	The XTreeDataModel property returns the model UNO object of the control
+	XTreeDataModel = _PropertyGet("XTreeDataModel", Nothing)
+End Property	'	SFDialogs.SF_DialogControl.XTreeDataModel (get)
+
 REM ===================================================================== METHODS
 
+REM -----------------------------------------------------------------------------
+Public Function AddSubNode(Optional ByRef ParentNode As Variant _
+								, Optional ByVal DisplayValue As Variant _
+								, Optional ByRef DataValue As Variant _
+								) As Variant
+'''	Return a new node of the tree control subordinate to a parent node
+'''	Args:
+'''		ParentNode: A node UNO object,  of type com.sun.star.awt.tree.XMutableTreeNode
+'''		DisplayValue: the text appearing in the control box
+'''		DataValue: any value associated with the new node. Default = Empty
+'''	Returns:
+'''		The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode
+'''	Examples:
+'''		Dim myTree As Object, myNode As Object, theRoot As Object
+'''			Set myTree = myDialog.Controls("myTreeControl")
+'''			Set theRoot = myTree.CreateRoot("Tree top")
+'''			Set myNode = myTree.AddSubNode(theRoot, "A branch ...")
+
+Dim oNode As Object				'	Return value
+Const cstThisSub = "SFDialogs.DialogControl.AddSubNode"
+Const cstSubArgs = "ParentNode, DisplayValue, [DataValue=Empty]"
+
+	If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+	Set oNode = Nothing
+
+Check:
+	If IsMissing(DataValue) Then DataValue = Empty
+	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+		If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
+		If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
+		If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
+	End If
+
+Try:
+	With _TreeDataModel
+		Set oNode = .createNode(DisplayValue, True)
+		oNode.DataValue = DataValue
+		ParentNode.appendChild(oNode)
+	End With
+
+Finally:
+	Set AddSubNode = oNode
+	ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+	Exit Function
+Catch:
+	GoTo Finally
+End Function	'	SFDialogs.SF_DialogControl.AddSubNode
+
+REM -----------------------------------------------------------------------------
+Public Function AddSubTree(Optional ByRef ParentNode As Variant _
+								, Optional ByRef FlatTree As Variant _
+								, Optional ByVal WithDataValue As Variant _
+								) As Boolean
+'''	Return True when a subtree, subordinate to a parent node, could be inserted successfully in a tree control
+'''	If the parent node had already child nodes before calling this method, the child nodes are erased
+'''	Args:
+'''		ParentNode: A node UNO object,  of type com.sun.star.awt.tree.XMutableTreeNode
+'''		FlatTree: a 2D array sorted on the columns containing the DisplayValues
+'''				Flat tree		>>>>		Resulting subtree
+'''				A1	B1	C1					|__	A1		
+'''				A1	B1	C2						|__	B1	
+'''				A1	B2	C3							|__	C1
+'''				A2	B3	C4							|__	C2
+'''				A2	B3	C5							B2	
+'''				A3	B4	C6							|__	C3
+'''											|__	A2		
+'''												|__	B3	
+'''													|__	C4
+'''													|__	C5
+'''											|__	A3		
+'''												|__	B4	
+'''													|__	C6
+'''			Typically, such an array can be issued by the GetRows method applied on the SFDatabases.Database service
+'''			when the array item containing the text to be displayed is = "" or is empty/null,
+'''				no new subnode is created and the remainder of the row is skipped
+'''		WithDataValue:
+'''			When False (default), every column of FlatTree contains the text to be displayed in the tree control
+'''			When True, the texts to be displayed (DisplayValue) are in columns 0, 2, 4, ...
+'''				while the DataValues are in columns 1, 3, 5, ...
+'''	Returns:
+'''		The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode
+'''	Examples:
+'''		Dim myTree As Object, theRoot As Object, oDb As Object, vData As Variant
+'''			Set myTree = myDialog.Controls("myTreeControl")
+'''			Set theRoot = myTree.CreateRoot("By product category")
+'''			Set oDb = CreateScriptService("SFDatabases.Database", "/home/.../mydatabase.odb")
+'''			vData = oDb.GetRows("SELECT [Category].[Name], [Category].[ID], [Product].[Name], [Product].[ID] " _
+'''				& "FROM [Category], [PRODUCT] WHERE [Product].[CategoryID] = [Category].[ID] " _
+'''				& "ORDER BY [Category].[Name], [Product].[Name]")
+'''			myTree.AddSubTree(theRoot, vData)
+
+Dim bSubTree As Boolean				'	Return value
+Dim oNode As Object					'	com.sun.star.awt.tree.XMutableTreeNode
+Dim oNewNode As Object				'	com.sun.star.awt.tree.XMutableTreeNode
+Dim lChildCount As Long				'	Number of children nodes of a parent node
+Dim iStep As Integer				'	1 when WithDataValue = False, 2 otherwise
+Dim bChange As Boolean				'	When True, the item in FlatTree is different from the item above
+Dim sValue As String				'	Alias for display values
+Dim i As Long, j As Long
+Const cstThisSub = "SFDialogs.DialogControl.AddSubTree"
+Const cstSubArgs = "ParentNode, FlatTree, [WithDataValue=False]"
+
+	If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+	bSubTree = False
+
+Check:
+	If IsMissing(WithDataValue) Or IsEmpty(WithDataValue) Then WithDataValue = False
+	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+		If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
+		If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
+		If Not ScriptForge.SF_Utils._ValidateArray(FlatTree, "FlatTree", 2) Then GoTo Catch
+		If Not ScriptForge.SF_Utils._Validate(WithDataValue, "WithDataValue", V_BOOLEAN) Then GoTo Catch
+	End If
+
+Try:
+	With _TreeDataModel
+		'	Clean subtree
+		lChildCount = ParentNode.getChildCount()
+		For i = 1 To lChildCount
+			ParentNode.removeChildByIndex(0)		'	This cleans all subtrees too
+		Next i
+		'	Build a new subtree
+		If UBound(FlatTree, 1) < LBound(FlatTree, 1) Then		'Array is empty
+		Else
+			iStep = Iif(WithDataValue, 2, 1)
+			For i = LBound(FlatTree, 1) To UBound(FlatTree, 1)					'	Array rows
+				bChange = ( i = 0 )
+				'	Restart from the parent node at each i-iteration
+				Set oNode = ParentNode
+				For j = LBound(FlatTree, 2) To UBound(FlatTree, 2) Step iStep	'	Array columns
+					If FlatTree(i, j) = "" Or IsNull(FlatTree(i, j)) Or IsEmpty(FlatTree(i, j)) Then
+						Set oNode = Nothing
+						Exit For		'	Exit j-loop
+					End If
+					If Not bChange Then bChange = ( FlatTree(i, j) <> FlatTree(i - 1, j) )
+					If bChange Then		'	Create new subnode at tree depth = j
+						If VarType(FlatTree(i, j)) = V_STRING Then sValue = FlatTree(i, j) Else sValue = ScriptForge.SF_String.Represent(FlatTree(i, j))
+						Set oNewNode = .createNode(sValue, True)
+						If WithDataValue Then oNewNode.DataValue = FlatTree(i, j + 1)
+						oNode.appendChild(oNewNode)
+						Set oNode = oNewNode
+					Else
+						'	Position next current node on last child of actual current node
+						lChildCount = oNode.getChildCount()
+						If lChildCount > 0 Then Set oNode = oNode.getChildAt(lChildCount - 1) Else Set oNode = Nothing
+					End If
+				Next j
+			Next i
+		End If			
+	End With
+
+Finally:
+	AddSubTree = bSubTree
+	ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+	Exit Function
+Catch:
+	GoTo Finally
+End Function	'	SFDialogs.SF_DialogControl.AddSubTree
+
+REM -----------------------------------------------------------------------------
+Public Function CreateRoot(Optional ByVal DisplayValue As Variant _
+								, Optional ByRef DataValue As Variant _
+								) As Variant
+'''	Return a new root node of the tree control. The new tree root is inserted below pre-exiting root nodes
+'''	Args:
+'''		DisplayValue: the text appearing in the control box
+'''		DataValue: any value associated with the root node. Default = Empty
+'''	Returns:
+'''		The new root node as a UNO object of type com.sun.star.awt.tree.XMutableTreeNode
+'''	Examples:
+'''		Dim myTree As Object, myNode As Object
+'''			Set myTree = myDialog.Controls("myTreeControl")
+'''			Set myNode = myTree.CreateRoot("Tree starts here ...")
+
+Dim oRoot As Object				'	Return value
+Const cstThisSub = "SFDialogs.DialogControl.CreateRoot"
+Const cstSubArgs = "DisplayValue, [DataValue=Empty]"
+
+	If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+	Set oRoot = Nothing
+
+Check:
+	If IsMissing(DataValue) Then DataValue = Empty
+	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+		If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
+	End If
+
+Try:
+	With _TreeDataModel
+		Set oRoot = .createNode(DisplayValue, True)
+		oRoot.DataValue = DataValue
+		.setRoot(oRoot)
+		'	To be visible, a root must have contained at least 1 child. Create a fictive one and erase it.
+		'	This behavious does not seem related to the RootDisplayed property ??
+		oRoot.appendChild(.createNode("Something", False))
+		oRoot.removeChildByIndex(0)
+	End With
+
+Finally:
+	Set CreateRoot = oRoot
+	ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+	Exit Function
+Catch:
+	GoTo Finally
+End Function	'	SFDialogs.SF_DialogControl.CreateRoot
+
 REM -----------------------------------------------------------------------------
 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
 '''	Return the actual value of the given property
@@ -833,10 +1078,14 @@ Try:
 	vServiceName = Split(_ControlModel.getServiceName(), ".")
 	sType = vServiceName(UBound(vServiceName))
 	Select Case sType
-		Case "UnoControlSpinButtonModel", "TreeControlModel"
-			_ControlType = ""	'	Not supported
-		Case "Edit"				:	_ControlType = CTLTEXTFIELD
-		Case Else				:	_ControlType = sType
+		Case "UnoControlSpinButtonModel"
+			_ControlType = ""	' Not supported
+		Case "Edit"					:	_ControlType = CTLTEXTFIELD
+		Case "TreeControlModel"	' Initialize the data model
+			_ControlType = CTLTREECONTROL
+			Set _ControlModel.DataModel = ScriptForge.SF_Utils._GetUNOService("TreeDataModel")
+			_TreeDataModel = _ControlModel.DataModel
+		Case Else					:	_ControlType = sType
 	End Select
 	
 Finally:
@@ -1067,6 +1316,8 @@ Const cstSubArgs = ""
 			Set _PropertyGet = _ControlModel
 		Case UCase("XControlView")
 			Set _PropertyGet = _ControlView
+		Case UCase("XTreeDataModel")
+			Set _PropertyGet = _TreeDataModel
 		Case Else
 			_PropertyGet = Null
 	End Select