Стандартизация значений по строкам

'Стандартизация значений по строкам
'(другие названия: стандартизация наблюдений, стандартизация переменных по строкам)

'Начало описания
'Скрипт проводит стандартизацию значений по строкам.
'Создаётся диалоговое окно, позволяющее пользователю указать (по крайней мере, три)
'переменных для стандартизации по строкам. Принцип стандартизации: если, например,
'выделено 4 переменных (скажем, ответы на вопросы анкеты), скрипт стандартизирует значение
'каждого ответа на основе среднего значения и стандартного отклонения данного (i-го) наблюдения
'по всем четырём переменным (т.е. score1i = (score1i - СРЕДНЕЕ из (score1i, score2i, score3i, score4i))/СТД ОТКЛ. из (score1i, score2i, score3i, score4i).
'Конец описания
Option Explicit

'Объявление констант уровня скрипта
Const cDLGTITLE As String = "Стандартизация значений по строкам"
Const cOK As String = "Да"
Const cCANCEL As String = "Отмена"
Const cROOTNAME As String = "Начальная часть имени новых переменных:"
Const cSELVARS As String = "Выбранные переменные"
Const cVARROOT As String = "VAR"
Const cROOTMSG As String = "Укажите начальную часть имени новых переменных."
Const cSCRIPTNAME As String = "Стандартизация значений по строкам"
Const cSELMSG As String = "Укажите, по крайней мере, 3 переменные."


Public strNotSelVar() As String
Public strSelVar() As String
Public strListOfVars() As String
Public bolSelected() As Boolean
Public intArrayIndex() As Integer
Public strFilePath As String

Sub Main

	BuildDialog

End Sub

Sub RunJob
'Назначение: запускает синтаксис, который стандартизирует значения по строкам
'Предположения: не заданы
'Результат: создание новых переменных со стандартизированными значениями
'Входные данные: не заданы
'Возвращаемые значения: не заданы

Dim strCmd1 As String
Dim strCmd2 As String
Dim strCmd3 As String
Dim strCmd4 As String
Dim intSelVarIndex As Integer

	strCmd1 = "COMPUTE #MEAN_ = MEAN("
	strCmd2  = "COMPUTE #SD_ = SD("
	For intSelVarIndex = 0 To UBound(strSelVar) 
    	If intSelVarIndex < UBound(strSelVar)  Then
        	strCmd1 = strCmd1 & strSelVar(intSelVarIndex) & ","
        	strCmd2  = strCmd2  & strSelVar(intSelVarIndex) & ","
    	ElseIf intSelVarIndex = UBound(strSelVar)  Then
        	strCmd1 = strCmd1 & strSelVar(intSelVarIndex) & ")."
        	strCmd2  = strCmd2  & strSelVar(intSelVarIndex) & ")."
    	End If
	Next
	
	objSpssApp.ExecuteCommands strCmd1, False
	objSpssApp.ExecuteCommands strCmd2, False
	For intSelVarIndex = 0 To UBound(strSelVar) 
 		strCmd3 = "COMPUTE " & DlgText("txtRootName") & intSelVarIndex+1 & " = (" & strSelVar(intSelVarIndex) & "- #MEAN_) / #SD_."
 		objSpssApp.ExecuteCommands strCmd3, False
	Next

	strCmd4 = "EXECUTE."
	objSpssApp.ExecuteCommands strCmd4, False
    
End Sub

Sub BuildDialog
'Назначение: создаёт и выводит диалог, который позволяет пользователю выбрать переменные,
' по которым будет осуществляться стандартизация
'Предположения: не заданы
'Результат: не задан
'Входные данные: не заданы
'Возвращаемые значения: не заданы

	ReDim strNotSelVar(0) As String
	ReDim strSelVar(0) As String

	Begin Dialog UserDialog 540,203,cDLGTITLE,.DialogMonitor
		ListBox 30,28,140,119,strNotSelVar(),.lstVarInFile
		ListBox 240,28,150,119,strSelVar(),.lstSelVar
		PushButton 430,14,90,21, cOK,.cmdRun
		PushButton 430,42,90,21, cCANCEL,.cmdCancel
		PushButton 190,77,30,21,">",.cmdMoveIt
		TextBox 290,161,100,21,.txtRootName
		Text 100,165,190,14, cROOTNAME,.Field7
		Text 240,14,140,14, cSELVARS,.lbl1
	End Dialog

	Dim dlg As UserDialog

	Dialog dlg
	
End Sub

Function DialogMonitor(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean
'Назначение: Следит за возникающими событиями диалогового окна
'Предположения: не заданы
'Результат: не задан. Следит за событиями диалогового окна и вызывает процедуры-обработчики этих событий
'Входные значения: выбранный элемент управления (strDialogItem), выполненное действие (intAction),
'		 и дополнительное значение, возникающее для некоторых событий элементов управления (intSuppValue)
'Возвращаемые значения: ИСТИНА (TRUE), если диалог остаётся видимым; ЛОЖЬ (FALSE), если должен быть закрыт.

    Select Case intAction
	    Case 1 ' Инициализация диалогового окна
	    	DlgEnable "cmdCancel", True
	    	DlgEnable "cmdRun", True
	    	DlgText "txtRootName",  cVARROOT
	    	GetVarsFromFile		'Процедура, берущая переменную из файла и помещающая её в список в диалоговом окне
	    Case 2 ' Изменилось значение или нажата клавиша
	        Select Case strDialogItem
	        	Case "cmdRun"
	        		If DlgText("txtRootName") = "" Then
						MsgBox cROOTMSG, 48, cSCRIPTNAME
						DialogMonitor = True
					ElseIf UBound(strSelVar) < 2 Then
						MsgBox cSELMSG, 48, cSCRIPTNAME
						DialogMonitor = True
					Else
	        			Call RunJob
	        			DialogMonitor = False
	        		End If
	        	Case "cmdCancel"
	        		DialogMonitor = False
	        	Case "lstVarInFile"
	        		DlgText "cmdMoveIt", ">"
	        		DlgEnable "cmdMoveIt", True
	        		DialogMonitor = True
	        	Case "lstSelVar"
	        		DlgText "cmdMoveIt", "<"
	        		DialogMonitor = True
	        	Case "cmdMoveIt"
	        		If DlgText("cmdMoveIt") = ">" Then 	'добавить переменную в список выбранных переменных
	        			Call AddToSelList
	        		Else								'удалить переменную из списка выбранных переменных
	        			Call RemoveFromSelList
	        		End If
	        		DialogMonitor = True
	        End Select
	End Select
End Function

Sub AddToSelList()
'Назначение: изменяет статус переменной с не выбранной на выбранную
'Предположения: не заданы
'Результат: изменяет соответствующую запись в массиве bolSelected с ЛЖИ (FALSE) на ИСТИНУ (TRUE)
'Входные значения: не заданы
'Возвращаемые значения: не заданы

	Dim intSelIndex As Integer
	Dim i As Integer
	
	intSelIndex = DlgValue("lstVarInFile")
	'пробегаем по массиву intArrayIndex; если обнаруживаем, что переменная была выбрана,
	'изменяем её запись в массиве bolSelected на ИСТИНУ (TRUE)
	For i = 0 To UBound(intArrayIndex)
		If (intArrayIndex(i) = intSelIndex) And (bolSelected(i) = False) Then
			bolSelected(i) = True
			Exit For
		End If
	Next i
	Call PopulateLists	'Обновляет списки доступных и выбранных переменных в диалоговом окне

End Sub

Sub RemoveFromSelList()
'Назначение: изменяет статус переменной с выбранной на не выбранную
'Предположения: не заданы
'Результат: изменяет соответствующую запись в массиве bolSelected с ИСТИНЫ (TRUE) на ЛОЖЬ (FALSE)
'Входные значения: не заданы
'Возвращаемые значения: не заданы

	Dim intSelIndex As Integer
	Dim i As Integer
	
	intSelIndex = DlgValue("lstSelVar")
	'пробегаем по массиву intArrayIndex; если обнаруживаем, что переменная была удалена из списка выбранных,
	' изменяем её запись в массиве bolSelected на ЛОЖЬ (FALSE)
	For i = 0 To UBound(intArrayIndex)
		If (intArrayIndex(i) = intSelIndex) And (bolSelected(i) = True) Then
			bolSelected(i) = False
			Exit For
		End If
	Next i
	Call PopulateLists

End Sub

Sub PopulateLists()
'Назначение: пробегает по всем переменным и помещает выбранные в массив strSelVar,
'		  а не выбранные - в массив strNotSelVar.
'Предположения: не заданы
'Результат: переменные массива strSelVar появляются в списке выбранных переменных, а переменные массива strNotSelVar -
'		  в списке не выбранных
'Входные значения: не заданы
'Возвращаемые значения: не заданы

	Dim i As Integer
	Dim intNumNotSel As Integer
	Dim intNumSel As Integer
	
	intNumSel = 0
	intNumNotSel = 0
	ReDim strNotSelVar(intNumNotSel) As String
	ReDim strSelVar(intNumSel) As String
	
	'пробегаем по переменным, чтобы положить каждую в соответствующий массив в зависимости
	' от того, выбрана она или нет
	For i = 0 To UBound(bolSelected)
		If bolSelected(i) = False Then
			ReDim Preserve strNotSelVar(intNumNotSel) As String
			strNotSelVar(intNumNotSel) = strListOfVars(i)
			intArrayIndex(i) = intNumNotSel
			intNumNotSel = intNumNotSel + 1
		Else	'Переменная выбрана для анализа
			ReDim Preserve strSelVar(intNumSel) As String
			strSelVar(intNumSel) = strListOfVars(i)
			intArrayIndex(i) = intNumSel
			intNumSel = intNumSel + 1
		End If
	Next i
	
	'назначаем массивы соответствующим спискам (выбранных и не выбранных переменных).
	DlgListBoxArray "lstVarInFile", strNotSelVar()
	DlgListBoxArray "lstSelVar", strSelVar()

End Sub

Sub GetVarsFromFile()
'Назначение: импортирует имена переменных из открытого файла SPSS
'Предположения: файл данных открыт
'Результат: помещает имя переменной в список в диалоговом окне
'Входные значения: не заданы
'Возвращаемые значения: не заданы

	Dim objSPSSInfo As ISpssInfo
	Dim i As Long
	
	Set objSPSSInfo = objSpssApp.SpssInfo

	ReDim strListOfVars(objSPSSInfo.NumVariables - 1) As String
	ReDim bolSelected(objSPSSInfo.NumVariables - 1) As Boolean
	ReDim intArrayIndex(objSPSSInfo.NumVariables - 1) As Integer

	
	For i = 0 To UBound(bolSelected)
		strListOfVars(i) = objSPSSInfo.VariableAt(i)	
		bolSelected(i) = False		'Если значение = ложь (false), переменная в данный момент не выбрана
		intArrayIndex(i) = i		'определяет место переменной в списке
	Next i
	
	DlgEnable "lstVarInFile", True
	DlgEnable "lstSelVar", True
	Call PopulateLists

End Sub