'Описание
'Скрип иллюстрирует использование элемента "список" с функцие Dialog
'для выбора множества переменных из файла данных SPSS.
'После выбора программа отображает отобранные переменные в виде сообщения.
'Конец описания

'потребуем явного определения переменных перед их использованием
Option Explicit

'нам потребуется глобальная переменная чтобы менять её через функцию диалога
Dim strVarsSelected() As String

Sub Main
	
	'будем вызывать функцию, которая вернёт выбранные переменные из того массива, который мы передадим ей.

	'индексная переменная цикла
	Dim i As Integer
	'используем эту строку для отображения результата
	Dim strTemp As String
	
	'эта функция имеет значение True (Истина), если выбрана минимум одна переменная,
	'и False (Ложь), если пользователь нажал "Отмена"
	If MultipleVariableSelectionDialog(strVarsSelected()) Then
		'это просто демонстрация. Мы сделаем строку из имён выбранных переменных и отобразим её.
		'(Мы могли составить эту функцию так, чтобы пустая строка означала отмену вместо вывода отдельного сообщения)
		For i = LBound(strVarsSelected) To UBound(strVarsSelected)
			strTemp = strTemp & strVarsSelected(i) & vbCrLf
		Next
		MsgBox strTemp, vbInformation, "Выбрали переменные"
	Else
		MsgBox "Процедура отменена.", vbExclamation, _
			"Переменные не выбраны"
	End If	
	
End Sub


'мы поместим выбранные переменные в массив, передаваемый как параметр функции
'функция вернёт значение False, если пользователь отменил выбор,
'либо True, если пользователь нажал OK после выбора не менее одной переменной.
Function MultipleVariableSelectionDialog(strVarsSelected() As String) As Boolean
	'мы подключим наши массивы к элементам listbox диалога
	'вообще, функция диалога будет инициализировать массивы, но мы
	'должны подключить к ней именно строковые массивы, иначе возникнет ошибка.
	Dim strVariables() As String
	ReDim strVariables(0)
	
	'реинициализируем массив выбранных переменных чтобы очистить его на всякий случай
	ReDim strVarsSelected(0)
	
	'сделаем "красиво": выведем путь к файлу данных
	Dim strFilePath As String
		
	'путь к файлу
	strFilePath = objSpssApp.Documents.GetDataDoc(0).GetDocumentPath
	'если файл ещё ни разу не сохранялся
	If strFilePath = "" Then
		strFilePath = "(Безымянный)"
	End If
	
	'Определим и вызовем диалог.
	
'Чтобы отредактировать диалоговое окно, поместите курсор между строками
	'Begin Dialog и End Dialog и вызовите Dialog Editor.
	'По умолчанию редактор диалогов создаёт шаблон с именем массива ListArray()
	'в качестве параметра для списка ListBox; мы заменили его на имя нашего массива - strVariables.

	'Чтобы начать редактировать свойства диалога используйте правую кнопку мыши, либо кнопку на панели инструментов.
	'Используйте стрелки << и >> для перемещения между элементами.
	'Зададим имя функции в свойстве Dialog Function,
	'и когда сохраним диалог, нам будет предложено сгенерировать шаблон
	'мониторинговой функции (следящей за диалогом).  См. функцию VarListDialogFunc ниже.
	Begin Dialog UserDialog 490,203,"Выбор нескольких переменных - Демо",.VarListDialogFunc ' %GRID:10,7,1,1
		GroupBox 10,7,470,189,strFilePath,.GroupBox1
		OKButton 340,161,120,21
		PushButton 210,35,90,21,"   Добавить >>",.PushButtonAdd
		CancelButton 220,161,110,21
		PushButton 210,63,90,21,"<< Убрать",.PushButtonRemove
		ListBox 20,21,180,168,strVariables(),.ListBoxVars
		ListBox 300,21,160,133,strVarsSelected(),.ListBoxVarsSelected
	End Dialog

	'Нажатие кнопки Отмена вызовет ошибку, поэтому перед вызовом диалога надо
	'установить метку, чтобы программа перепрыгнула на обработку ошибки.
	On Error GoTo UserCancel
	
	Dim dlg As UserDialog

	'установим выбор по умолчанию на элемент с индексом  0
	dlg.ListBoxVars = 0
	
	'вызов диалога.
	Dialog dlg
	
	'устанавливаем функцию в положение True, что означает, что переменная(ые) была(и) выбрана(ы)
	MultipleVariableSelectionDialog = True	'(strVarsSelected(0) <> "")
		
	Exit Function

'обработка ошибки
UserCancel:
	'в вашем случае вы можете прописать здесь выдачу сообщения пользователю.
	'Здесь мы просто возвращаем пустую строку. Дальнейшие действия программы будут зависеть от
	'того, как устроена процедура, вызвавшая данную функцию.
	Debug.Print "Ошибка " & Err & vbCrLf & Err.Description
	MultipleVariableSelectionDialog = False
End Function


Rem См. подсказку по теме DialogFunc для более подробной информации.
'Функция мониторинга диалога вызывается постоянно, пока отображается диалог.
'Когда эта функция вернёт значение False, окно диалога будет закрыто.
Private Function VarListDialogFunc(DlgItem$, Action%, SuppValue%) As Boolean
	'статичные переменные сохраняют свои значения при повторных вызовах функции
	'мы будем их использовать, чтобы отслеживать, какие переменные были выбраны
	Static strVars() As String
	'Static strVarsSelected() As String
	'индексная переменная цикла
	Dim i As Integer
	
	Select Case Action%
	Case 1 ' Инициализация диалога
		'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)
	Case 2 ' Изменение значения или нажатие кнопки
		If DlgItem$ = "PushButtonAdd" Then
			Call MoveItem(DlgValue("ListBoxVars"), strVars(), strVarsSelected())
			DlgListBoxArray "ListBoxVars", strVars()
			DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
			DlgEnable "OK", True
			VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки
		ElseIf DlgItem$ = "PushButtonRemove" Then
			Call MoveItem(DlgValue("ListBoxVarsSelected"), strVarsSelected(), strVars())			
			DlgListBoxArray "ListBoxVars", strVars()
			DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
			DlgEnable "OK", (strVarsSelected(0) <> "")
			VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки
	'	ElseIf dlgItem$ = "OK" Then
	'		DlgListBoxArray "ListBoxVarsSelected", strVarsSelected()
		End If
		Rem VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки
	Case 3 ' Измненеие текста в элементах TextBox или ComboBox
	Case 4 ' Смена фокуса
	Case 5 ' Ожидание
		DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0)
		DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0)
		VarListDialogFunc = True ' Отображение диалога продолжается - программа ожидает
	End Select
End Function


Sub InitVariables(strVars() As String)	'As Variant
	'список переменных - свойство объекта Info.
	Dim objInfo As ISpssInfo
	'Dim strVars() As String
	'индексная переменная цикла
	Dim i As Integer
	'нам потребуется знать число переменных
	Dim intNumVariables As Integer
	
	Set objInfo = objSpssApp.SpssInfo
	'имена будут помещены в массив с индексами от 0 до .NumVariables - 1
	intNumVariables = objInfo.NumVariables
	
	If intNumVariables > 0 Then
		'расширяем массив до числа переменных
		ReDim strVars(intNumVariables - 1)
		
		'читаем имена переменных в массив
		For i = 0 To intNumVariables - 1
			'если надо, можно работать с метками вместо имён, либо и с теми и с другими
			strVars(i) = objInfo.VariableAt(i)
			'strVars(i) = objInfo.VariableLabelAt(i)
			'strVars(i) = objInfo.VariableAt(i) & ": " & objInfo.VariableLabelAt(i)
		Next 
	Else
		'массив с одной пустой строкой
		ReDim strVars(0)
	End If
	'InitVariables = strVars
End Sub


'вспомогательная процедура, вызываемая при перемещении имён переменных между списками;
'в ней нет процедур контроля данных, т.к. она вызывается лишь из функции диалога
Sub MoveItem(intItem As Integer, strFrom() As String, strTo() As String)
	Dim i As Integer
	Dim intUpper As Integer
	'добавление элемента в массив-приёмщик
	intUpper = UBound(strTo)
	Debug.Print intUpper; intItem; strTo(intUpper)
	'сохраняем уже существующее содержимое массива
	If strTo(intUpper)="" Then intUpper=-1
	ReDim Preserve strTo(intUpper + 1)
	strTo(intUpper + 1) = strFrom(intItem)
	
	'удаление элемента из массива-источника
	intUpper = UBound(strFrom)
	'копируем элементы после выбранного на одну позицию выше
	For i = intItem To intUpper-1
		strFrom(i) = strFrom(i + 1)
	Next
	If intUpper > 0 Then
		'сохраняем всё, кроме последнего элемента
		ReDim Preserve strFrom(intUpper-1)
	Else
		'реинициализируем массив, оставляя в нём одну пустую строчку
		ReDim strFrom(0)
	End If
End Sub