Variable list demo3

'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.
'It differs from VarListDemo2 only in that it uses a function call and 
'static variables, to avoid the use of global variables.  
'This simplifies encapsulation of the code, and encourages reuse, but is 
'otherwise unneeded.
'End Description

'require variables to be dimensioned before use
Option Explicit

'demonstrates use of the MultipleVariableSelectionDialog function
Sub Main
	
	'we'll call a function which returns variables selected
	'by the user in an array of strings we pass it.
	Dim strVarsSelected() As String
	'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 - which we only allow after at least one 
'variable is selected.
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
	'but we have to pass it a string array or there will be a type mismatch.
	Dim strVariables() As String
	ReDim strVariables(0)
	
	're-initialize the Selected array, to make sure it isn't empty.
	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
		CancelButton 220,161,110,21
		PushButton 210,35,80,21,"   Add   >> ",.PushButtonAdd
		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

	'this actually puts up the dialog.	
	Dialog dlg
	
	'we used a utility function called from the dialog monitor
	'to store the variables.  Request them now.
	strVarsSelected() = SelectedVariableArray("", False)
	
	'return true since user hit OK
	MultipleVariableSelectionDialog = True
		
	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
	ReDim strVarsSelected(0)
	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
	'the item selected 
	Dim intDlgItem As Integer
	
	Select Case Action%
	Case 1 ' Dialog box initialization
		Call InitVariables(strVars)
		DlgListBoxArray "ListBoxVars", strVars()
		ReDim strVarsSelected(0)
		DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
		DlgEnable "OK", False
		DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0)
		DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0)
		'while initializing, return True to close the dialog
		'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
			'store the array, ignore the function result
			Call SelectedVariableArray(strVarsSelected(), True)
		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, intItem will be valid
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 strTo(intUpper); intUpper; intItem
	'make the array larger, but 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 item down one position
	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


'this is a cheap dodge which lets us avoid using a global variable
'to pass the array out of the dialog monitor.  This function stores 
'its parameter when called with blnStore = True, and returns whatever 
'was stored previously as the function result.  This makes it easier
'to encapsulate code, since when copying the code for re-use, we 
'don't need to create and follow instructions to add a global variable 
'to the project in order for the code to work.
Function SelectedVariableArray(vntStore As Variant, blnStore As Boolean) As Variant
	Static vntStored As Variant
	
	SelectedVariableArray = vntStored
	
	'we refuse to store anything but an array of strings
	If blnStore Then
		If IsArray(vntStore) Then
			If VarType(vntStore(0)) = vbString Then
				vntStored = vntStore
			End If
		End If
	End If
End Function