Работа со списком переменных (3)

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

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

'демонстрирует использование функции MultipleVariableSelectionDialog
Sub Main
	
	'будем вызывать функцию, которая вернёт выбранные переменные из того массива, который мы передадим ей.
	Dim strVarsSelected() As String
	'индексная переменная цикла
	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 = "(Untitled)"
	End If
	
'Чтобы отредактировать диалоговое окно, поместите курсор между строками
	'Begin Dialog и End Dialog и вызовите Dialog Editor.
	'По умолчанию редактор диалогов создаёт шаблон с именем массива ListArray()
	'в качестве параметра для списка ListBox; мы заменили его на имя нашего массива - strVariables.

	'Чтобы начать редактировать свойства диалога используйте правую кнопку мыши, либо кнопку на панели инструментов.
	'Используйте стрелки << и >> для перемещения между элементами.
	'Зададим имя функции в свойстве Dialog Function,
	'и когда сохраним диалог, нам будет предложено сгенерировать шаблон
	'мониторинговой функции (следящей за диалогом).  См. функцию VarListDialogFunc ниже.
	Begin Dialog UserDialog 490,203,"Выбор нескольких переменных - Демо",.VarListDialogFunc
		GroupBox 10,7,470,189,strFilePath,.GroupBox1
		OKButton 340,161,120,21
		CancelButton 220,161,110,21
		PushButton 210,35,90,21,"   Выбрать   >> ",.PushButtonAdd
		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

	'вызов диалога.
	Dialog dlg
	
	'мы использовали вспомогательную функцию при работе диалога чтобы сохранять
	'имена переменных. Запросим их теперь.
	strVarsSelected() = SelectedVariableArray("", False)
	
	'возвращаем true, т.к. пользователь нажал OK
	MultipleVariableSelectionDialog = True
		
	Exit Function

'обработка ошибки
UserCancel:
	'в вашем случае вы можете прописать здесь выдачу сообщения пользователю.
	'Здесь мы просто возвращаем пустую строку. Дальнейшие действия программы будут зависеть от
	'того, как устроена процедура, вызвавшая данную функцию.
	Debug.Print "Error" & Err & vbCrLf & Err.Description
	ReDim strVarsSelected(0)
	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 ' Инициализация диалога
		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)
	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
			'сохраняем массив, игнорируем результат функции
			Call SelectedVariableArray(strVarsSelected(), True)
		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

'вспомогательная процедура, вызываемая при перемещении имён переменных между списками;
'в ней нет процедур контроля данных, т.к. она вызывается лишь из функции диалога. Параметр
'intItem будет в пределах размера массива.
Sub MoveItem(intItem As Integer, strFrom() As String, strTo() As String)
	Dim i As Integer
	Dim intUpper As Integer

	'добавление элемента в массив-приёмщик
	intUpper = UBound(strTo)
	Debug.Print strTo(intUpper); intUpper; intItem
	'расширяем массив, но сохраняем уже имеющееся содержимое
	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


'Это дешёвая уловка позволяет избежать использования глобальной переменной для
'извлечения списка переменных из функции мониторинга диалога.
'Функция сохраняет значение своего параметра когда вызвана с параметром blnStore=True и
'возвращает то, что было сохранено ранее как свой результат.
'Это упрощает встраивание данного кода в вашу программу, т.к. не требуется добавлять глобальную переменную
'в ваш проект чтобы данный диалог работал.

Function SelectedVariableArray(vntStore As Variant, blnStore As Boolean) As Variant
	Static vntStored As Variant
	
	SelectedVariableArray = vntStored
	
	'принимаем на хранение только массивы со строками
	If blnStore Then
		If IsArray(vntStore) Then
			If VarType(vntStore(0)) = vbString Then
				vntStored = vntStore
			End If
		End If
	End If
End Function