Генерация и подгонка распределений случайных величин

'DISTRIBUTION.SBS
'Автор:   Terry.Taerum@ualberta.ca

'Генерация случайных выборок из распределений (с возможностью задания подгрупп)
'Оценка (подгонка) распределений случайных величин по выборке (с возможностью задания подгрупп)*
'*Оценка распределений требует установки модуля SPSS Regression Models.
'Перевод: А.Балабанов, 17.12.2008, www.spsstools.ru

' Перед использованием этого скрипта имеет смысл ознакомиться с процедурой нелинейной регрессии с ограничениями
' (CNLR) модуля Regression Models, а также (естественно) с характером и параметрами распределений, которые вас
' интересуют, и со спецификацией генератора случайных величин из этих распределений (функция RV), обратных,
' кумулятивных и нецентральных кумулятивных функций распределений (функции IDF, CDF и NCDF), например, в справке
' из меню Transform -> Compute - примеч. перев.

' Для подгонки параметров (оценки формы распределений) используется команда CNLR, которая для каждого параметра
' распределения допускает указание нижней и верхней границ области поиска, а также начального значения параметров
' при первой итерации метода (всё это находится в диалоговом окне скрипта).
' Можно указывать несколько уравнений подгонки, для каждой группы уравнения будут подгоняться со своими параметрами.
' Для большинства распределений подгонка возможна  на основе обратной функции
' распределения (предсказываем значение случайной величины на основе накопленной вероятности), на основе
' кумулятивной функции распределения (предсказываем накопленную вероятность на основе значения случайной величины),
' а для некоторых функций и на основе нецентральной кумулятивной функции распределения (добавляется параметр нецентральности).
' Для распределения Пуассона подгонка возможна лишь на основе кумулятивной функции распределения.

' Для каждого распределения и используемой функции автор сообщает прогноз достигаемого качества подгонки с помощью CNLR
' (сходимость отличная, хорошая, либо плохая), вероятно, на основе собственного опыта оценки распределений - примеч. перев.

' Следует помнить, что во всех функциях, кроме аргументов, специфичных для конкретного распределения,
' автор предусмотрел ещё и параметры линейного преобразования случайной величины:
' a - сдвига, и b - сжатия/растяжения - примеч. перев.

Option Explicit

Public strNotSelVar() As String
Public strSelVar() As String
Public strGroupVar() As String
Public strShape() As String
Public intSelection() As Integer
Public intArrayIndex() As Integer
Public intLenVariable() As Integer

Public VarNames() As String
Public DataFileName As String
Public qRunJob As Integer
Public iDist As Integer , iDistx As Integer
Public iRandom As Integer
Public intButton As Integer
Public DistType() As String
Public Param() As Double
Public loParam() As Double
Public hiParam() As Double

Public iDistrx() As Integer
Public iEqualx() As Integer
Public iXDFx() As Integer

Public strDist() As String 'Имена распределений в SPPS, которые используются непосредственно в синтаксисах
Public strDistRus() As String 'Копия strDist для отображения имён распределений в русифицированных диалогах
Public nDist As Integer
Public nVars As Long
Public nCases As Long
Public nGroups As Long

' Тип myVarList - тип-контейнер для управления списками переменных. varNum - порядковый номер переменных (считается только тип Numeric,
'  строковые отбрасываются), varSel - признак выбора переменной (0-не выбрана, 1 - выбрана для анализа, 2 - выбрана как группирующая),
'  varLst - позиция переменной в соответствующем списке (невыбранных, отобранных, группирующих) - модиф. перев.
Type myVarList
	varNum () As Integer
	varSel () As Byte
	varLst () As Integer
End Type
Public VarList As myVarList
Public Quanta As Double, Quantb As Double
' Так как одна из целей скрипта - дать возможность генерировать случайные величины, имеющие распределения,
' по форме соотетствующие некоторым известным распределениям, но не все стандартные распределения имеют параметры,
' явно управляющие положением и масштабом значений случайной величины, для таких распределений автор предусмотрел
' два дополнительных параметра a и b (Quanta и Quantb). Здесь a - аддитивная константа, b - множитель.
' Варьируя эти параметры, пользователь может "смещать" выборки случайных величин по числовой оси, а также
' "растягивать/сжимать" график плотности распределения случайной величины - примеч. перев.

Public Shape1 As Double
Public Shape2 As Double
Public Shape3 As Double
Public Shape4 As Double

Public strGroup As String
Public strFocus As String
Public strVariable As String

Public intNumSel As Integer
Public intNumGrp As Integer
Public intNumNotSel As Integer
Public Instruction As Integer
Public iXDF As Integer
Public nXDF As Integer
Public strXDF() As String
Public iProgram As Integer

Public loQuanta As Double, hiQuanta As Double
Public loQuantb As Double, hiQuantb As Double
Public loShape1 As Double, hiShape1 As Double
Public loShape2 As Double, hiShape2 As Double
Public loShape3 As Double, hiShape3 As Double
Public qFileVisible As Integer, qEditMode As Integer
Public qRelation As Integer

Public nCase() As Long
Public iRandomx() As Integer
Public xShape1() As Single, xShape2() As Single
Public strForm As String

Public iDistAnalyze As Integer
Public strDistUse() As String
Public nDistList As Integer
Public qModify As Integer

Sub Main
	Call LoadDist()
	Dim objDataDoc As ISpssDataDoc
	Dim objDocuments As ISpssDocuments
	Dim iCount As Integer, iCountx As Integer
	qRunJob=0
	For iCount=0 To 1000
		Call DialogGetProgram()
		If (qRunJob=0) Then Exit For
		Select Case qRunJob
			Case 1
				For iCountx=0 To 1000
					Call DialogGetRandomInfo()
					If (qRunJob=0) Then Exit For
					If (qRunJob=1) Then Call CreateDataFile()
					Exit For
				Next iCountx
				If (qRunJob=0) Then Exit For
			Case 2
				For iCountx=0 To 1000
					Call DialogGetFileInfo()
					If (qRunJob=0) Then Exit For
					If (qRunJob=1) Then
						Call DialogGetDistInfo()
						If (qRunJob=0) Then Exit For
						If (qRunJob=1) Then
							Call CreateSyntaxFile()
							Set objDocuments = objSpssApp.Documents
							Set objDataDoc = objSpssApp.OpenDataDoc(DataFileName)
						End If
					End If
					If (qRunJob=1 Or qRunJob=-1) Then Exit For
				Next iCountx
				If (qRunJob=0) Then Exit For
			Case 3
		End Select
	Next iCount
End Sub


Sub AddToSelList()
	Dim intSelIndex As Integer
	Dim i As Integer
	intSelIndex = DlgValue("lstVarInFile")
	For i = 0 To UBound(VarList.varLst)
		If (VarList.varLst(i) = intSelIndex) And (VarList.varSel(i) = 0) Then
			VarList.varSel(i) = intButton
			Exit For
		End If
	Next i
	Call PopulateLists
End Sub

Sub RemoveFromSelList()
	Dim intSelIndex As Integer
	Dim i As Integer
	If (intButton=1) Then intSelIndex = DlgValue("lstSelVar")
	If (intButton=2) Then intSelIndex = DlgValue("lstGroupVar")
	For i = 0 To UBound(VarList.varLst)
		If (VarList.varLst(i) = intSelIndex) And (VarList.varSel(i)=intButton) Then
			VarList.varSel(i) = 0
			Exit For
		End If
	Next i
	Call PopulateLists
End Sub

Sub PopulateLists()
	Dim i As Integer
	intNumSel = 0
	intNumNotSel = 0
	intNumGrp=0
	ReDim strNotSelVar(intNumNotSel) As String
	ReDim strSelVar(intNumSel) As String
	ReDim strGroupVar(intNumGrp) As String
	intNumSel = 0
	intNumNotSel = 0
	intNumGrp=0
	For i = 0 To UBound(VarList.varNum)
		If VarList.varSel(i) = 0 Then
			ReDim Preserve strNotSelVar(intNumNotSel) As String
			strNotSelVar(intNumNotSel) = VarNames(i)
			VarList.varLst(i) = intNumNotSel
			intNumNotSel = intNumNotSel + 1
		ElseIf VarList.varSel(i) = 1 Then 	'Переменная выбрана для анализа
			ReDim Preserve strSelVar(intNumSel) As String
			strSelVar(intNumSel) = VarNames(i)
			VarList.varLst(i) = intNumSel
			intNumSel = intNumSel + 1
		ElseIf VarList.varSel(i) = 2 Then	'Переменная выбрана в качестве группирующей
			ReDim Preserve strGroupVar(intNumGrp) As String
			strGroupVar(intNumGrp) = VarNames(i)
			VarList.varLst(i) = intNumGrp
			intNumGrp = intNumGrp + 1
		End If
	Next i
	DlgListBoxArray "lstVarInFile", strNotSelVar()
	DlgListBoxArray "lstSelVar", strSelVar()
	DlgListBoxArray "lstGroupVar",strGroupVar()
End Sub


Sub GetVarsFromFile()
	If (qRunJob>=0) Then
		Dim objSPSSInfo As ISpssInfo
		Dim i As Long
		Set objSPSSInfo = objSpssApp.SpssInfo
		Dim nVarsx As Long
		nVarsx=0
		For i = 0 To nVars-1
			If (objSPSSInfo.VarType(i)=0) Then
				nVarsx=nVarsx+1
				ReDim Preserve VarNames(nVarsx-1) As String
				ReDim Preserve VarList.varNum(nVarsx-1)
				ReDim Preserve VarList.varSel(nVarsx-1)
				ReDim Preserve VarList.varLst(nVarsx-1)
				VarList.varnum(nVarsx-1)=nVars-1
				VarList.varsel(nVarsx-1)=0
				VarList.varLst(nVarsx-1)=i
				VarNames(nVarsx-1) = objSPSSInfo.VariableAt(i)
			End If
		Next i
		DlgEnable "lstVarInFile", True
		DlgEnable "lstSelVar", True
		DlgEnable "lstGroupVar",True
	End If
	Call PopulateLists
End Sub

Sub SelectiDist()
	Dim iValue As Integer
	    			If (qRelation<>1) Then DlgText "txtShape1","b2: "+strShape(iDist,0)
	    			If (qRelation=1) Then DlgText "txtShape1","b2: range"
	    			If (qRelation=0 Or qRelation=1) Then DlgText "txtShape2","b3: "+strShape(iDist,1)
	    			If (qRelation=2) Then DlgText "txtShape2","b3: b2"
	    			If (qRelation=3) Then DlgText "txtShape2","b3: range"
	    			Dim strPerform As String
	    			DlgVisible "txtPerform",True
	    			If (iXDF=1) Then strPerform="Сходимость:  отличная"
	    			If (iXDF=2) Then
	    				If (Mid(DistType(iDist),7,1)="1") Then
	    					strPerform="Сходимость:  хорошая"
	    				Else
	    					strPerform="Сходимость:  плохая"
	    				End If
	    			End If
	    			If (iXDF=3) Then strPerform="Сходимость: хорошая"
	    			DlgText "txtPerform",strPerform
					loShape1=xShape1(iDist,0)
					Shape1=xShape1(iDist,1)
					hiShape1=xShape1(iDist,2)
					loShape2=xShape2(iDist,0)
					Shape2=xShape2(iDist,1)
					hiShape2=xShape2(iDist,2)
		    			iValue=0
		    			Shape3=1.0
	    				loShape3=0.25
	    				hiShape3=200.0
					If (iXDF=3) Then iValue=1
					DlgVisible "Shape3",iValue
					DlgVisible "loShape3",iValue
					DlgVisible "hiShape3",iValue
					DlgVisible "txtShape3",iValue
					Dim strRelation As String
					strRelation=""
					If (Mid(DistType(iDist),4,1)<>"0") Then
						strRelation="Отношение "+strShape(iDist,0)+" и "+strShape(iDist,1)
					Else
						DlgVisible "grpboxRelation",False
						DlgVisible "optFree",False
					End If
					DlgText "grpboxRelation",strRelation
			    	Select Case iDist
			    		Case 00 '<выбор>
			    			iXDF=0
						DlgEnable"cmdNext",False
						DlgVisible "txtInitial",False
						DlgVisible "txtLower",False
						DlgVisible "txtUpper",False
						DlgVisible "txtForm",False
						DlgVisible "txtPerform",False
						DlgVisible "grpboxDist",False
						DlgVisible "grpboxRelation",False
						DlgVisible "cmdAdd",False
						DlgVisible "optFree",False
						DlgText "txtForm",""
						iValue=0
						DlgVisible "Shape3",iValue
						DlgVisible "loShape3",iValue
						DlgVisible "hiShape3",iValue
						DlgVisible "txtShape3",iValue
						DlgVisible "lstDistAnalyze",False
			    		Case 01 'Beta
			    			DlgText "txtShape3","b5: ncBeta"
			    		Case 03 'ChiSq
			    			DlgText "txtShape3","b5: ncChiSq"
			    		Case 05 'f
			    			DlgText "txtShape3","b5: ncF"
			    		Case 13 't
			    			DlgText "txtShape3","b5: ncT"
			    		Case 14 'uniform
			    			qRelation=3
			    			DlgValue "grpRelation",qRelation
						DlgVisible "optFree",False
						DlgVisible "optLT",False
						DlgVisible "optEQ",False
			    	End Select
End Sub

Sub RemoveOld()
	Dim intSelIndex As Integer
	Dim i As Integer
	intSelIndex=0
	For i = 0 To UBound(intArrayIndex)
		If (intArrayIndex(i) = intSelIndex) And (intSelection(i)=intButton) Then
			intSelection(i) = 0
			Exit For
		End If
	Next i
End Sub

Sub TestIfFileVisible(qInitialize As Integer)
	Dim objDataDoc As ISpssDataDoc
	Dim objDocuments As ISpssDocuments
	Set objDocuments = objSpssApp.Documents
	If (qInitialize) Then
		Set objDataDoc = objSpssApp.OpenDataDoc(DataFileName)
	Else
		Set objDataDoc = objDocuments.GetDataDoc(0)
		DataFileName=objDataDoc.GetDocumentPath
		If (Right(DataFileName,8)="Untitled") Then DataFileName=""
	End If
	nVars=objDataDoc.GetNumberOfVariables
	nCases=objDataDoc.GetNumberOfCases
	If (nVars=0) Then DataFileName=""
   	qFileVisible=0
   	If (nVars>0) Then qFileVisible=1
	DlgVisible "lstVarInFile",qFileVisible
	DlgVisible "cmdGetVariable",qFileVisible
	DlgVisible "lbl2",qFileVisible
	DlgVisible "lbl1",qFileVisible
	DlgVisible "cmdGetGroup",qFileVisible
	DlgVisible "lstSelVar",qFileVisible
	DlgVisible "lstGroupVar",qFileVisible
	If (nVars>0) Then
		DlgFocus "lstVarInFile"
	    	Call GetVarsFromFile()
	    	DlgEnable "cmdNext", True
	Else
		DlgFocus "cmdBrowse"
	    	DlgEnable "cmdNext", False
	End If
End Sub

Function DialogFileInfo(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean
    Select Case intAction
	    Case 1 ' Инициализация диалогового окна
	    	DlgEnable "cmdCancel", True
	    	DlgEnable "cmdNext", False
	    	DlgEnable "DataFileName",False
		Call TestIfFileVisible(0)
	    	DlgText "DataFileName",DataFileName
    		Call GetVarsFromFile()
    		DlgEnable "cmdNext",False
    		If (intNumSel>0) Then DlgEnable "cmdNext",True
	    Case 2 ' Изменено значение или нажата кнопка
	        Select Case strDialogItem
	        	Case "cmdBack"
	        		DialogFileInfo=False
	        		qRunJob=-1
	        	Case "cmdNext"
	    			DialogFileInfo = False
        			qRunJob=1
        			If (nVars=0) Then
 					MsgBox("Вам надо указать имя файла SPSS.",vbOK)
 					DialogFileInfo=True
        			End If
        			If (intNumSel>0) Then strVariable=strSelVar(0)
        			If (intNumGrp>0) Then strGroup=strGroupVar(0)
	        	Case "cmdCancel"
	        		DialogFileInfo = False
	        		qRunJob=0
	        	Case "lstVarInFile"
	        		DlgText "cmdGetVariable", ">Переменная>"
	        		DlgEnable "cmdGetVariable", True
	        		DlgText "cmdGetGroup", ">Группа>"
	        		DlgEnable "cmdGetGroup", True
	        		DialogFileInfo = True
	        	Case "lstGroupVar"
	        		DlgText "cmdGetGroup","<Группа<"
	        		DialogFileInfo=True
	        	Case "lstSelVar"
	        		DlgText "cmdGetVariable", "<Переменная<"
	        		DialogFileInfo = True
	        	Case "cmdBrowse"
	        		ReDim strNotSelVar(0) As String
	        		ReDim strSelVar(0) As String
	        		ReDim strGroupVar(0) As String
				DlgListBoxArray "lstVarInFile", strNotSelVar()
				DlgListBoxArray "lstSelVar", strSelVar()
				DlgListBoxArray "lstGroupVar",strGroupVar()
				Dim DataFileNameHold As String
				DataFileNameHold=GetFilePath$(,"sav",,"Файл данных SPSS:",0)
				If (DataFileNameHold<>"") Then
					DataFileName=DataFileNameHold
				    	DlgText "DataFileName", DataFileName
				End If
				If (DataFileName<>"") Then Call TestIfFileVisible(1)
	        		DialogFileInfo=True
	        	Case "cmdGetVariable"
	        		intButton=1
	        		If DlgText("cmdGetVariable") = ">Переменная>" Then
	        			If (intNumSel>0) Then Call RemoveOld()
	        			Call AddToSelList()
	        			DlgEnable "cmdNext",True
	        		Else
	        			Call RemoveFromSelList
	        			DlgEnable "cmdNext",False
	        		End If
	        		DialogFileInfo = True
	        	Case "cmdGetGroup"
	        		intButton=2
	        		If DlgText("cmdGetGroup") = ">Группа>" Then
	        			If (intNumGrp>0) Then Call RemoveOld()
	        			Call AddToSelList()
	        		Else
	        			Call RemoveFromSelList()
	        		End If
	        		DialogFileInfo = True
	        End Select
	End Select
End Function

Sub DialogGetFileInfo
	ReDim strNotSelVar(0) As String
	ReDim strSelVar(0) As String
	ReDim strGroupVar(0) As String
	Begin Dialog UserDialog 600,182,"Выберите переменные для анализа распределений",.DialogFileInfo ' %GRID:10,7,1,1
		PushButton 500,21,80,21,"Выбрать...",.cmdBrowse
		PushButton 500,49,80,21,"Назад...",.cmdBack
		PushButton 500,77,80,21,"Дальше...",.cmdNext
		PushButton 500,105,80,21,"Отмена",.cmdCancel
		TextBox 100,21,320,21,.DataFileName
		ListBox 30,77,140,98,strNotSelVar(),.lstVarInFile
		ListBox 320,77,150,35,strSelVar(),.lstSelVar
		PushButton 180,77,120,21,">Переменная>",.cmdGetVariable
		Text 30,56,140,14,"Переменные:",.lbl2
		Text 320,56,140,14,"Выбрано:",.lbl1
		PushButton 180,126,120,21,">Группа>",.cmdGetGroup
		ListBox 320,126,150,28,strGroupVar(),.lstGroupVar
		Text 30,21,70,14,"Файл данных",.Text1
	End Dialog
	Dim dlg As UserDialog
	Dialog dlg
End Sub


Sub ResetEditMode(iReset As Integer)
	If (iReset=0) Then
		DlgVisible "grpboxEdit",False
		DlgEnable "cmdNext",True
		DlgEnable "cmdCancel",True
		qEditMode=0
		DlgText "cmdBack","Назад..."
	ElseIf (iReset=1) Then
		DlgVisible "grpboxEdit",True
		DlgEnable "cmdNext",False
		DlgEnable "cmdCancel",False
		DlgText "cmdBack","Выйти из ред."
	End If
End Sub

Sub DialogGetRandomInfo
	Begin Dialog UserDialog 700,287,"Генерация случайных переменных",.DialogRandomInfo ' %GRID:10,7,1,1
		PushButton 350,60,80,40,"Дальше",.cmdNext
		Text 220,147,460,14,"",.txtForm
		PushButton 600,7,90,21,"Завершить",.cmdFinish
		PushButton 600,35,90,21,"Назад...",.cmdBack
		PushButton 600,63,90,21,"Отмена",.cmdCancel
		TextBox 20,2,100,21,.txtboxNGroups
		Text 20,28,460,14,"1. Введите число наблюдений в группе и нажмите 'Дальше'",.txt2
		TextBox 20,56,340,0,.line2
		TextBox 520,30,41,21,.txtboxNCases
		Text 20,56,310,14,"2. Выберите распределение для группы: ",.txt3
		TextBox 20,49,200,0,.line3
		ListBox 50,84,150,77,strDistRus(),.lstRandom
		Text 20,168,480,14,"3. Измените параметры и нажмите 'Дальше' когда будете готовы",.txt4
		TextBox 20,185,380,2,.line4
		GroupBox 10,182,490,77,"Режим редактирования",.grpboxEdit
		Text 50,196,70,14,"a",.txtQuanta
		Text 140,196,70,14,"b",.txtQuantb
		Text 240,196,70,14,"Распр.",.lstRandomText
		Text 320,196,80,14,"s1",.txtShape1
		Text 410,196,80,14,"s2",.txtShape2
		TextBox 40,217,70,21,.Quanta
		TextBox 410,217,70,21,.Shape2
		TextBox 130,217,70,21,.Quantb
		TextBox 220,217,100,21,.boxRandom
		TextBox 330,217,70,21,.Shape1
		Text 20,270,510,14,"4. Нажмите 'Дальше' для добавления новой группы или 'Завершить'",.txt5
		TextBox 20,246,350,2,.line5
		GroupBox 500,14,72,45,"Число",.grpboxNCases
	End Dialog
	Dim dlg As UserDialog
	Dialog dlg
End Sub

Sub SelectiRandom()
	Dim iValue As Integer
	    		DlgText "txtShape1",strShape(iRandom,0)
	    		DlgText "txtShape2",strShape(iRandom,1)
	    		DlgVisible "Quanta",True
	    		DlgVisible "Quantb",True
	    		DlgVisible "Shape1",False
	    		DlgVisible "Shape2",False
				DlgVisible "txtQuanta",True
				DlgVisible "txtQuantb",True
				DlgVisible "lstRandomText",True
				DlgVisible "txtShape1",False
				DlgVisible "txtShape2",False
				DlgVisible "boxRandom",True
				DlgEnable "txt4",True
				DlgVisible "line4",True
				DlgEnable "cmdNext",True
				Quanta=10
				Quantb=50
				strForm=""
				If (Mid(DistType(iRandom),10,1)="0") Then
					DlgVisible "Quanta",False
					DlgVisible "Quantb",False
					DlgVisible "txtQuanta",False
					DlgVisible "txtQuantb",False
				Else
					strForm=strForm+"a+b*"
				End If
					strForm=strForm+"rv."+strDist(iRandom)+"("
				If (Mid(DistType(iRandom),11,1)="1") Then
	      	  		strForm=strForm+strShape(iRandom,0)+")"
					Call TurnOnFormula(1,1)
				End If
				If (Mid(DistType(iRandom),11,1)="2") Then
					If (strDist(iRandom)="Uniform") Then
	      	  			strForm=strForm+strShape(iRandom,0)+","+strShape(iRandom,0)+"+"+strShape(iRandom,1)+")"
	      	  		Else
	      	  			strForm=strForm+strShape(iRandom,0)+","+strShape(iRandom,1)+")"
	      	  		End If
					Call TurnOnFormula(2,1)
				End If
				If (Mid(DistType(iRandom),11,1)="0") Then
					strForm=""
					Call TurnOnFormula(2,0)
				End If
				Shape1=xShape1(iRandom,1)
				Shape2=xShape2(iRandom,1)
			    	Select Case iRandom
			    		Case 00 '<выбор распределения>
						DlgEnable"cmdFinish",False
						DlgEnable "txt4",False
			    	End Select
End Sub

Function DialogRandomInfo(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean
    Select Case intAction
	    Case 1 ' Инициализация диалогового окна
				DlgEnable "txtboxNGroups",False
			    DlgVisible "grpboxEdit", False
	    		DlgVisible "Quanta",False
	    		DlgVisible "Quantb",False
	    		DlgVisible "Shape1",False
	    		DlgVisible "Shape2",False
				DlgVisible "txtQuanta",False
				DlgVisible "txtQuantb",False
				DlgVisible "txtShape1",False
				DlgVisible "txtShape2",False
				DlgVisible "lstRandomText",False
				DlgVisible "boxRandom",False
				DlgEnable "boxRandom",False
				DlgVisible "txtForm",False
				nGroups=0
				DlgEnable "lstRandom",False
				DlgEnable "cmdFinish",False
				DlgEnable "txt2",True
				DlgEnable "txt3",False
				DlgEnable "txt4",False
				DlgEnable "txt5",False
				DlgVisible "line2",False
				DlgVisible "line3",False
				DlgVisible "line4",False
				DlgVisible "line5",False
				DlgEnable "txtboxNCases",False
				Call exInstruction1()
				nCases=0
				DlgEnable "grpboxNCases",True
				DlgVisible "grpboxNCases",True
				Wait .001  ' задержка требуется для синхронизации
		Case 2 ' Обработка действий пользователя
	If (qEditMode>0) Then Call DialogEditRandom(strDialogItem,intAction,intSuppValue)
	        Select Case strDialogItem
	        	Case "cmdFinish"
	        		DialogRandomInfo=False
	        		qRunJob=1
	        	Case "cmdCancel"
	        		DialogRandomInfo=False
	        		qRunJob=0
	        	Case "cmdBack"
	        		DialogRandomInfo=False
	        		qRunJob=-1
	        	Case "cmdNext"
	        		DialogRandomInfo=True
				If (Instruction=1) Then
					Call exInstruction1()
	      	  	ElseIf (Instruction=2) Then
	      	  		nCases=Val(DlgText("txtboxNCases"))
	      	  		If (nCases>=10 And nCases<=10000) Then
	      	  			DlgEnable "txt2",False
	      	  			DlgEnable "txt3",True
	      	  			DlgVisible "line2",False
	      	  			DlgVisible "line3",True
	      	  			Instruction=3
						DlgEnable "txtboxNCases",False
						DlgEnable "lstRandom",True
						DlgEnable "txtForm",True
						DlgVisible "txtForm",True
						DlgEnable "lstRandomText",True
	      	  		Else
 						MsgBox("Число наблюдений должно быть от 10 до 10000.",vbOK)
						DlgFocus "txtboxNCases"
	      	  		End If
	      	  	ElseIf (Instruction=3) Then
	      	  		If (iRandom>0 And (Mid(DistType(iRandom),10,1)<>"0" Or Mid(DistType(iRandom),11,1)<>"0")) Then
		      	  		DlgEnable "txt3",False
		      	  		DlgEnable "txt4",False
	      		  		DlgEnable "txt5",True
	      		  		DlgVisible "line3",False
	      		  		DlgVisible "line4",False
	      		  		DlgVisible "line5",True
	      		  		DlgEnable "cmdFinish",True
	      	  			Instruction=5
						DlgEnable "lstRandom",False
						DlgEnable "txtForm",False
		      	  		DlgEnable "Quanta",False
		      	  		DlgEnable "Quantb",False
	      		  		DlgEnable "shape1",False
	      		  		DlgEnable "shape2",False
						DlgEnable "lstRandomText",False
		      	  		DlgEnable "txtQuanta",False
		      	  		DlgEnable "txtQuantb",False
	      		  		DlgEnable "txtshape1",False
	      		  		DlgEnable "txtshape2",False
	      		  		Dim iGroup As Integer
	      		  		iGroup=nGroups-1
	      		  		ReDim Preserve nCase(nGroups)
						nCase(iGroup)=nCases
						ReDim Preserve iRandomx(nGroups)
						iRandomx(iGroup)=iRandom
						ReDim Preserve Param(4,nGroups)
						Param(0,iGroup)=Quanta
						Param(1,iGroup)=Quantb
						Param(2,iGroup)=Shape1
						Param(3,iGroup)=Shape2
	      	  		Else
 						MsgBox("Нужно выбрать одно из представленных распределений.",vbOK)
						DlgFocus "lstRandom"
	      	  		End If
	      	  	ElseIf (Instruction=5) Then
	      	  		Call exInstruction1()
	      	  	End If
	        	Case "lstRandom"
	        		DlgEnable "txt4",True
	        		DlgVisible "line4",True
	        		iRandom=DlgValue("lstRandom")
				Call SelectiRandom()
				DlgText "txtForm","Формула: " + strForm
				DlgText	"Quanta",Format(Quanta,"####0.######")
				DlgText "Quantb",Format(Quantb,"####0.######")
				DlgText "boxRandom",strDistRus(iRandom)
				DlgText "Shape1",Format(Shape1,"####0.######")
				DlgText "Shape2",Format(Shape2,"####0.######")
		End Select
	    Case 4 ' получение фокуса
	If (qEditMode>0) Then Call DialogEditRandom(strDialogItem,intAction,intSuppValue)
	    	Select Case strDialogItem
	    		Case "txtboxNCases"
	    			qEditMode=1
	    		Case "Quanta","Quantb","Shape1","Shape2"
	    			qEditMode=2
			End Select
			If (qEditMode>0) Then
	    			strFocus=strDialogItem
	    			Call ResetEditMode1(1)
			End If
	End Select
End Function

Sub exInstruction1()
	strForm=""
	DlgVisible "txtForm",False
	DlgText "txtForm",strForm
	iRandom=0
	Instruction=2
	DlgValue "lstRandom",iRandom
	DlgEnable "cmdFinish",False
	nGroups=nGroups+1
	If (nGroups>=5) Then
		nGroups=5
		DlgEnable "cmdNext",False
		DlgEnable "cmdFinish",True
		MsgBox("Максимальное число групп равно 20.",vbOK)
		Instruction=1
	End If
	DlgText "txtboxNGroups","Группа: "+Format(nGroups)
	DlgEnable "txt2",True
	DlgVisible "line2",True
	qEditMode=1
	DlgEnable "txtboxNCases",True
	DlgFocus "txtboxNCases"
	DlgEnable "lstRandom",False
	DlgVisible "Quanta",False
	DlgVisible "Quantb",False
	DlgVisible "Shape1",False
	DlgVisible "shape2",False
	DlgVisible "txtQuanta",False
	DlgVisible "txtQuantb",False
	DlgVisible "txtShape1",False
	DlgVisible "txtshape2",False
	DlgVisible "lstRandomText",False
	DlgVisible "boxRandom",False
	DlgEnable "txt5",False
	DlgVisible "line5",False
	ResetEditMode1(1)
End Sub

Sub ResetEditMode1(iReset As Integer)
	If (iReset=0) Then
		qEditMode=0
		If (Instruction=2) Then
			DlgVisible "grpboxNCases",False
		ElseIf (Instruction=3) Then
			DlgVisible "grpboxEdit",False
			DlgEnable "cmdFinish",True
		End If
	ElseIf (iReset=1) Then
		If (Instruction=2) Then
			DlgVisible "grpboxNCases",True
		ElseIf (Instruction=3) Then
			DlgVisible "grpboxEdit",True
		End If
	End If
End Sub

Sub DialogEditRandom(strDialogItem As String, intAction As Integer, intSuppValue As Integer)
    Select Case intAction
	    Case 4    ' gaining focus
	    	Select Case strFocus
	    		Case "txtboxNCases"
	    			nCases=Val(DlgText("txtboxNCases"))
	    		Case "Quanta"
			    			Quanta=Val(DlgText("Quanta"))
	    		Case "Quantb"
			    			Quantb=Val(DlgText("Quantb"))
	    		Case "Shape1"
			    			Shape1=Val(DlgText("Shape1"))
			    			xShape1(iRandom,1)=Shape1
	    		Case "Shape2"
			    			Shape2=Val(DlgText("Shape2"))
			    			xShape2(iRandom,2)=Shape2
	    	End Select
		If (strDialogItem="cmdNext") Then Call ResetEditMode1(0)
	End Select
End Sub

Sub CreateDataFile()
	Dim strCommand As String
	Dim iGroup As Integer
	strCommand="new file."+vbCrLf
	strCommand=strCommand+"input program."+vbCrLf
	For iGroup=1 To nGroups
		iRandom=iRandomx(iGroup-1)
		strCommand=strCommand+"loop #i=1 to "+Format(nCase(iGroup-1))+"."+vbCrLf
		strCommand=strCommand+"compute group="+Format(iGroup)+"."+vbCrLf
		strCommand=strCommand+"compute value="
		If (Mid(DistType(iRandom),10,1)="1") Then
			strCommand=strCommand+Format(Param(0,iGroup-1))
			strCommand=strCommand+"+"+Format(Param(1,iGroup-1))+"*"
		End If
		strCommand=strCommand+"rv."+strDist(iRandom)+"("+Format(Param(2,iGroup-1))
		If (Mid(DistType(iRandom),11,1)="2") Then
			If (strDist(iRandom)="Uniform") Then
				strCommand=strCommand+","+Format(Param(2,iGroup-1))+"+"+Format(Param(3,iGroup-1))
			Else
				strCommand=strCommand+","+Format(Param(3,iGroup-1))
			End If
		End If
		strCommand=strCommand+")."+vbCrLf
		strCommand=strCommand+"compute value=trunc(100*value)/100 ."+vbCrLf
		strCommand=strCommand+"end case."+vbCrLf
		strCommand=strCommand+"end loop."+vbCrLf
	Next iGroup
	strCommand=strCommand+"end file."+vbCrLf
	strCommand=strCommand+"end input program."+vbCrLf
	strCommand=strCommand+"execute ."+vbCrLf
	strCommand=strCommand+"save outfile='random.sav'."+vbCrLf
	objSpssApp.ExecuteCommands strCommand, False
End Sub

Sub DialogGetProgram
	Begin Dialog UserDialog 520, 140, "Выберите процедуру", .DialogProgInfo
		PushButton  10,110,500,21,"Выход",.cmdCancel
		PushButton 10,10,500,21,"Оценка распределения переменной в существующем файле данных...",.cmdData
		PushButton 10,35,500,21,"Создание переменной с помощью генератора случайных чисел...",.cmdRandom
		PushButton 10,60,400,21,"Estimate Distribution of Parameters...",.cmdParam ' не реализовано
		PushButton 10,85,400,21,"Test Parameters...",.cmdTest ' не реализовано
	End Dialog
	Dim dlg As UserDialog
	Dialog dlg
End Sub

Function DialogProgInfo(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean
    Select Case intAction
	    Case 1 ' Инициализация диалогового окна
			While objSpssApp.IsBusy
				Wait 1
		 	Wend
		    	DlgVisible "cmdTest", False
		    	DlgVisible "cmdParam", False

		Case 2 ' Варианты пользовательского выбора
	        Select Case strDialogItem
	        	Case "cmdCancel"
	        		DialogProgInfo=False
	        		qRunJob=0
	        	Case "cmdRandom"
	        		DialogProgInfo=False
	        		qRunJob=1
	        	Case "cmdData"
	        		DialogProgInfo=False
	        		qRunJob=2
	        	Case "cmdParam"
	        		DialogProgInfo=False
	        		qRunJob=3
	        	Case "cmdTest"
	        		DialogProgInfo=False
	        		qRunJob=4
		End Select
	End Select
End Function
Sub TurnOnFormula(qLevel As Integer,qValue As Integer)
	If (qValue=0) Then DlgText "lstRandomText","Не найдено"
	If (qValue=1) Then DlgText "lstRandomText","Распр."
	DlgEnable "txtQuanta",qValue
	DlgEnable "Quanta",qValue
	DlgEnable "txtQuantb",qValue
	DlgEnable "Quantb",qValue
	DlgVisible "txtShape1",qValue
	DlgVisible "Shape1",qValue
	DlgEnable "txtShape1",qValue
	DlgEnable "Shape1",qValue
	If (qLevel=2) Then
		DlgVisible "txtShape2",qValue
		DlgVisible "Shape2",qValue
		DlgEnable "txtShape2",qValue
		DlgEnable "Shape2",qValue
	End If
End Sub

Sub MakeForm()
	strForm=""
	If (iXDF=1) Then
		strForm=strForm+"quant="
		If (Mid(DistType(iDist),1,1)="1") Then strForm=strForm+"a+"
		If (Mid(DistType(iDist),2,1)="1") Then strForm=strForm+"b*"
		strForm=strForm+"idf."+strDist(iDist)+"(prob,"
	End If
	If (iXDF=2 Or iXDF=3) Then
		strForm=strForm+"prob="
		If (iXDF=2) Then strForm=strForm+"cdf."
		If (iXDF=3) Then strForm=strForm+"ncdf."
		strForm=strForm+strDist(iDist)+"((quant"
		If (Mid(DistType(iDist),1,1)="1") Then strForm=strForm+"-a)"
		If (Mid(DistType(iDist),2,1)="1") Then strForm=strForm+"/b"
		strForm=strForm+","
	End If
	If (Mid(DistType(iDist),3,1)="1" And qRelation<>1) Then strForm=strForm+strShape(iDist,0)
	If (qRelation=1) Then strForm=strForm+strShape(iDist,1)+"+range"
	If (Mid(DistType(iDist),3,1)="1" And Mid(DistType(iDist),4,1)="1") Then strForm=strForm+","
	If (Mid(DistType(iDist),4,1)<>"0" And qRelation=0) Then strForm=strForm+strShape(iDist,1)
	If (qRelation=1) Then strForm=strForm+strShape(iDist,1)
	If (qRelation=2) Then strForm=strForm+strShape(iDist,0)
	If (qRelation=3) Then strForm=strForm+strShape(iDist,0)+"+range"
	If (Mid(DistType(iDist),4,1)<>"0" And Mid(DistType(iDist),5,1)="1") Then strForm=strForm+","
	If (Mid(DistType(iDist),5,1)="1") Then strForm=strForm+"c"
	If (iXDF=3) Then strForm=strForm+",ncdf"
	strForm=strForm+")"
		DlgText "txtForm",strForm
End Sub

Sub CreateSyntaxInit(strCommand As String)
	If (DataFileName<>"") Then
		If (intNumGrp>0) Then
			strCommand="get file='"+DataFileName+"'/keep "+strGroup+" "&strVariable+"."&vbCrLf
		Else
			strCommand="get file='"+DataFileName+"'/keep "+strVariable+"."&vbCrLf
		End If
	End If
	If (intNumGrp=0) Then
		strGroup="curve$"
		strCommand=strCommand+"compute "+strGroup+"=1."&vbCrLf
	End If
	strCommand=strCommand+"sort cases by "+strGroup+" "+strVariable+" ."&vbCrLf
	strCommand=strCommand+"split file by "+strGroup+" ."&vbCrLf
	strCommand=strCommand+"rank vars="+strVariable+" /ties=mean/fraction=blom /Print=no /proportion   into prob ."&vbCrLf
	strCommand=strCommand+"save outfile='curve1.sav' /keep prob "+strGroup+" "+strVariable+" ."&vbCrLf
	strCommand=strCommand+"execute."&vbCrLf
	strCommand=strCommand+"get file='curve1.sav'."&vbCrLf
	strCommand=strCommand+"aggregate outfile='curve2.sav'"&vbCrLf
	strCommand=strCommand+" /break="+strGroup+" "+strVariable+"/nx=n("+strVariable+")/prob=mean(prob) ."&vbCrLf
	strCommand=strCommand+"execute."&vbCrLf
End Sub

Sub CreateSyntaxDist(iCount As Integer, strCommand As String)
	strCommand=strCommand+"get file='curve2.sav'."&vbCrLf
	strCommand=strCommand+"weight by nx."&vbCrLf
	strCommand=strCommand+"split file by "+strGroup+" ."&vbCrLf
	strCommand=strCommand+"select If Not missing(prob) ."&vbCrLf
	If (iCount=0) Then
		strCommand=strCommand+"frequencies vars="+strVariable+"/format=notable"&vbCrLf
		strCommand=strCommand+"  /statistics=mean stddev skewness seskw kurtosis sekurt ."&vbCrLf
	End If
	strCommand=strCommand+"model program "
	If (Mid(DistType(iDist),1,1)="1") Then strCommand=strCommand+"b0="+Format(Quanta)+" "
	If (Mid(DistType(iDist),2,1)="1") Then strCommand=strCommand+"b1="+Format(Quantb)+" "
	If (Mid(DistType(iDist),3,1)="1") Then strCommand=strCommand+"b2="+Format(Shape1)+" "
	If (qRelation=0 And Mid(DistType(iDist),4,1)="1") Then strCommand=strCommand+"b3="+Format(Shape2)+" "
	If (qRelation=1 Or qRelation=3) Then strCommand=strCommand+"b3="+Format(Shape2)+" "
	If (Mid(DistType(iDist),5,1)="1") Then strCommand=strCommand+"b4="+Format(Shape3)+" "
	If (iXDF=3) Then  strCommand=strCommand+"b4="+Format(Shape3)+" "
	strCommand=strCommand+"."+vbCrLf
	strCommand=strCommand+"compute pred="
	If (iXDF=1) Then
		If (Mid(DistType(iDist),1,1)="1") Then strCommand=strCommand+"b0 +"
		If (Mid(DistType(iDist),2,1)="1") Then strCommand=strCommand+"b1*"
	End If
	strCommand=strCommand+strXDF(iXDF)+"."+strDist(iDist)
	If (iXDF=1) Then strCommand=strCommand+"(prob"
	If (iXDF<>1) Then
		strCommand=strCommand+"(("+strVariable
		If (Mid(DistType(iDist),1,1)="1") Then strCommand=strCommand+"-b0"
		strCommand=strCommand+")"
		If (Mid(DistType(iDist),2,1)="1") Then strCommand=strCommand+"/b1"
	End If
	If (Mid(DistType(iDist),3,1)="1" And qRelation<>1) Then strCommand=strCommand+",b2"
	If (qRelation=1) Then strCommand=strCommand+",b3+b2"
	If (qRelation=0 And Mid(DistType(iDist),4,1)<>"0") Then strCommand=strCommand+",b3"
	If (qRelation=1) Then strCommand=strCommand+",b3"
	If (qRelation=2) Then strCommand=strCommand+",b2"
	If (qRelation=3) Then strCommand=strCommand+",b2+b3"
	If (Mid(DistType(iDist),5,1)="1") Then strCommand=strCommand+",b4"
	If (iXDF=3) Then  strCommand=strCommand+",b4"
	strCommand=strCommand+")."+vbCrLf
	If (iXDF=1) Then strCommand=strCommand+"cnlr "+strVariable+vbCrLf
	If (iXDF<>1) Then strCommand=strCommand+"cnlr "+"prob"+vbCrLf
	strCommand=strCommand+"    /criteria iter 200 /save pred"&vbCrLf
	strCommand=strCommand+"    /bounds"&vbCrLf
	If (Mid(DistType(iDist),1,1)="1") Then strCommand=strCommand+"   "&Format(loQuanta)&" < b0 < "&Format(hiQuanta)&";"&vbCrLf
	If (Mid(DistType(iDist),2,1)="1") Then strCommand=strCommand+"   "&Format(loQuantb)&" < b1 < "&Format(hiQuantb)&";"&vbCrLf
	If (Mid(DistType(iDist),3,1)="1") Then strCommand=strCommand+"   "&Format(loShape1)&" < b2 < "&Format(hiShape1)&";"&vbCrLf
	If (qRelation=0 And Mid(DistType(iDist),4,1)<>"0") Then strCommand=strCommand+"   "&Format(loShape2)&" < b3 < "&Format(hiShape2)&" ;"&vbCrLf
	If (qRelation=1 Or qRelation=3) Then strCommand=strCommand+"   "&Format(loShape2)&" < b3 < "&Format(hiShape2)&" ;"&vbCrLf
	If (Mid(DistType(iDist),5,1)="1") Then strCommand=strCommand+"   "&Format(loShape3)&" < b4 < "&Format(hiShape3)&" ;"&vbCrLf
	If (iXDF=3) Then strCommand=strCommand+"   "&Format(loShape3)&" < b4 < "&Format(hiShape3)&" ;"&vbCrLf
	strCommand=strCommand+"."+vbCrLf
End Sub

Sub CreateSyntaxMatch(iCount As Integer, strCommand As String, strProbName As String)
		strProbName=Mid(strDist(iDist),1,5)+Format(iCount,"00")+"$"
		strCommand=strCommand+"compute "&strProbName+"=pred ."&vbCrLf
	If (iCount>0) Then
		strCommand=strCommand+"match files file=*/ file='curve2.sav' ."&vbCrLf
		strCommand=strCommand+"execute."&vbCrLf
	End If
		strCommand=strCommand+"save outfile='curve2.sav' /drop pred ."&vbCrLf
		strCommand=strCommand+"execute."&vbCrLf
End Sub

Sub CreateSyntaxPlot(strCommand As String, strProbName As String)
	strCommand=strCommand+"Get file='curve2.sav'."&vbCrLf
	Dim strVar4 As String, strGrp4 As String, strPrb4 As String
	strVar4=StrConv(Mid(strVariable,1,4),vbUpperCase)
	strGrp4=StrConv(Mid(strGroup,1,4),vbUpperCase)
	strPrb4=StrConv(Mid(strProbName,1,4),vbUpperCase)
	If (strPrb4=strVar4) Then strPrb4=Mid(strPrb4,1,3)+"$"
	strCommand=strCommand+"compute Case$$=$casenum ."&vbCrLf
	strCommand=strCommand+"compute one$$=1 ."&vbCrLf
	strCommand=strCommand+"aggregate outfile='agg.sav'/break=one$$/ncases$$=max(case$$) ."&vbCrLf
	strCommand=strCommand+"execute ."&vbCrLf
	strCommand=strCommand+"match files file=*/table='agg.sav'/by one$$ ."&vbCrLf
	strCommand=strCommand+"numeric prob$$m1 prob$$ prob$$p1 ."&vbCrLf
	strCommand=strCommand+"numeric "+strPrb4+"$$m1 "+strPrb4+"$$ "+strPrb4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"numeric "+strVar4+"$$m1 "+strVar4+"$$ "+strVar4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"numeric "+strGrp4+"$$m1 "+strGrp4+"$$ "+strGrp4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"compute Case$$=$casenum ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$m1=lag("+strGrp4+"$$) ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$=lag("+strGroup+") ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$p1="+strGroup+" ."&vbCrLf
	strCommand=strCommand+"compute prob$$m1=lag(prob$$) ."&vbCrLf
	strCommand=strCommand+"compute prob$$=lag(prob) ."&vbCrLf
	strCommand=strCommand+"compute prob$$p1=prob ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$m1=lag("+strPrb4+"$$) ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$=lag("+strProbName+") ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$p1="+strProbName+" ."&vbCrLf
	strCommand=strCommand+"compute "+strVar4+"$$m1=lag("+strVar4+"$$) ."&vbCrLf
	strCommand=strCommand+"compute "+strVar4+"$$=lag("+strVariable+") ."&vbCrLf
	strCommand=strCommand+"compute "+strVar4+"$$p1="+strVariable+" ."&vbCrLf
	strCommand=strCommand+"compute #nx=1 ."&vbCrLf
	strCommand=strCommand+"If (Case$$ eq ncases$$) #nx=2 ."&vbCrLf
	strCommand=strCommand+"Loop #i=1 To #nx ."&vbCrLf
	strCommand=strCommand+"Do If (#i eq 2) ."&vbCrLf
	strCommand=strCommand+"numeric missx ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$m1="+strGrp4+"$$ ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$="+strGrp4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"compute "+strGrp4+"$$p1=missx ."&vbCrLf
	strCommand=strCommand+"compute prob$$m1=prob$$ ."&vbCrLf
	strCommand=strCommand+"compute prob$$=prob$$p1 ."&vbCrLf
	strCommand=strCommand+"compute prob$$p1=missx ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$m1="+strPrb4+"$$ ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$="+strPrb4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"compute "+strPrb4+"$$p1=missx ."&vbCrLf
	strCommand=strCommand+"End If ."&vbCrLf
	strCommand=strCommand+"xsave outfile='curve3.sav'"&vbCrLf
	strCommand=strCommand+"  /keep "&vbCrLf
	strCommand=strCommand+"        prob$$m1 prob$$ prob$$p1 "&vbCrLf
	strCommand=strCommand+"        "+strPrb4+"$$m1 "+strPrb4+"$$ "+strPrb4+"$$p1"&vbCrLf
	strCommand=strCommand+"        "+strVar4+"$$m1 "+strVar4+"$$ "+strVar4+"$$p1 "&vbCrLf
	strCommand=strCommand+"        "+strGrp4+"$$m1 "+strGrp4+"$$ "+strGrp4+"$$p1 ."&vbCrLf
	strCommand=strCommand+"End Loop ."&vbCrLf
	strCommand=strCommand+"execute ."&vbCrLf
	strCommand=strCommand+"Get file='curve3.sav'."&vbCrLf
	strCommand=strCommand+"Do If ("+strGrp4+"$$ ne "+strGrp4+"$$m1) ."&vbCrLf
	strCommand=strCommand+"compute slope1=(prob$$p1-prob$$)/("+strVar4+"$$p1-"+strVar4+"$$) ."&vbCrLf
	If (iXDF=1) Then strCommand=strCommand+"compute slope2=(prob$$p1-prob$$)/("+strPrb4+"$$p1-"+strPrb4+"$$) ."&vbCrLf
	If (iXDF<>1) Then strCommand=strCommand+"compute slope2=("+strPrb4+"$$p1-"+strPrb4+"$$)/("+strVar4+"$$p1-"+strVar4+"$$) ."&vbCrLf
	strCommand=strCommand+"Else If ("+strGrp4+"$$ ne "+strGrp4+"$$p1)."&vbCrLf
	strCommand=strCommand+"compute slope1=(prob$$-prob$$m1)/("+strVar4+"$$-"+strVar4+"$$m1) ."&vbCrLf
	If (iXDF=1) Then strCommand=strCommand+"compute slope2=(prob$$-prob$$m1)/("+strPrb4+"$$-"+strPrb4+"$$m1) ."&vbCrLf
	If (iXDF<>1) Then strCommand=strCommand+"compute slope2=("+strPrb4+"$$-"+strPrb4+"$$m1)/("+strVar4+"$$-"+strVar4+"$$m1) ."&vbCrLf
	strCommand=strCommand+"Else If (prob$$ gt prob$$m1) ."&vbCrLf
	strCommand=strCommand+"compute slope1=((prob$$-prob$$m1)/("+strVar4+"$$-"+vbCrLf
	strCommand=strCommand+strVar4+"$$m1)  +(prob$$p1-prob$$)/("+strVar4+"$$p1-"+strVar4+"$$))/2."&vbCrLf
	If (iXDF=1) Then
		strCommand=strCommand+"compute slope2=((prob$$-prob$$m1)/("+strPrb4+"$$-"+strPrb4+"$$m1)+(prob$$p1-prob$$)/("+vbCrLf
		strCommand=strCommand+strPrb4+"$$p1-"+strPrb4+"$$))/2 ."&vbCrLf
	End If
	If (iXDF<>1) Then
		strCommand=strCommand+"compute slope2=(("+strPrb4+"$$-"+strPrb4+"$$m1)/("+strVar4+"$$-"+strVar4+"$$m1)+("+vbCrLf
		strCommand=strCommand+strPrb4+"$$p1-"+strPrb4+"$$)/("+strVar4+"$$p1-"+strVar4+"$$))/2 ."&vbCrLf
	End If
	strCommand=strCommand+"End If ."&vbCrLf
	strCommand=strCommand+"execute ."&vbCrLf

	strCommand=strCommand+"aggregate outfile='agg.sav'"+vbCrLf
	strCommand=strCommand+"  /break="+strGrp4+"$$"+vbCrLf
	strCommand=strCommand+"  /max$$=max(slope2) ."+vbCrLf
	strCommand=strCommand+"match files file=*/table='agg.sav'/by "+strGrp4+"$$ ."+vbCrLf

	strCommand=strCommand+"Select If Not missing(slope2) And slope2 lt 1.00 ."&vbCrLf
	strCommand=strCommand+"split file off ."&vbCrLf
	strCommand=strCommand+"weight off ."&vbCrLf
	strCommand=strCommand+"GRAPH"&vbCrLf
	If (iXDF=1) Then strCommand=strCommand+"   /SCATTERPLOT(BIVAR)="+strPrb4+"$$ With slope2 BY "+strGrp4+"$$"+vbCrLf
	If (iXDF<>1) Then strCommand=strCommand+"  /SCATTERPLOT(BIVAR)="+strVar4+"$$ With slope2 BY "+strGrp4+"$$"+vbCrLf
	strCommand=strCommand+"  /MISSING=LISTWISE ."&vbCrLf
	strCommand=strCommand+"split file by "+strGrp4+"$$ ."&vbCrLf
	strCommand=strCommand+"if (slope1>2*max$$) slope1=2*max$$ ."&vbCrLf
	strCommand=strCommand+"GRAPH"&vbCrLf
	If (iXDF=1) Then strCommand=strCommand+"  /SCATTERPLOT(OVERLAY)="+strVar4+"$$ "+strPrb4+"$$  With slope1 slope2 (PAIR)"&vbCrLf
	If (iXDF<>1) Then strCommand=strCommand+"  /SCATTERPLOT(OVERLAY)="+strVar4+"$$ "+strVar4+"$$  With slope1 slope2 (PAIR)"&vbCrLf
	strCommand=strCommand+"  /MISSING=LISTWISE ."&vbCrLf
End Sub

Sub LoadDist
	nXDF=4
	ReDim strXDF(nXDF)
	strXDF(0)=""
	strXDF(1)="IDF"
	strXDF(2)="CDF"
	strXDF(3)="NCDF"
	nDist=16
	ReDim strDist(nDist)
	ReDim strDistRus (nDist)
	ReDim DistType(nDist)

	strDist(00)="<выбор распределения>"	:	DistType(00)="00000000000"
	strDist(01)="Beta"					:	DistType(01)="11110111112"
	strDist(02)="Cauchy"				:	DistType(02)="11110011012"
	strDist(03)="ChiSq"					:	DistType(03)="11100011111"
	strDist(04)="Exp"					:	DistType(04)="11100011011"
	strDist(05)="F"						:	DistType(05)="11110111112"
	strDist(06)="Gamma"					:	DistType(06)="11110011012"
	strDist(07)="LaPlace"				:	DistType(07)="11110011002"
	strDist(08)="Logistic"				:	DistType(08)="11110011012"
	strDist(09)="lNormal"				:	DistType(09)="11110111012"
	strDist(10)="Normal"				:	DistType(10)="00110111002"
	strDist(11)="Pareto"				:	DistType(11)="11110011012"
	strDist(12)="Poisson"				:	DistType(12)="11100001011"
	strDist(13)="T"						:	DistType(13)="11100011111"
	strDist(14)="Uniform"				:	DistType(14)="00110111002"
	strDist(15)="Weibull"				:	DistType(15)="11110111012"

	strDistRus(00)="<выбор распределения>"
	strDistRus(01)="Бета (Beta)"
	strDistRus(02)="Коши (Cauchy)"
	strDistRus(03)="Хи-квадрат (ChiSq)"
	strDistRus(04)="Экспоненц. (Exp)"
	strDistRus(05)="Фишера (F)"
	strDistRus(06)="Гамма (Gamma)"
	strDistRus(07)="Лапласа (LaPlace)"
	strDistRus(08)="Логистич. (Logistic)"
	strDistRus(09)="Лог-норм. (lNormal)"
	strDistRus(10)="Нормальное (Normal)"
	strDistRus(11)="Парето (Pareto)"
	strDistRus(12)="Пуассона (Poisson)"
	strDistRus(13)="Стьюдента (T)"
	strDistRus(14)="Равномерное (Uniform)"
	strDistRus(15)="Вейбулла (Weibull)"

	ReDim strShape(nDist,2)
	strShape(00,00)=""					:	strShape(00,01)=""
	strShape(01,00)="форма1"			:	strShape(01,01)="форма2"
	strShape(02,00)="плж"				:	strShape(02,01)="мсштб" 'положение, масштаб
	strShape(03,00)="стсв"				:	strShape(03,01)=""
	strShape(04,00)="форма"				:	strShape(04,01)=""		'степени свободы
	strShape(05,00)="стсв1"				:	strShape(05,01)="стсв2"
	strShape(06,00)="форма"				:	strShape(06,01)="мсштб"
	strShape(07,00)="срдн"				:	strShape(07,01)="мсштб" 'среднее, масштаб
	strShape(08,00)="срдн"				:	strShape(08,01)="мсштб"
	strShape(09,00)="ax"				:	strShape(09,01)="bx"
	strShape(10,00)="срдн"				:	strShape(10,01)="стдоткл"
	strShape(11,00)="порог"				:	strShape(11,01)="форма"
	strShape(12,00)="срдн	"			:	strShape(12,01)=""
	strShape(13,00)="стсв"				:	strShape(13,01)=""
	strShape(14,00)="мин"				:	strShape(14,01)="размах" 'минимум и размах (максимум-минимум)
	strShape(15,00)="ax"				:	strShape(15,01)="bx"

	ReDim xShape1(nDist,3) As Single
	xShape1(00,00)=0			:xShape1(00,01)=0			:xShape1(00,02)=0
	xShape1(01,00)=0.25 		:xShape1(01,01)=1.0  		:xShape1(01,02)=200.0
	xShape1(02,00)=1.0		:xShape1(02,01)=1.000		:xShape1(02,02)=500.0
	xShape1(03,00)=.25		:xShape1(03,01)=1.0  		:xShape1(03,02)=500.
	xShape1(04,00)=0.0001		:xShape1(04,01)=1.0  		:xShape1(04,02)=500.0
	xShape1(05,00)=0.25  		:xShape1(05,01)=1.0  		:xShape1(05,02)=200.0
	xShape1(06,00)=0.250		:xShape1(06,01)=1.0  		:xShape1(06,02)=200.0
	xShape1(07,00)=0.25  		:xShape1(07,01)=1.0  		:xShape1(07,02)=200.0
	xShape1(08,00)=0.25 		:xShape1(08,01)=1.0  		:xShape1(08,02)=200.0
	xShape1(09,00)=0.25  		:xShape1(09,01)=1.0  		:xShape1(09,02)=200.0
	xShape1(10,00)=-400.0		:xShape1(10,01)=100  		:xShape1(10,02)=400.0
	xShape1(11,00)=0.25 		:xShape1(11,01)=1.0  		:xShape1(11,02)=200.0
	xShape1(12,00)=0.25   		:xShape1(12,01)=1.0  		:xShape1(12,02)=200.0
	xShape1(13,00)=0.25		:xShape1(13,01)=1.0		:xShape1(13,02)=200.0
	xShape1(14,00)=-200.0		:xShape1(14,01)=10.0  		:xShape1(14,02)=200.0
	xShape1(15,00)=0.25 		:xShape1(15,01)=1.0  		:xShape1(15,02)=200.0
	ReDim xShape2(nDist,3) As Single
	xShape2(00,00)=0			:xShape2(00,01)=0			:xShape2(00,02)=0
	xShape2(01,00)=0.25 		:xShape2(01,01)=1.0  		:xShape2(01,02)=200.0
	xShape2(02,00)=.0001		:xShape2(02,01)=0.5		:xShape2(02,02)=0.9999
	xShape2(03,00)=0			:xShape2(03,01)=0  		:xShape2(03,02)=0
	xShape2(04,00)=0	 		:xShape2(04,01)=0  		:xShape2(04,02)=0
	xShape2(05,00)=0.25   		:xShape2(05,01)=1.0  		:xShape2(05,02)=200.0
	xShape2(06,00)=0.25		:xShape2(06,01)=1.0		:xShape2(06,02)=200.0
	xShape2(07,00)=0.25   		:xShape2(07,01)=1.0  		:xShape2(07,02)=200.0
	xShape2(08,00)=0.25 		:xShape2(08,01)=1.0  		:xShape2(08,02)=200.0
	xShape2(09,00)=0.25   		:xShape2(09,01)=1.0  		:xShape2(09,02)=200.0
	xShape2(10,00)=.0001		:xShape2(10,01)=20.0  		:xShape2(10,02)=100.0
	xShape2(11,00)=0.25 		:xShape2(11,01)=1.0  		:xShape2(11,02)=200.0
	xShape2(12,00)=0   		:xShape2(12,01)=0  		:xShape2(12,02)=0
	xShape2(13,00)=0			:xShape2(13,01)=0			:xShape2(13,02)=0
	xShape2(14,00)=.00001		:xShape2(14,01)=20.0  		:xShape2(14,02)=200.0
	xShape2(15,00)=0.25		:xShape2(15,01)=1.0  		:xShape2(15,02)=200.0
End Sub

Sub AddToDistList()
	If (nDistList=0) Then
		ReDim nCase(0)
		ReDim iDistrx(0)
		ReDim Param(5,0)
		ReDim loParam(5,0)
		ReDim hiParam(5,0)
		ReDim iEqualx(0)
		ReDim iXDFx(0)
	End If
	nDistList=nDistList+1
	ReDim Preserve iDistrx(nDistList)
	ReDim Preserve Param(5,nDistList)
	ReDim Preserve loParam(5,nDistList)
	ReDim Preserve hiParam(5,nDistList)
	ReDim Preserve iEqualx(nDistList)
	ReDim Preserve iXDFx(nDistList)
	ReDim Preserve strDistUse(nDistList) As String
	Dim iDistList As Integer
	iDistList=nDistList-1
	Call ModifyDistList(iDistList)
End Sub

Sub CreateSyntaxFile()
	Dim iVars As Integer
	Dim strProbName As String
	Dim strCommand As String
	Dim iCount As Integer
	Dim qExecute As Integer
	qExecute=0
	For iCount=0 To nDistList-1
		strCommand=""
		LoadForm(iCount)
		If (iCount=0) Then Call CreateSyntaxInit(strCommand) ' расчёт процентилей и статистики по группам
		Call CreateSyntaxDist(iCount,strCommand) 'собственно синтаксис подгонки (CNLR)
		Call CreateSyntaxMatch(iCount,strCommand,strProbName) ' Эта и следующая процедура обрабатывают довольно нетривиальный
		Call CreateSyntaxPlot(strCommand,strProbName) 'подход к демонстрации совпадения/несовпадения подогнанных распределений
														'в разных группах, а также демонстрации совпадения/несовпадения
														'подогнанных и исходных распределений в разных группах
														'(основная проблема здесь - продемонстрировать на одном графике
														'разные распределения (которые могут иметь очень разные масштабы) - примеч. перев.

		If (qExecute=0) Then qExecute=MsgBox("Процедура может занять несколько минут.  Нажмите OK для запуска.",vbOkCancel)
		If (qExecute=vbOK) Then
			objSpssApp.ExecuteCommands strCommand, False
			While objSpssApp.IsBusy
				Wait 2
		 	Wend
		Else
			Exit For
		End If
	Next iCount
	If (qExecute=vbOK) Then
		strCommand=""
		Call CreateSyntaxFinal(strCommand)
		objSpssApp.ExecuteCommands strCommand, False
		While objSpssApp.IsBusy
			Wait 2
	 	Wend
	 End If
End Sub

Sub CreateSyntaxFinal(strCommand As String)
	Dim strProbName As String
	Dim iCount As Integer
	strCommand=strCommand+"get file='curve2.sav'."&vbCrLf
	strCommand=strCommand+"split file by "+strGroup+" ."&vbCrLf
	strCommand=strCommand+"correlations vars="
	strCommand=strCommand+"prob "+strVariable+vbCrLf
	For iCount=0 To nDistList-1
		iDist=iDistrx(iCount)
		strProbName=Mid(strDist(iDist),1,5)+Format(iCount,"00")+"$"
		iXDF=iXDFx(iCount)
		strCommand=strCommand+" "+strProbName
	Next iCount
	strCommand=strCommand+"."+vbCrLf
End Sub

Sub LoadForm(iCount)
	iDist=iDistrx(iCount)
	Quanta=Param(0,iCount)
	Quantb=Param(1,iCount)
	Shape1=Param(2,iCount)
	Shape2=Param(3,iCount)
	Shape3=Param(4,iCount)
	loQuanta=loParam(0,iCount)
	loQuantb=loParam(1,iCount)
	loShape1=loParam(2,iCount)
	loShape2=loParam(3,iCount)
	loShape3=loParam(4,iCount)
	hiQuanta=hiParam(0,iCount)
	hiQuantb=hiParam(1,iCount)
	hiShape1=hiParam(2,iCount)
	hiShape2=hiParam(3,iCount)
	hiShape3=hiParam(4,iCount)
	qRelation=iEqualx(iCount)
	iXDF=iXDFx(iCount)
End Sub

Sub SetEqual()
	qRelation=DlgValue("grpRelation")
	If (qRelation=2) Then
		Shape2=Shape1
		loShape2=loShape1
		hiShape2=hiShape1
		DlgText "Shape2",Format(Shape2)
		DlgText "loShape2",Format(loShape2)
		DlgText "hiShape2",Format(hiShape2)
		DlgEnable "Shape2",False
		DlgEnable "loShape2",False
		DlgEnable "hiShape2",False
	Else
		DlgEnable "Shape2",True
		DlgEnable "loShape2",True
		DlgEnable "hiShape2",True
	End If
End Sub

Sub LoadParam()
	DlgEnable "Shape1",True
	DlgEnable "loShape1",True
	DlgEnable "hiShape1",True
	DlgEnable "Shape2",True
	DlgEnable "loShape2",True
	DlgEnable "hiShape2",True
	DlgValue "grpRelation",qRelation
	If (nDistList>0) Then DlgEnable"cmdNext",True
   	DlgText "lstDistText",strDist(iDist)
	Dim iValue As Integer
	iValue=0
	If (Mid(DistType(iDist),1,1)="1") Then iValue=1.
	DlgVisible "Quanta",iValue
	DlgVisible "loQuanta",iValue
	DlgVisible "hiQuanta",iValue
	DlgVisible "txtQuanta",iValue
	iValue=0
	If (Mid(DistType(iDist),2,1)="1") Then iValue=1.
	DlgVisible "Quantb",iValue
	DlgVisible "loQuantb",iValue
	DlgVisible "hiQuantb",iValue
	DlgVisible "txtQuantb",iValue
	iValue=0
	If (Mid(DistType(iDist),3,1)="1") Then iValue=1.
	DlgVisible "Shape1",iValue
	DlgVisible "loShape1",iValue
	DlgVisible "hiShape1",iValue
	DlgVisible "txtShape1",iValue
	iValue=0
	If (Mid(DistType(iDist),4,1)<>"0") Then iValue=1.
	DlgVisible "Shape2",iValue
	DlgVisible "loShape2",iValue
	DlgVisible "hiShape2",iValue
	DlgVisible "txtShape2",iValue
	iValue=0
	If (Mid(DistType(iDist),5,1)="1") Then iValue=1.
	DlgVisible "Shape3",iValue
	DlgVisible "loShape3",iValue
	DlgVisible "hiShape3",iValue
	DlgVisible "txtShape3",iValue
	DlgVisible ("grpboxRelation",1)
	iValue=0
	If (Mid(DistType(iDist),6,1)="1") Then iValue=1
	DlgVisible "grpRelation",iValue
	DlgVisible "optFree",1
	DlgVisible "optLT",iValue
	DlgVisible "optEQ",iValue
	DlgVisible "optGT",iValue
Rem	If (qRelation=2) Then DlgText "chkRelation",strShape(iDist,1)+" = "+strShape(iDist,0)
Rem	If (qRelation=3) Then DlgText "chkGT",strShape(iDist,1)+" > "+strShape(iDist,0)
	DlgVisible ("grpboxDist",1)
   	iValue=0
	If (Mid(DistType(iDist),7,1)="1") Then iValue=1
	DlgVisible "optIDF",iValue
	iValue=0
	If (Mid(DistType(iDist),8,1)="1") Then iValue=1
	DlgVisible "optCDF",iValue
	iValue=0
	If (Mid(DistType(iDist),9,1)="1") Then iValue=1
	DlgVisible "optNCDF",iValue
	DlgValue "grpDist",iXDF-1
	DlgVisible "txtInitial",True
	DlgVisible "txtLower",True
	DlgVisible "txtUpper",True
	Call MakeForm()
	DlgVisible "txtForm",True
	DlgVisible "txtPerform",True
	If (qModify=0) Then Call SelectiDist()
	If (Mid(DistType(iDist),1,1)="1") Then
    	DlgText "Quanta",Format(Quanta,"####0.######")
    	DlgText "loQuanta",Format(loQuanta,"####0.######")
    	DlgText "hiQuanta",Format(hiQuanta,"####0.######")
	End If
	If (Mid(DistType(iDist),2,1)="1") Then
    	DlgText "Quantb",Format(Quantb,"####0.######")
    	DlgText "loQuantb",Format(loQuantb,"####0.######")
    	DlgText "hiQuantb",Format(hiQuantb,"####0.######")
	End If
	If (Mid(DistType(iDist),3,1)="1") Then
    	DlgText "Shape1",Format(Shape1,"####0.######")
    	DlgText "loShape1",Format(loShape1,"####0.######")
    	DlgText "hiShape1",Format(hiShape1,"####0.######")
	End If
	If (Mid(DistType(iDist),4,1)<>"0") Then
	   	DlgText "Shape2",Format(Shape2,"####0.######")
    	DlgText "loShape2",Format(loShape2,"####0.######")
    	DlgText "hiShape2",Format(hiShape2,"####0.######")
	End If
	If (Mid(DistType(iDist),5,1)="1" Or iXDF=3) Then
    	DlgText "Shape3",Format(Shape3,"####0.######")
    	DlgText "loShape3",Format(loShape3,"####0.######")
   		DlgText "hiShape3",Format(hiShape3,"####0.######")
	End If
End Sub

Sub ModifyDistList(iDistList As Integer)
	iDistrx(iDistList)=iDist
	Param(0,iDistList)=Quanta
	Param(1,iDistList)=Quantb
	Param(2,iDistList)=Shape1
	Param(3,iDistList)=Shape2
	Param(4,iDistList)=Shape3
	loParam(0,iDistList)=loQuanta
	loParam(1,iDistList)=loQuantb
	loParam(2,iDistList)=loShape1
	loParam(3,iDistList)=loShape2
	loParam(4,iDistList)=loShape3
	hiParam(0,iDistList)=hiQuanta
	hiParam(1,iDistList)=hiQuantb
	hiParam(2,iDistList)=hiShape1
	hiParam(3,iDistList)=hiShape2
	hiParam(4,iDistList)=hiShape3
	iEqualx(iDistList)=qRelation
	iXDFx(iDistList)=iXDF
	Call MakeForm()
	strDistUse(iDistList)=strForm
	DlgListBoxArray "lstDistAnalyze", strDistUse()
	DlgValue "lstDistAnalyze",iDistList
	DlgValue "lstDistAnalyze",-1
End Sub

Sub DeleteDistList(iDistList As Integer)
	nDistList=nDistList-1
	Dim iList As Integer
	For iList=iDistList To nDistList-1
		iDistrx(iList)=iDistrx(iList+1)
		Dim iParam As Integer
		For iParam=0 To 4
			Param(iParam,iList)=Param(iParam,iList+1)
			loParam(iParam,iList)=loParam(iParam,iList+1)
			hiParam(iParam,iList)=hiParam(iParam,iList+1)
		Next iParam
		iEqualx(iList)=iEqualx(iList+1)
		iXDFx(iList)=iXDFx(iList+1)
		strDistUse(iList)=strDistUse(iList+1)
	Next iList
	ReDim Preserve iDistrx(nDistList)
	ReDim Preserve Param(5,nDistList)
	ReDim Preserve loParam(5,nDistList)
	ReDim Preserve hiParam(5,nDistList)
	ReDim Preserve iEqualx(nDistList)
	ReDim Preserve iXDFx(nDistList)
	strDistUse(nDistList)=""
	ReDim Preserve strDistUse(nDistList) As String
	DlgListBoxArray "lstDistAnalyze", strDistUse()
End Sub

Function DialogDistInfo(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean
    Select Case intAction
	    Case 1 ' Инициализация диалогового окна
	        		ReDim strDistUse(0) As String
				DlgListBoxArray "lstDistAnalyze",strDistUse()
	    		Dim iCount As Integer, nCount As Integer
	    		nCount=DlgCount()
	    		For iCount=0 To nCount-1
					DlgVisible iCount,False
				Next iCount
		    	DlgEnable "cmdCancel", True
		    	DlgEnable "cmdNext", False
				DlgEnable "lstDist",True
				DlgEnable "lstDistText",False
		    	DlgVisible "cmdCancel", True
		    	DlgVisible "cmdBack",True
		    	DlgVisible "cmdNext", True
				DlgVisible "lstDist",True
				DlgVisible "lstDistText",True
				qEditMode=0
	    		iDist=0
				qRelation=0
				iXDF=0
				nDistList=0
				iDistAnalyze=0
				qModify=0
				DlgText "lstDistText","<выберите распределение>"
	    Case 2
	If (qEditMode>0) Then Call DialogEditInfo(strDialogItem,intAction,intSuppValue)
				DlgVisible "cmdModify",False
	        Select Case strDialogItem
	        	Case "cmdNext"
		        		dialogDistInfo=False
		        		qRunJob=1
	        	Case "cmdCancel"
	        		dialogDistInfo=False
	        		qRunJob=0
	        	Case "cmdBack"
	        		If (qEditMode=0) Then
		        		dialogDistInfo=False
		        		qRunJob=-2
		        	ElseIf (qEditMode>0) Then
		        		dialogDistInfo=True
		        		Call ResetEditMode(0)
		        		DlgFocus "cmdNext"
		        	End If
		        	If (qModify=1) Then
		        		DlgText "cmdModify", "Принять правку"
		        		DlgVisible "cmdModify",True
		        	End If
		        	qModify=0
		      Case "cmdModify"
		      	If (DlgText("cmdModify")="Принять правку") Then
		        		Call ModifyDistList(iDistAnalyze)
		        		DlgValue "lstDistAnalyze",-1
		        		DlgValue "lstDist",-1
	      	  		dialogDistInfo=True
	        			qModify=0
	        			DlgEnable "cmdAdd",False
			      End If
				If (DlgText ("cmdModify")="Удалить подгонку") Then
					Call DeleteDistList(iDistAnalyze)
					DialogDistInfo=True
					If (nDistList<=0) Then DlgEnable"cmdNext",False
					DlgEnable "cmdAdd",False
					DlgValue "lstDist",-1
				End If
	        	Case "grpDist"
				If (qModify>0) Then
					DlgText "cmdModify","Принять правку"
					DlgVisible "cmdModify",True
				End If
	        		iXDF=DlgValue("grpDist")+1
	        			Call MakeForm()
					Call SelectiDist()
	    			If (iXDF=3) Then
				    	DlgText "Shape3",Format(Shape3)
				    	DlgText "loShape3",Format(loShape3)
			    		DlgText "hiShape3",Format(hiShape3)
					End If
				Case "grpRelation"
					qRelation=DlgValue("grpRelation")
					Call SelectiDist()
					Call SetEqual()
					Call MakeForm()
					If (qModify>0) Then
						DlgText "cmdModify","Принять правку"
						DlgVisible "cmdModify",True
					End If
		      Case "cmdAdd"
		      	Call AddToDistList()
		        	dialogDistInfo=True
		        	DlgEnable "cmdNext",True
	      	  	DlgValue "lstDistAnalyze",nDistList-1
	        		DlgValue "lstDistAnalyze",-1
		        	DlgEnable "cmdAdd",False
				DlgValue "lstDist",-1
	        	Case "lstDist"
	        		qRelation=0
	        		qModify=0
	        		iDist=DlgValue("lstDist")
	        		iDistx=iDist
				DlgVisible "lstDistAnalyze",True
				DlgVisible "cmdAdd",True
				Quanta=50
				Quantb=10
				loQuanta=-200.0000000000000
				hiQuanta=200.0000000000000
				loQuantb=0.000001
				hiQuantb=200.0000000000000
				Dim iValue As Integer
				If (Mid(DistType(iDist),7,1)="1") Then iXDF=1
				If (Mid(DistType(iDist),8,1)="1") And (Mid(DistType(iDist),7,1)="0") Then iXDF=2
				Call LoadParam()
				DlgEnable "cmdAdd",True
				DlgValue "lstDistAnalyze",-1
			   Case "lstDistAnalyze"
				qModify=1
		      	iDistAnalyze=DlgValue("lstDistAnalyze")
		      	Call LoadForm(iDistAnalyze)
		      	DlgValue "lstDist",iDist
		      	Call LoadParam()
		      	Call SetEqual()
		      	DlgValue "grpDist",iXDF-1
				DlgVisible "cmdModify",True
				DlgText "cmdModify","Удалить подгонку"
				Call SelectiDist()
		    End Select
	    Case 3 ' потеря фокуса
	    Case 4 ' получения фокуса
	If (qEditMode>0) Then Call DialogEditInfo(strDialogItem,intAction,intSuppValue)
	    	Select Case strDialogItem
	    		Case "Quanta","loQuanta","hiQuanta","Quantb","loQuantb","hiQuantb"
	    			qEditMode=1
	    		Case "Shape1","loShape1","hiShape1","Shape2","loShape2","hiShape2"
	    			qEditMode=1
	    		Case "Shape3","loShape3","hiShape3"
	    			qEditMode=1
			End Select
			If (qEditMode>0) Then
	    			strFocus=strDialogItem
	    			Call ResetEditMode(1)
			End If
	End Select
End Function

Sub DialogGetDistInfo
	ReDim strDistUse(0) As String
	Begin Dialog UserDialog 750,329,"Подгонка распределения",.DialogDistInfo ' %GRID:10,7,1,1
		PushButton 590,7,150,21,"Завершить",.cmdNext
		PushButton 590,35,150,21,"Назад...",.cmdBack
		PushButton 590,63,150,21,"Отмена",.cmdCancel
		PushButton 590,91,150,42,"**  Добавить подгонку  **",.cmdAdd
		PushButton 590,140,150,21,"Удалить подгонку",.cmdModify
		ListBox 20,28,150,98,strDistRus(),.lstDist
		TextBox 20,7,150,21,.lstDistText
		GroupBox 170,0,400,161,"Редактировать",.grpboxEdit
		Text 250,14,80,14,"Начальный",.txtInitial
		Text 400,14,60,14,"Нижний",.txtLower
		Text 480,14,70,14,"Верхний",.txtUpper
		Text 180,31,75,14,"b0: a",.txtQuanta
		TextBox 260,28,70,21,.Quanta
		TextBox 400,28,70,21,.loQuanta
		TextBox 480,28,70,21,.hiQuanta
		Text 180,52,75,14,"b1: b",.txtQuantb
		TextBox 260,49,70,21,.Quantb
		TextBox 400,49,70,21,.loQuantb
		TextBox 480,49,70,21,.hiQuantb
		Text 178,73,75,14,"Shape1:",.txtShape1
		TextBox 260,70,70,21,.Shape1
		TextBox 400,70,70,21,.loShape1
		TextBox 480,70,70,21,.hiShape1
		Text 178,94,75,14,"Shape2:",.txtShape2
		TextBox 260,91,70,21,.Shape2
		TextBox 400,91,70,21,.loShape2
		TextBox 480,91,70,21,.hiShape2
		Text 178,115,75,14,"Shape3:",.txtShape3
		TextBox 260,112,70,21,.Shape3
		TextBox 400,112,70,21,.loShape3
		TextBox 480,112,70,21,.hiShape3
		GroupBox 20,231,270,84,"Форма распределения",.grpboxDist
		OptionGroup .grpDist
			OptionButton 30,252,200,14,"Обратная функция (IDF)",.optIDF
			OptionButton 30,273,230,14,"Кумулятивная функция (CDF)",.optCDF
			OptionButton 30,294,250,14,"Нецентральная функция (NCDF)",.optNCDF
		GroupBox 120,189,520,35,"Отношение Shape1 и Shape2",.grpboxRelation
		OptionGroup .grpRelation
			OptionButton 130,203,100,14,"не задано",.optFree
			OptionButton 250,203,110,14,"b3 < b2",.optLT
			OptionButton 380,203,120,14,"b3 = b2",.optEQ
			OptionButton 510,203,120,14,"b3 > b2",.optGT
		Text 330,231,230,14," ",.txtPerform
		Text 330,252,310,14,"Форма:",.txtForm
		ListBox 320,273,310,42,strDistUse(),.lstDistAnalyze
	End Dialog
	Dim dlg As UserDialog
	Dialog dlg
End Sub

Sub DialogEditInfo(strDialogItem As String, intAction As Integer, intSuppValue As Integer)
    Select Case intAction
	    Case 4 ' получение фокуса
	    	Select Case strFocus
	    		Case "Quanta", "loQuanta", "hiQuanta"
	    			Select Case strFocus
			    		Case "Quanta"
			    			Quanta=Val(DlgText("Quanta"))
	    					If (Quanta<loQuanta) Then loQuanta=Quanta
	    					If (Quanta>hiQuanta) Then hiQuanta=Quanta
	    				Case "loQuanta"
		    				loQuanta=Val(DlgText("loQuanta"))
		    				If (loQuanta>Quanta) Then Quanta=loQuanta
		    				If (loQuanta>hiQuanta) Then hiQuanta=loQuanta
		    			Case "hiQuanta"
	    					hiQuanta=Val(DlgText("hiQuanta"))
	    					If (hiQuanta<Quanta) Then Quanta=hiQuanta
		    				If (hiQuanta<loQuanta) Then loQuanta=hiQuanta
		    		End Select
		    		DlgText "Quanta",Format(Quanta,"####0.######")
		    		DlgText "loQuanta",Format(loQuanta,"####0.######")
		    		DlgText "hiQuanta",Format(hiQuanta,"####0.######")
	    		Case "Quantb", "loQuantb", "hiQuantb"
	    			Select Case strFocus
			    		Case "Quantb"
			    			Quantb=Val(DlgText("Quantb"))
	    					If (Quantb<loQuantb) Then loQuantb=Quantb
	    					If (Quantb>hiQuantb) Then hiQuantb=Quantb
	    				Case "loQuantb"
		    				loQuantb=Val(DlgText("loQuantb"))
		    				If (loQuantb>Quantb) Then Quantb=loQuantb
		    				If (loQuantb>hiQuantb) Then hiQuantb=loQuantb
		    			Case "hiQuantb"
	    					hiQuantb=Val(DlgText("hiQuantb"))
	    					If (hiQuantb<Quantb) Then Quantb=hiQuantb
		    				If (hiQuantb<loQuantb) Then loQuantb=hiQuantb
		    		End Select
		    		DlgText "Quantb",Format(Quantb,"####0.######")
		    		DlgText "loQuantb",Format(loQuantb,"####0.######")
		    		DlgText "hiQuantb",Format(hiQuantb,"####0.######")
	    		Case "Shape1", "loShape1", "hiShape1"
	    			Select Case strFocus
			    		Case "Shape1"
			    			Shape1=Val(DlgText("Shape1"))
	    					If (Shape1<loShape1) Then loShape1=Shape1
	    					If (Shape1>hiShape1) Then hiShape1=Shape1
	    				Case "loShape1"
		    				loShape1=Val(DlgText("loShape1"))
		    				If (loShape1>Shape1) Then Shape1=loShape1
		    				If (loShape1>hiShape1) Then hiShape1=loShape1
		    			Case "hiShape1"
	    					hiShape1=Val(DlgText("hiShape1"))
	    					If (hiShape1<Shape1) Then Shape1=hiShape1
		    				If (hiShape1<loShape1) Then loShape1=hiShape1
		    		End Select
		    		DlgText "Shape1",Format(Shape1)
		    		DlgText "loShape1",Format(loShape1)
		    		DlgText "hiShape1",Format(hiShape1)
				xShape1(iDist,0)=loShape1
				xShape1(iDist,1)=Shape1
				xShape1(iDist,2)=hiShape1
	    			If (qRelation=2) Then
	    				Shape2=Shape1
	    				loShape2=loShape1
	    				hiShape2=hiShape1
		    			DlgText "Shape2",Format(Shape2)
		    			DlgText "loShape2",Format(loShape2)
	    				DlgText "hiShape2",Format(hiShape2)
	    			End If
	    			If (qRelation=1) Then
	    				If (Shape1<0.001) Then Shape1=0.001
	    				If (loShape1<0.001) Then loShape1=0.001
	    				If (hiShape1<0.001) Then hiShape1=0.001
		    			DlgText "Shape1",Format(Shape1)
		    			DlgText "loShape1",Format(loShape1)
	    				DlgText "hiShape1",Format(hiShape1)
	    			End If
				xShape2(iDist,0)=loShape2
				xShape2(iDist,1)=Shape2
				xShape2(iDist,2)=hiShape2
	    		Case "Shape2", "loShape2", "hiShape2"
	    			Select Case strFocus
			    		Case "Shape2"
			    			Shape2=Val(DlgText("Shape2"))
	    					If (Shape2<loShape2) Then loShape2=Shape2
	    					If (Shape2>hiShape2) Then hiShape2=Shape2
	    				Case "loShape2"
		    				loShape2=Val(DlgText("loShape2"))
		    				If (loShape2>Shape2) Then Shape2=loShape2
		    				If (loShape2>hiShape2) Then hiShape2=loShape2
		    			Case "hiShape2"
	    					hiShape2=Val(DlgText("hiShape2"))
	    					If (hiShape2<Shape2) Then Shape2=hiShape2
		    				If (hiShape2<loShape2) Then loShape2=hiShape2
		    		End Select
	    			If (qRelation=3) Then
	    				If (Shape2<0.001) Then Shape2=0.001
	    				If (loShape2<0.001) Then loShape2=0.001
	    				If (hiShape2<0.001) Then hiShape2=0.001
		    			DlgText "Shape2",Format(Shape2)
		    			DlgText "loShape2",Format(loShape2)
	    				DlgText "hiShape2",Format(hiShape2)
	    			End If
		    		DlgText "Shape2",Format(Shape2,"####0.######")
		    		DlgText "loShape2",Format(loShape2,"####0.######")
		    		DlgText "hiShape2",Format(hiShape2,"####0.######")
				xShape2(iDist,0)=loShape2
				xShape2(iDist,1)=Shape2
				xShape2(iDist,2)=hiShape2
	    		Case "Shape3", "loShape3", "hiShape3"
	    			Select Case strFocus
			    		Case "Shape3"
			    			Shape3=Val(DlgText("Shape3"))
	    					If (Shape3<loShape3) Then loShape3=Shape3
	    					If (Shape3>hiShape3) Then hiShape3=Shape3
	    				Case "loShape3"
		    				loShape3=Val(DlgText("loShape3"))
		    				If (loShape3>Shape3) Then Shape3=loShape3
		    				If (loShape3>hiShape3) Then hiShape3=loShape3
		    			Case "hiShape3"
	    					hiShape3=Val(DlgText("hiShape3"))
	    					If (hiShape3<Shape3) Then Shape3=hiShape3
		    				If (hiShape3<loShape3) Then loShape3=hiShape3
		    		End Select
		    		DlgText "Shape3",Format(Shape3,"####0.######")
		    		DlgText "loShape3",Format(loShape3,"####0.######")
		    		DlgText "hiShape3",Format(hiShape3,"####0.######")
	    	End Select
	    	If (strDialogItem<>"cmdBack") Then 	Call ResetEditMode(0)
	End Select
End Sub