Variable list demo2

'Begin Description
'This script illustrates how to use a list box with a Dialog monitor function, 
'to select multiple variables from an SPSS data file.  
'It simply displays the selected variables in a message box when finished.
'End Description

'require variables to be dimensioned before use
Option Explicit

'this needs to be a global variable so it can be modified
'by the dialog function
Dim strVarsSelected() As String

Sub Main
	
	'we'll call a function which returns selected variables 
	'in an array of strings we pass it.

	'loop control variable
	Dim i As Integer
	'we'll use this string to display the result
	Dim strTemp As String
	
	'the function result is True if one or more variables are selected
	'False if the user presses cancel
	If MultipleVariableSelectionDialog(strVarsSelected()) Then
		'this is just a demo, so we'll make a single string out of the 
		'variable names, and display it.  (We could have written the 
		'function to return this as a string, with an empty string 
		'signifying Cancel.)
		For i = LBound(strVarsSelected) To UBound(strVarsSelected)
			strTemp = strTemp & strVarsSelected(i) & vbCrLf
		Next
		MsgBox strTemp, vbInformation, "Variables Selected"
	Else
		MsgBox "Operation Cancelled.", vbExclamation, _
			"No Variables Selected"
	End If	
	
End Sub


'we'll put the selected variable names in the array passed as a parameter
'we'll return False as the function result if the user cancels,
'True if the user pressed OK after selecting at least one variable.
Function MultipleVariableSelectionDialog(strVarsSelected() As String) As Boolean
	'we'll pass string arrays to the dialog's listboxes
	'actually, the dialog function will initialize the arrays
	Dim strVariables() As String
	ReDim strVariables(0)
	
	're-initialize the Selected array, too
	ReDim strVarsSelected(0)
	
	'we'll make things nice by displaying the name of the data file
	Dim strFilePath As String
		
	'the path to the file
	strFilePath = objSpssApp.Documents.GetDataDoc(0).GetDocumentPath
	'if the file hasn't been saved
	If strFilePath = "" Then
		strFilePath = "(Untitled)"
	End If
	
	'Define and put up the dialog.
	
	'To edit the dialog: position the cursor between Begin Dialog and 
	'End Dialog, then activate the Dialog Editor.
	'Note that the dialog editor created a template with ListArray()
	'as the ListBox parameter; it's been replaced by strVariables.
	'Right-click on an item to edit its properties, or use the toolbar button.
	'Use the << and >> arrows to cycle through items.
	'Add a function name to the UserDialog's Dialog Function property,
	'and when you save the dialog it will offer to generate the skeleton
	'of the dialog monitor function.  See VarListDialogMonitor function, below.
	Begin Dialog UserDialog 490,203,"Variable List Selection Demo",.VarListDialogFunc
		GroupBox 10,7,470,189,strFilePath,.GroupBox1
		OKButton 340,161,120,21
		PushButton 210,35,80,21,"   Add >>",.PushButtonAdd
		CancelButton 220,161,110,21
		PushButton 210,63,80,21,"<< Remove",.PushButtonRemove
		ListBox 20,21,180,168,strVariables(),.ListBoxVars
		ListBox 300,21,160,133,strVarsSelected(),.ListBoxVarsSelected
	End Dialog

	'the Cancel button will cause an error when pressed, 
	'so we need to set up error handling before putting up the dialog.
	On Error GoTo UserCancel
	
	Dim dlg As UserDialog

	'We'll set the default choice to be item 0
	dlg.ListBoxVars = 0
	
	'this actually puts up the dialog.	
	Dialog dlg
	
	'we do a quick check to make sure variables were selected
	MultipleVariableSelectionDialog = True	'(strVarsSelected(0) <> "")
		
	Exit Function

'here's the error handler
UserCancel:
	'in other circumstances, we might put up a message box.
	'Here, we'll return an empty string.  It's up to the caller 
	'of the function to respond appropriately.
	Debug.Print "Error" & Err & vbCrLf & Err.Description
	MultipleVariableSelectionDialog = False
End Function


Rem See DialogFunc help topic for more information.
'the Dialog Monitor is called repeatedly while the dialog is displayed.
'when it returns False, the dialog will close.
Private Function VarListDialogFunc(DlgItem$, Action%, SuppValue%) As Boolean
	'static variables retain their values between function invocations
	'we'll use these to track which variables are selected
	Static strVars() As String
	'Static strVarsSelected() As String
	'loop control variable
	Dim i As Integer
	
	Select Case Action%
	Case 1 ' Dialog box initialization
		'Dim strTemp() As String

		Call InitVariables(strVars)
		Debug.Print LBound(strVars); UBound(strVars)
		Debug.Print strVars(0); strVars(UBound(strVars))
		DlgListBoxArray "ListBoxVars", strVars()
		ReDim strVarsSelected(0)
		DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
		DlgEnable "OK", False
		DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0)
		DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0)
		VarListDialogFunc = False
	Case 2 ' Value changing or button pressed
		If DlgItem$ = "PushButtonAdd" Then
			Call MoveItem(DlgValue("ListBoxVars"), strVars(), strVarsSelected())
			DlgListBoxArray "ListBoxVars", strVars()
			DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
			DlgEnable "OK", True
			VarListDialogFunc = True ' Prevent button press from closing the dialog box
		ElseIf DlgItem$ = "PushButtonRemove" Then
			Call MoveItem(DlgValue("ListBoxVarsSelected"), strVarsSelected(), strVars())			
			DlgListBoxArray "ListBoxVars", strVars()
			DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
			DlgEnable "OK", (strVarsSelected(0) <> "")
			VarListDialogFunc = True ' Prevent button press from closing the dialog box
	'	ElseIf dlgItem$ = "OK" Then
	'		DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
		End If
		Rem VarListDialogFunc = True ' Prevent button press from closing the dialog box
	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0)
		DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0)
		VarListDialogFunc = True ' Continue getting idle actions
	End Select
End Function


Sub InitVariables(strVars() As String)	'As Variant
	'the variable list is a property of the Info object.
	Dim objInfo As ISpssInfo
	'we'll return the array of strings in a variant
	'Dim strVars() As String
	'loop control variable
	Dim i As Integer
	'we'll need to know how many variables there are
	Dim intNumVariables As Integer
	
	Set objInfo = objSpssApp.SpssInfo
	'the variables are indexed by 0 to .NumVariables - 1
	intNumVariables = objInfo.NumVariables
	
	If intNumVariables > 0 Then
		'set aside enough storage for the array
		ReDim strVars(intNumVariables - 1)
		
		'read in the variable names
		For i = 0 To intNumVariables - 1
			'if we preferred, we could work with labels instead, or both
			strVars(i) = objInfo.VariableAt(i)
			'strVars(i) = objInfo.VariableLabelAt(i)
			'strVars(i) = objInfo.VariableAt(i) & ": " & objInfo.VariableLabelAt(i)
		Next 
	Else
		'array with one empty string
		ReDim strVars(0)
	End If
	
	'InitVariables = strVars
End Sub


'utility procedure for moving an item, omits checks because it's only
'called from the dialog function
Sub MoveItem(intItem As Integer, strFrom() As String, strTo() As String)
	Dim i As Integer
	Dim intUpper As Integer
	
	'add the item to the destination array
	intUpper = UBound(strTo)
	Debug.Print intUpper; intItem; strTo(intUpper)
	'make sure we keep the current contents
	ReDim Preserve strTo(intUpper + 1)
	strTo(intUpper + 1) = strFrom(intItem)
	
	'remove the item from the source array
	intUpper = UBound(strFrom)
	'copy the items above the removed one position lower
	For i = intItem To intUpper - 1
		strFrom(i) = strFrom(i + 1)
	Next
	If intUpper > 0 Then
		'keep all but the last element
		ReDim Preserve strFrom(intUpper - 1)
	Else
		'this will re-initialize the array to contain one empty string
		ReDim strFrom(0)
	End If
End Sub