/* ******************************************
** Column Selector Freeware for ChemBasic  **
**                                         **
** Version 9.00, Build: 01 May 2006        **
**                                         **
** Current number of columns: 187          **
**                                         **
** Robin Martin                            **
** Advanced Chemistry Development, Inc     **
**                                         **
******************************************* */
Const licfle="license.txt"
Const lf="lc.txt"
Const columndb="columndata.txt"
Const collistdb="collist.txt"
Const FrmMnColLst="SelColMainForm.frm"
const FrmCompCols="SelColCompCol.frm"
Const FrmStart="SelColStart.frm"
Const StrtSel1="Compare Column vs List"
Const StrtSel2="Compare two columns"
Const NumCols=187
Const HdLabl="kPB      aCH2     aTO      aCP     aBP76     aBP27"
Const Header="Rank   (CDF)       Column Name"
Const rankp=1
Const rankl=7
Const cdfp=8
Const cdfl=11
Const colp=20
Const coll=49
Const kpos=70
Const kposl=9
Const chpos=80
Const chposl=9
Const topos=90
Const toposl=9
Const cppos=100
Const cpposl=9
Const bp76pos=110
Const bp76posl=10
Const bp27pos=121
Const bp27posl=10
Const spstng="                                                                                  "
Const lp=153
Const tp=156
Const wp=2013
Const hp=81
Const ltg=153
Const ttg=247
Const wtg=2014
Const htg=81

' Textbox bounds for column list
Const llst=172
Const tlst=953
Const wlst=1017
Const hlst=2115
Const l2lst=1266
Const t2lst=953
Const w2lst=1017
Const h2lst=2115

' Textbox bounds for the six column parameters
' l=1191,t=953,w=135,h=2115
' l=1376,t=953,w=135,h=2115
' l=1561,t=953,w=135,h=2115
' l=1746,t=953,w=135,h=2115
' l=1931,t=953,w=135,h=2115
' l=2116,t=953,w=135,h=2115
'
' Texbox bound for target column
' l=163,t=853,w=1005,h=47
'
' Textbox bound for column parameters for target column
' Parameter labels are also in this box.
' l=1191,t=761,w=135,h=162
' l=1376,t=761,w=135,h=162
' l=1561,t=761,w=135,h=162
' l=1746,t=761,w=135,h=162
' l=1931,t=761,w=135,h=162
' l=2116,t=761,w=135,h=162
'
' Textbox bounds for Column Vs Column comparison
'
' Textbox for CDF
' l=213,t=813,w=416,h=91
'
' Textbox for column names
' l=169,t=1022,w=1147,h=273
'
' Textbox for parmeters
' l=1469,t=924,w=179,h=364
' l=1629,t=928,w=160,h=364



'
'first line is a dummy name,avgkPB,avgaCH2,avgaTO,avgaCP,avgaBP76,avgBP27,stdkPB,stdaCH2,stdaTO,stdaCP,stdaBP76,stdaBP27
' columndata listing order
'ColName,kPB,aCH2,aTO,aCP,aBP76,aBP27,kPBs,aCH2s,aTOs,aCPs,aBP76s,aBP27s
'
Public dim SortedColumns() as string
Public dim CDFlst() as double
Public dim wtkPB,wtaCH2,wtaTO,wtaCP,wtaBP76,wtaBP27 as double 'weighting values for parameters
Public dim tgakPB,tgaCH2,tgaTO,tgaCP,tgaBP76,tgaBP27 as double 'raw parameters for target column
Public dim tgskPB,tgsaCH2,tgsaTO,tgsaCP,tgsaBP76,tgsaBP27 as double 'normalized parameters for target column
function main as string

Dim tdoc,pag1,pag2,pag3,partbx,tgtbx,lstbx as object
dim tcb,tp1,tp2,tp3,tp4,tp5,tp6,clstb,lp1,lp2,lp3,lp4,lp5,lp6,cdftb,cl1stb,cl2stb as object
dim tp1s,tp2s,tp3s,tp4s,tp5s,tp6s,lp1s,lp2s,lp3s,lp4s,lp5s,lp6s,cdftbc as string
dim ColumnNames(188) as string
dim Cmp1(12) as double
dim Cmp2(12) as double
dim Done,SelMd,flg1,flg2,lck as boolean
dim indx,cmmpos,oldpos,i,trgidx,lorln,pgc,x,flld,ntbe, C1idx, C2idx,colct as integer
dim LineOfRec,TargetCol,tgtbc,lstbc,sct,oputs,CmpCol1,CmpCol2,Col1ost,Col2ost,mess,cdfres,rnp,fntpad,licmess as string
dim Form as object
dim dist as double

main="You pressed CANCEL. GOODBYE!!"

if Documents.Count > 8 then
	main="You have too many ChemSketch documents open.  You must close some of these documents before you can run Column Selector."
	Goto Fin
end if

tdoc=Documents.AddFromFile("colselsplash.sk2", FT_SKETCH)

for x = 1 to 250000
next x

/* ***************************************************************************************
*                                                                                        *
* This section checks to see if the licence agreement has been accepted.                 *
* It requires write permission to the file lc.txt.  If this program is installed         *
* in a location where the user does not have write permission, then the program crashes. *
*                                                                                        *
* Remove the comment symbols from this section to make use of reading the licence        *
* during the first run of the software.                                                  *
**************************************************************************************** */

/*  <- Remove this comment mark to restore licence check
lck=LicStrt() 'Check to see if the license was accepted already
if lck=False then 'License has not been accepted yet or this is first time program has been run
	MessageBox("This is your first time running this program or you never accepted the license agreement on a previous execution." + chr(13) + chr(13) + "You must accept the license agreement in order to continue using the program." + chr(13) + chr(13) + "Once accepted, you will not see the license agreement screen on subsequent program executions.","License Agreement Acceptance",MBI_EXCLAMATION+MBB_OK)
	
	Call GetLicInf(licmess)
	i=MessageBox(licmess,"License Agreement Acceptance",MBB_YESNO+MBI_EXCLAMATION) 'Show the License agreement
	if i=MBR_NO then  'Licence not accepted
		Call Kill(tdoc)
		main="You must accept the license agreement in order to use the program!"
		goto Fin  'Goto program termination step
	else
		open lf access write as 6  'License was accepted so change flag to YES
		LineOfRec="YES"
		print #6, LineOfRec
		close #6
	end if

end if
*/
' Remove the comment end mark above to restore licence check
Call Kill(tdoc)
indx=1

Open collistdb Access read as 1   'Read in column names list and fill ColumnNames array
eof #1, Done
while not Done
	read #1, LineOfRec, 200
	ColumnNames(indx)=trim(LineOfRec)
	indx=indx+1
	eof #1, Done
wend
Close #1	
SelMd=SelCompMde()
if SelMd=False then  'Comparing two columns mode
SA:
	Form=ReadForm(FrmCompCols)
	If Form.ExecForm Then
		CmpCol1=Form.GetStrValue("ColumnList")
		CmpCol2=Form.GetStrValue("ColumnList2")
		wtkPB=Form.GetDblValue("kPB")
		wtaCH2=Form.GetDblValue("aCH2")
		wtaTO=Form.GetDblValue("aTO")
		wtaCP=Form.GetDblValue("aCP")
		wtaBP76=Form.GetDblValue("aBP76")
		wtaBP27=Form.GetDblValue("aBP27")
		If CmpCol1=CmpCol2 then
			messagebox("You must choose different columns!","Duplicate Columns",MBB_OK+MBI_EXCLAMATION)
			Goto SA
		end if
		lstbc="Column 1: "+CmpCol1+chr(13)+chr(13)+"Column 2: "+CmpCol2
		for i=1 to NumCols
			if CmpCol1=ColumnNames(i) then C1idx=i
			if CmpCol2=ColumnNames(i) then C2idx=i
		next i
		Open columndb Access read as 2
		read #2, LineOfRec, 200
		flg1=False
		flg2=False
		for i = 1 to NumCols
			if (flg1 and flg2) then exit for
			read #2, LineOfRec, 200
			if (flg1=False) and (i=C1idx) then
				Call DecompColPms(LineOfRec,Cmp1(7),Cmp1(8),Cmp1(9),Cmp1(10),Cmp1(11),Cmp1(12))
				Col1ost=LineOfRec
				flg1=True
			end if
			if (flg2=False) and (i=C2idx) then
				Call DecompColPms(LineOfRec,Cmp2(7),Cmp2(8),Cmp2(9),Cmp2(10),Cmp2(11),Cmp2(12))
				Col2ost=LineOfRec
				flg2=True
			end if
		next i
		close #2
		dist=calceucdist(Cmp1(7), Cmp2(7), wtkPB, Cmp1(8), Cmp2(8), wtaCH2, Cmp1(9), Cmp2(9), wtaTO, Cmp1(10), Cmp2(10), wtaCP, Cmp1(11), Cmp2(11), wtaBP76, Cmp1(12), Cmp2(12), wtaBP27)
		cdfres=FStr(dist,7,3)
		mess="CDF = "+FStr(dist,7,3)+chr(13)
		oldpos=1
		for x=1 to 7
			cmmpos=InStr(oldpos,Col1ost,"*")
			select case x
				case 1 'column
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+":"+chr(13)
				case 2 'kPB
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+","
					Cmp1(1)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case 3 'aCH2
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+","
					Cmp1(2)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case 4 'aTO
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+","
					Cmp1(3)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case 5 'aCP
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+","
					Cmp1(4)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case 6 'aBP76
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+","
					Cmp1(5)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case 7 'aBP27
					mess=mess+mid(Col1ost,oldpos,cmmpos-oldpos)+chr(13)
					Cmp1(6)=val(mid(Col1ost,oldpos,cmmpos-oldpos))
				case else
					messagebox("there is a problem","mess",MBB_OK)
			end select
			oldpos=cmmpos+1
		next x
		oldpos=1
		for x=1 to 7
			cmmpos=InStr(oldpos,Col2ost,"*")
			select case x
				case 1 'column
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+":"+chr(13)
				case 2 'kPB
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+","
					Cmp2(1)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case 3 'aCH2
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+","
					Cmp2(2)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case 4 'aTO
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+","
					Cmp2(3)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case 5 'aCP
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+","
					Cmp2(4)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case 6 'aBP76
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+","
					Cmp2(5)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case 7 'aBP27
					mess=mess+mid(Col2ost,oldpos,cmmpos-oldpos)+chr(13)
					Cmp2(6)=val(mid(Col2ost,oldpos,cmmpos-oldpos))
				case else
					messagebox("there is a problem","mess",MBB_OK)
			end select
			oldpos=cmmpos+1
		next x
		messagebox(mess,"Results of Comparison",MBB_OK+MBI_INFORMATION)
		i=messagebox("Do you want to create a report of the results?","Create Report",MBB_YESNO+MBI_QUESTION)
		if i=MBR_YES then
			tdoc=ChgTempl("singletmpl.sk2")
			pag1=tdoc.Item(1)
			cdftb=pag1.TextBoxes.AddEmpty
			clstb=pag1.TextBoxes.AddEmpty
			lp1=pag1.TextBoxes.AddEmpty
			lp2=pag1.TextBoxes.AddEmpty
			lp3=pag1.TextBoxes.AddEmpty
			lp4=pag1.TextBoxes.AddEmpty
			lp5=pag1.TextBoxes.AddEmpty
			lp6=pag1.TextBoxes.AddEmpty
			cdftbc="CDF = "+cdfres
			cdftb.SetContent(cdftbc)
			cdftb.SetBound(175,848,416,47)		
			clstb.SetContent(lstbc)
			clstb.SetBound(166,1023,1147,94)
			lp1s="kPB"+chr(13)+"("+FStr(wtkPB,4,2)+")"+chr(13)+str(Cmp1(1))+chr(13)+chr(13)+str(Cmp2(1))
			lp2s="aCH2"+chr(13)+"("+FStr(wtkPB,4,2)+")"+chr(13)+str(Cmp1(2))+chr(13)+chr(13)+str(Cmp2(2))
			lp3s="aTO"+chr(13)+"("+FStr(wtaTO,4,2)+")"+chr(13)+str(Cmp1(3))+chr(13)+chr(13)+str(Cmp2(3))
			lp4s="aCP"+chr(13)+"("+FStr(wtaCP,4,2)+")"+chr(13)+str(Cmp1(4))+chr(13)+chr(13)+str(Cmp2(4))
			lp5s="aBP76"+chr(13)+"("+FStr(wtaBP76,4,2)+")"+chr(13)+str(Cmp1(5))+chr(13)+chr(13)+str(Cmp2(5))
			lp6s="aBP27"+chr(13)+"("+FStr(wtaBP27,4,2)+")"+chr(13)+str(Cmp1(6))+chr(13)+chr(13)+str(Cmp2(6))
			lp1.SetContent(lp1s)
			lp1.SetBound(1228,929,135,141)
			lp2.SetContent(lp2s)
			lp2.SetBound(1413,929,135,141)
			lp3.SetContent(lp3s)
			lp3.SetBound(1598,929,135,141)
			lp4.SetContent(lp4s)
			lp4.SetBound(1783,929,135,141)
			lp5.SetContent(lp5s)
			lp5.SetBound(1968,929,135,141)
			lp6.SetContent(lp6s)
			lp6.SetBound(2153,929,135,141)
			main="Done!"
		end if
	end if ' form end if
	
	goto Fin		
end if

/* Compare selected target column versus rest of the list */

tdoc=ChgTempl("template.sk2")
pag1=tdoc.Item(1)
pag2=tdoc.Item(2)
pag3=tdoc.Item(3)

Form=ReadForm(FrmMnColLst)
If Form.ExecForm Then
	TargetCol=Form.GetStrValue("ColumnList")
	wtkPB=Form.GetDblValue("kPB")
	wtaCH2=Form.GetDblValue("aCH2")
	wtaTO=Form.GetDblValue("aTO")
	wtaCP=Form.GetDblValue("aCP")
	wtaBP76=Form.GetDblValue("aBP76")
	wtaBP27=Form.GetDblValue("aBP27")

	for i = 1 to NumCols
		if TargetCol=ColumnNames(i) then trgidx=i   'Find index number of selected column
	next i
	Open columndb Access read as 2
	read #2, LineOfRec, 200
	for i = 1 to NumCols
		read #2, LineOfRec, 200
		if i=trgidx then
			'need to extract parameters and normalized paramters
			Call DecompTrgVls(LineOfRec)
			exit for
		end if
	next i
	close #2
	' begin the CDF calculations
	Call CompColDifFac(SortedColumns,CDFlst,TargetCol,trgidx)
	'
	' Display output of calculations
	'
	'build a table dynamically by printing a textbox with "rank..cdf..colnm..kpb..ach2..ato..acp..abp76..abp27"
	'

	tgtbc="Target Column: "+TargetCol
	tcb=pag1.TextBoxes.AddEmpty
	tcb.SetContent(tgtbc)
	tcb.SetBound(163,853,1005,47)
	ntbe=0
	pgc=1
	colct=1
	lstbc=Header+chr(13)
	tp1=pag1.TextBoxes.AddEmpty
	tp2=pag1.TextBoxes.AddEmpty
	tp3=pag1.TextBoxes.AddEmpty
	tp4=pag1.TextBoxes.AddEmpty
	tp5=pag1.TextBoxes.AddEmpty
	tp6=pag1.TextBoxes.AddEmpty
	tp1s="":tp2s="":tp3s="":tp4s="":tp5s="":tp6s=""
	tp1s="kPB"+chr(13)+"("+FStr(wtkPB,4,2)+")"+chr(13)+str(tgakPB)
	tp2s="aCH2"+chr(13)+"("+FStr(wtaCH2,4,2)+")"+chr(13)+str(tgaCH2)
	tp3s="aTO"+chr(13)+"("+FStr(wtaTO,4,2)+")"+chr(13)+str(tgaTO)
	tp4s="aCP"+chr(13)+"("+FStr(wtaCP,4,2)+")"+chr(13)+str(tgaCP)
	tp5s="aBP76"+chr(13)+"("+FStr(wtaBP76,4,2)+")"+chr(13)+str(tgaBP76)
	tp6s="aBP27"+chr(13)+"("+FStr(wtaBP27,4,2)+")"+chr(13)+str(tgaBP27)
	tp1.SetContent(tp1s)
	tp1.SetBound(1191,761,135,162)
	tp2.SetContent(tp2s)
	tp2.SetBound(1376,761,135,162)
	tp3.SetContent(tp3s)
	tp3.SetBound(1561,761,135,162)
	tp4.SetContent(tp4s)
	tp4.SetBound(1746,761,135,162)
	tp5.SetContent(tp5s)
	tp5.SetBound(1931,761,135,162)
	tp6.SetContent(tp6s)
	tp6.SetBound(2116,761,135,162)
	cl1stb=pag1.TextBoxes.AddEmpty
	cl2stb=pag1.TextBoxes.AddEmpty
	for i=1 to NumCols-1
		oputs=""
		sct=SortedColumns(i)
	
		oputs=left(str(i)+"."+spstng,rankl)
		oputs=oputs+Left("("+FStr(CDFlst(i),7,3)+")"+spc(10),cdfl)
	
		oldpos=1
		cmmpos=InStr(oldpos,sct,"*")
		oputs=oputs+mid(sct,oldpos,cmmpos-oldpos)
		lstbc=lstbc+oputs+chr(13)
		ntbe=ntbe+1
		' check to see if lstis filled to 45 which is max number of rows for output
	
		if ntbe=45 or (i=NumCols-1) then
			select case colct
				case 1
					cl1stb.SetContent(lstbc)
					cl1stb.SetBound(llst,tlst,wlst,hlst)
					lstbc=""
					lstbc=Header+chr(13)
					colct=2
				case 2
					cl2stb.SetContent(lstbc)
					cl2stb.SetBound(l2lst,t2lst,w2lst,h2lst)
					lstbc=""
					lstbc=Header+chr(13)
					colct=1
					select case pgc
						case 1
							pgc=pgc+1
							tcb=pag2.TextBoxes.AddEmpty
							tcb.SetContent(tgtbc)
							tcb.SetBound(163,853,1005,47)
							tp1=pag2.TextBoxes.AddEmpty
							tp2=pag2.TextBoxes.AddEmpty
							tp3=pag2.TextBoxes.AddEmpty
							tp4=pag2.TextBoxes.AddEmpty
							tp5=pag2.TextBoxes.AddEmpty
							tp6=pag2.TextBoxes.AddEmpty
							tp1.SetContent(tp1s)
							tp1.SetBound(1191,761,135,162)
							tp2.SetContent(tp2s)
							tp2.SetBound(1376,761,135,162)
							tp3.SetContent(tp3s)
							tp3.SetBound(1561,761,135,162)
							tp4.SetContent(tp4s)
							tp4.SetBound(1746,761,135,162)
							tp5.SetContent(tp5s)
							tp5.SetBound(1931,761,135,162)
							tp6.SetContent(tp6s)
							tp6.SetBound(2116,761,135,162)
							cl1stb=pag2.TextBoxes.AddEmpty
							cl2stb=pag2.TextBoxes.AddEmpty
						case 2
							pgc=pgc+1
							tcb=pag3.TextBoxes.AddEmpty
							tcb.SetContent(tgtbc)
							tcb.SetBound(163,853,1005,47)
							tp1=pag3.TextBoxes.AddEmpty
							tp2=pag3.TextBoxes.AddEmpty
							tp3=pag3.TextBoxes.AddEmpty
							tp4=pag3.TextBoxes.AddEmpty
							tp5=pag3.TextBoxes.AddEmpty
							tp6=pag3.TextBoxes.AddEmpty
							tp1.SetContent(tp1s)
							tp1.SetBound(1191,761,135,162)
							tp2.SetContent(tp2s)
							tp2.SetBound(1376,761,135,162)
							tp3.SetContent(tp3s)
							tp3.SetBound(1561,761,135,162)
							tp4.SetContent(tp4s)
							tp4.SetBound(1746,761,135,162)
							tp5.SetContent(tp5s)
							tp5.SetBound(1931,761,135,162)
							tp6.SetContent(tp6s)
							tp6.SetBound(2116,761,135,162)
							cl1stb=pag3.TextBoxes.AddEmpty
							cl2stb=pag3.TextBoxes.AddEmpty
					end select


			end select
			ntbe=0
		end if
				
	next i


	ActiveDocument.SetActivePage(pag1)
	main="Done!"
end if ' column form end if
	
Fin:

End Function 'Main 



/* *********************************************************************************************************
** Function to calculate the weighted Euclidean distance between two, multi-coordinate points (P1 and P2) **
**                                                                                                        **
**             Dist = SQRT[ (x1-x2)^2 + (y1-y2)^2 + ... + (n1-n2)^2 ]                                     **
**             where P1 has the coordinates (x1,y1,...,n1)                                                **
**               and P2 has the coordinates (x2,y2,...,n2)                                                **
**                                                                                                        **
********************************************************************************************************** */
Function calceucdist(p1s as double, p1c as double, wkpb as double, p2s as double, p2c as double, wach2 as double, p3s as double, p3c as double, wato as double, p4s as double, p4c as double, wacp as double, p5s as double, p5c as double, wbp76 as double, p6s as double, p6c as double, wbp27 as double) as double
Dim p1,p2,p3,p4,p5,p6 as double
Dim Ns,Ws as double

p1=p1s-p1c
p2=p2s-p2c
p3=p3s-p3c
p4=p4s-p4c
p5=p5s-p5c
p6=p6s-p6c

Ns=wkpb*(p1^2)+wach2*(p2^2)+wato*(p3^2)+wacp*(p4^2)+wbp76*(p5^2)+wbp27*(p6^2)
Ws=wkpb+wach2+wato+wacp+wbp76+wbp27

calceucdist=sqrt(Ns/Ws)

End Function 'calceucdist

/* *******************************************************************************************************************
**                                                                                                                  **
** Subroutine to set up calculation of the Column Difference Factor for selected column versus the list of columns  **
**                                                                                                                  **
******************************************************************************************************************** */
Sub CompColDifFac(SortedColumns() as string, CDFlst() as double,targ as string,tidx as integer)
Dim ct as Integer
Dim dist as double
Dim LineOfRec as String
Dim vkPB,vaCH2,vaTO,vaCP,vaBP76,vaBP27 as double

Call InitArrys(SortedColumns,CDFlst)

Open columndb Access read as 3
read #3, LineOfRec, 200
For ct= 1 to NumCols
	read #3, LineOfRec, 200
	if ct=tidx then goto L1
        Call DecompColPms(LineOfRec, vkPB, vaCH2, vaTO, vaCP, vaBP76, vaBP27)
        dist=calceucdist(tgskPB, vkPB, wtkPB, tgsaCH2, vaCH2, wtaCH2, tgsaTO, vaTO, wtaTO, tgsaCP, vaCP, wtaCP, tgsaBP76, vaBP76, wtaBP76, tgsaBP27, vaBP27, wtaBP27)
        CDFlst(ct)=dist  'USe with sort routine
        SortedColumns(ct)=LineOfRec  'use with sort routine 
L1:        
Next ct

Call SrtArrys(CDFlst,SortedColumns)

End Sub

/* *******************************************************************
**                                                                  **
** Routine to sort arrays in ascending order                        **
**                                                                  **
** highpnt = Maximum number of elements in the Array being sorted   **
**           This should be an even number. If number of elements   **
**           is odd, then highpnt + 1 greater                       **
**                                                                  **
** StackLow and StackHigh array elements should be set to highpnt/2 **
**                                                                  **
******************************************************************** */
Sub SrtArrys(CDFlst() as double, SortedColumns() as string)
Dim StackLow(94) as Integer
Dim StackHigh(94) as Integer
Dim stackpt as Integer
Dim lowpnt as Integer
Dim highpnt as Integer
Dim low as Integer
Dim high as Integer
Dim middle as Integer
Dim lowbnd as Integer
Dim highbnd as Integer
Dim compre as double
Dim tempflt as double
Dim tempstg as String
lowpnt=1
highpnt=188
stackpt=1
StackLow(stackpt)=lowpnt
StackHigh(stackpt)=highpnt
stackpt=stackpt+1
Do WHILE stackpt <> 1
    stackpt=stackpt-1
    low=StackLow(stackpt)
    high=StackHigh(stackpt)
    Do WHILE low < high
        lowbnd=low
        highbnd=high
        middle=int((low + high)/2)
        compre=CDFlst(middle)
        Do WHILE lowbnd<=highbnd
            Do WHILE CDFlst(lowbnd)<compre
                lowbnd=lowbnd+1
            Loop
            Do WHILE CDFlst(highbnd)>compre
                highbnd=highbnd-1
            Loop
            If lowbnd<=highbnd Then
                tempflt=CDFlst(lowbnd)
                tempstg=SortedColumns(lowbnd)
                CDFlst(lowbnd)=CDFlst(highbnd)
                SortedColumns(lowbnd)=SortedColumns(highbnd)
                CDFlst(highbnd)=tempflt
                SortedColumns(highbnd)=tempstg
                lowbnd=lowbnd+1
                highbnd=highbnd-1
            End If
        Loop
        If (highbnd-low) < (high-lowbnd) Then
            If lowbnd < high Then
                StackLow(stackpt)=lowbnd
                StackHigh(stackpt)=high
                stackpt=stackpt+1
            End If
            high=highbnd
        Else
            If low < highbnd Then
                StackLow(stackpt)=low
                StackHigh(stackpt)=highbnd
                stackpt=stackpt+1
            End If
            low=lowbnd
        End If
    Loop
Loop

End Sub

/* *******************************************************
**                                                      **
** Subroutine to Initialize arrays with default values  **
**                                                      **
******************************************************** */
Sub InitArrys(SortedColumns() as string, CDFlst() as double)
Dim x as Integer
Redim SortedColumns(1 to 188)
Redim CDFlst(1 to 188)
For x=1 to 188
    SortedColumns(x)="-"
    
    CDFlst(x)=10000 ' use with sort routine
Next x
End Sub

/* **************************************************************************************************
**                                                                                                 **
** Subroutine to extract the raw column parameters and the normalized values for the target column **
**                                                                                                 **
*************************************************************************************************** */
Sub DecompTrgVls(lors as string)

dim sl,cmmposold,cmmpos,max,ct as integer
dim tmps as string
max=14
ct=1
cmmposold=1
sl=len(lors)
while ct<max
	cmmpos=InStr(cmmposold,lors,",")
	if ct<>1 then
		select case ct
			case 2 
				tgakPB=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 3
				tgaCH2=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 4	
				tgaTO=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 5
				tgaCP=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 6
				tgaBP76=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 7
				tgaBP27=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 8
				tgskPB=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 9	
				tgsaCH2=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 10	
				tgsaTO=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 11	
				tgsaCP=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 12	
				tgsaBP76=val(mid(lors,cmmposold,cmmpos-cmmposold))
			case 13	
				tgsaBP27=val(mid(lors,cmmposold,cmmpos-cmmposold))
		end select
	end if
	ct=ct+1
	cmmposold=cmmpos+1
wend

end sub 'DecompTrgVls

/* *************************************************************************************
**                                                                                    **
** Subroutine to extract the raw and normalized parameters for a column from the list **
** Column name and raw parameters are combined in a string for display                **
**                                                                                    **
************************************************************************************** */
sub DecompColPms(lors as string, ckPB as double, caCH2 as double, caTO as double, caCP as double, caBP76 as double, caBP27 as double)
dim colnm,tkPB,taCH2,taTO,taCP,taBP76,taBP27 as string
dim sl,cmmposold,cmmpos,max,ct as integer
max=14
sl=len(lors)
cmmposold=1
ct=1
while ct<max
	cmmpos=InStr(cmmposold,lors,",")
	select case ct
		case 1
			colnm=mid(lors,cmmposold,cmmpos-cmmposold)
		case 2
			tkPB=mid(lors,cmmposold,cmmpos-cmmposold)
		case 3
			taCH2=mid(lors,cmmposold,cmmpos-cmmposold)
		case 4
			taTO=mid(lors,cmmposold,cmmpos-cmmposold)
		case 5
			taCP=mid(lors,cmmposold,cmmpos-cmmposold)
		case 6
			taBP76=mid(lors,cmmposold,cmmpos-cmmposold)
		case 7
			taBP27=mid(lors,cmmposold,cmmpos-cmmposold)
		case 8
			ckPB=val(mid(lors,cmmposold,cmmpos-cmmposold))
		case 9
			caCH2=val(mid(lors,cmmposold,cmmpos-cmmposold))
		case 10
			caTO=val(mid(lors,cmmposold,cmmpos-cmmposold))
		case 11
			caCP=val(mid(lors,cmmposold,cmmpos-cmmposold))
		case 12
			caBP76=val(mid(lors,cmmposold,cmmpos-cmmposold))
		case 13
			caBP27=val(mid(lors,cmmposold,cmmpos-cmmposold))
	end select
	ct=ct+1
	cmmposold=cmmpos+1
wend
lors=colnm+"*"+tkpb+"*"+taCH2+"*"+taTO+"*"+taCP+"*"+taBP76+"*"+taBP27+"*"	
end sub 'DecompColPms 

/* *********************************************************************
**                                                                    ** 
** Function to call the form to select which calculation mode to use  **
**                                                                    **
**   True is for Column vs list; False is for comparing two columns   **
**                                                                    **
********************************************************************** */
Function SelCompMde() as boolean
dim Frm as object
dim slc as string
slc=""
Frm=ReadForm(FrmStart)
If Frm.ExecForm Then
	slc=Frm.GetStrValue("Selection")

	if slc=StrtSel1 then
		SelCompMde=True
	else
		SelCompMde=False
	end if
end if
if slc="" then
	Stop "You pressed CANCEL. GOODBYE!!"
end if
end function

/* ***************************************************************************************
**                                                                                      **
** Read in the template file and make a copy of it so that it does not get over written **
**                                                                                      **
**************************************************************************************** */
function ChgTempl(byval tmpflnm as string) as object
dim OrgDoc,npg,CurrDoc,orgpag,curpag,curobj as object
dim orgpgct,x,y,nobs as integer 
OrgDoc=Documents.AddFromFile(tmpflnm,2) 'Load the template file
orgpgct=OrgDoc.Count                    'Get the number of pages in the template                 
CurrDoc=Documents.AddEmpty              'Create the new blank document          
npg=CurrDoc.Item(1)
if orgpgct>1 then	                'Create blank pages in the new document to match the number in the template
	for x = 2 to orgpgct
		npg=CurrDoc.AddEmpty           
	next x
end if 
for x = 1 to orgpgct                   
	orgpag=OrgDoc.Item(x)
	curpag=CurrDoc.Item(x)
	nobs=orgpag.Drawings.Count      'Get the total number of objects (textboxes, images) on the current page
	for y = 1 to nobs
		curobj=orgpag.Drawings.Item(y)   'Get the current object
		curobj.LoadOnto(curpag)          'Load the object on the new page
	next y
next x
Call Kill(OrgDoc)              'Close the template file                    
CurrDoc.SetActiveDocument                
curpag=CurrDoc.Item(1)
CurrDoc.SetActivePage(curpag)  'Make the first page of the document the current active page         
ChgTempl=CurrDoc
end function

/* ******************************************************************************************************************
**                                                                                                                 **
** Check contents of lc.txt file which contains the flag to determine if the License Agreement has been accepted.  **
**                                                                                                                 **
** If flag is NO, then LicStrt() is false and License agreement needs to be shown.                                 **
** If flag is YES then LicStrt() is true and License agreement does not need to be shown                           **
**                                                                                                                 **
******************************************************************************************************************* */	
function LicStrt() as boolean
dim s as string

open lf access read as 5
	read #5, s, 5
close #5

if left(s,2)="NO" then
	LicStrt=False

else
	LicStrt=True
end if

end function

/* *********************************************************************
**                                                                    **
** Read in the text of the license agreement into one string variable **
**                                                                    **
********************************************************************** */
Sub GetLicInf(tmpshld as string)
dim lor as string
dim Done as boolean
tmpshld=""
lor=""
open licfle access read as 7
eof #7, Done
while not Done
	read #7, lor, 600
	tmpshld=tmpshld+lor+chr(13)
	lor=""
	eof #7, Done
wend
close #7

end sub