{This program will generate a combined image (array of ratio images) 
in a grid with specified step. 



created 13/01/2002 by V.Lobastov Ver. 08}

const

{	 			   	  			 	  	 	 		   		 		 										--->>OLD
	 Path ='D:\DATA\';								//Base path
	 PathU ='D:\DATA\Utilities\'; 		 			//default Utilities directory
	 PathR ='D:\DATA\Utilities\XYarrayNEW\';		//default directory for polar images    		  
	 DM ='AppCOT.tif';								//default Mask
	 														  	  				  					  		<<---OLD
}
	 	  P ='D:\DATA\Utilities\Delays\*.ini'; 		 	  //default directory for INI file

  	 	  Prompt = 'Select an image for calculation' ;	  
	 
		  CommonDlgsLib = 'VppCommonDlgs.dll' ;		// declaration of CommonDialog constant 

//Windows API constants
  		  wm_Close 		= 16 ;
		  wm_SysCommand = $0112 ; 
		  sc_Close 		= 61536 ;		  	  		// command to close Excel
		  

		  { Declaration of external DLL functions }
		  function OpenDialog( FileName,Title,Filter,DefaultExt:pointer ) : integer ; external CommonDlgsLib ;		  
		  function FindWindow( ClassName,WindowName:pointer ) : integer ;
		  external 'User32' ; name 'FindWindowA' ;

		  procedure SendMessage( Handle,Message,wParam,lParam:integer ) ; 
		  external 'User32' ; name 'SendMessageA' ;		  
		  
		  
		  
		  
		  
{************************************************************************}
{ ***	                      Global variable declaration			  ***}									   
{************************************************************************}

var
   cP;
   X0,Y0; 									//initial coordinates for center   
   S; 										//Search radius
   cur, Ed;									//
   i,j;										//indices
   Fnam;									//extended file name for .CSV file
   extFile;									//file name
   I_Mask; 			   		   				//default Mask image
   Size_x, Size_y, HALF;                     //Size of image in X and Y, and half of the size
   Img, iNam;								 //Experimental image, extended and short names
   iC;										 //Return image
   NRAT;									 //ratio of experiment/converted
   RR;			   							 //appended image name
   PAT;										 //array of variance
   Data, cellY;						 		 //Array of 1D intensities, colomn in ASCII file
   ST,k,iT;								 	 //Search step
   sR, eR;							 		 //search limits
   arSz;
   minS;									 //minimum step size
   Combo;

   Sel;
   AppMask;
   Path;
   PathU;
   PathR;
   PathC;
   RXY;
{
******************************************************************
********************** function Select ***************************
******************************************************************
This function return a full file name for a file 
}	 	 
function SELECT;											
		var
   		   nName; Name, ix;
   		   Choice, nDIR;
		begin
	 		 Name:=FindFirstFile(P, fa_Archive);
	 		 nName:=ExtractFileName(Name);		
	 		 nDIR:= ExtractFilePath(Name);			//extract the path
			 ix:=0;
	  		 
			 while StrLen(Name) > 0 do

	  		 	   begin
	  	   		   		Name:=ExtractFileName(FindNextFile) ;
		   				nName:=nName+';'+Name;
					 if ix>100 then halt('Too many Files in Directory');   
					 	ix:=ix+1;
	 				end; 

	 			 if SelectString( 'Select File',nName , Choice ) >= 0 then
	 			 	begin
			 			 SELECT:=nDIR+Choice;
	 				end	
	 			else
	 				begin 
	 	 	  			  WriteInfo('No Selection made! Restart program! ');	
		 	  			  halt;
	 				end; 
		end;
//----------------------> end of function SELECT <-----------------------------------			


{
 ************************************************************************
 ***                                                                  ***
 ***	                      Procedure RAD							  ***
 ***																  ***
 ************************************************************************ 
 }  
 //-------->This routine calculate a polar image

procedure RAD(X_off,Y_off);

var
  Image_x, Image_y;                             {X- and Y-coordinate Ramp images}
  Image_R;                                      {Polar-field image (equal radius field)}
  i, j;											{indices}
  x,y;
  Ramp_X, Ramp_Y;                               {Ramp vectors}
  Full;											{image headers}


		  begin
				   Full:='x'+Str(Word(Round(10*X_off)))+'y'+Str(Word(Round(10*Y_off)));
		  	   	if FileExists(PathR+Full+'.tif') then
				begin
				   WriteStatus('File Already Exists  '+ Full);
				end   
				else   
		  		   begin
						  WriteStatus('X_off= '+Str(X_off)+ '  Y_off= '+Str(Y_off));
                          Ramp_X:= Single(MakeLinear(0,Size_x,Size_x));
                          Ramp_Y:= Single(MakeLinear(0,Size_y,Size_y));
                                 Ramp_X:=Single(Ramp_X-X_off);
                                 Ramp_Y:=Single(Ramp_Y-Y_off);
                                 x:=Single(sqr(Ramp_X));
                                 y:=Single(sqr(Ramp_Y));
                          Image_x := CreateImage( Single, Size_x, Size_y ) ;
                          Image_y := CreateImage( Single, Size_x, Size_y );

                          Image_R:= CreateImage(Double, Size_x,Size_y);

 
           for j := 0 to (Size_x-1) do
                  begin
                          PutRow( Image_x, x, j ) ;
                      for i := 0 to (Size_y-1) do
                          PutColumn( Image_y, y, i );
                 end; 
                         Image_R:= Single(sqrt(Image_x+Image_y));
	   			   		 Save(Image_R,PathR+Full+'.tif');
							 
{------> Free memory}
                Free (Image_x);
                Free(Image_y);
                Free(Ramp_X);
                Free(Ramp_Y);
                Free(Image_R);
				Free(X_off);
				Free(Y_off);
			end;
		  end;  
  
{---------> end of procedure RAD}
   
{************************************************************************}
{ ***	                      Function GetOpenFileName 				  ***}									   
{************************************************************************}
{This function returns a full name of selected file }		  
   
function GetOpenFileName(Title,Filter,DefaultExt ) ;
{ Open the common Open dialog box and get a file name }
{ Quit if Cancel is pressed }

  const
  	   BufSize = 255 ;
  
  var
  	   FileName ;

	   begin
	   		SetDir(Path);
  	 		FileName := StringOfChar( ' ',BufSize ) ;
  			
		 if OpenDialog( FileName,Title,Filter,DefaultExt ) <> 0 then
     	 	GetOpenFileName := Trim( FileName )
  		else
  			halt('File is NOT selected!!!');  	
end;  { GetOpenFileName }
//----------------------> end of function GetOpenFileName <-------------------------- 


{************************************************************************}
{ ***	                      function ImgCENT(X2,Y2, RR, sR,eR)	  ***}									   
{************************************************************************}

//------>this function returns an image generated from 1D data
//------>input parameters are center coordinates (X2,Y2), file name for polar image, start and end of the caluculated radius

function ImgCENT(X2,Y2, RR, StartR, endR);

var
   R;	 									 //1D-->2D converted image image 
   R_field,F_image;							 //polar image, mask image of equal radii          
   
	begin	  							

//-----> polar image selection						  
						  RAD(X2,Y2);
 		    		 	  Open(PathR + RR+'.tif',R_field);			  
						  WriteStatus('Selected polar image is ' + RR);							
//-----> create arrays				   
 			   

				   R:=CreateImage(single,Size_x,Size_y);				   				   
         		   R:=0;	

					for i:=startR to endR do
           				begin		   
               				 F_Image := ( R_field > i) and (R_field <= i+1);  {binary ring of current radius}
			   				 R:=R+F_image*Data[0,i];
//			  				 Show(R,RR);			   
WriteStatus(RR+'  r= '+Str(i));
		  				end;
				   R:=R*I_Mask*(not (R = 0));			  				 
WriteStatus(RR);
//							 Show(R,RR);
					ImgCENT:=R;		 
							 				   
//----------->Free memory
				Delete(R); 
				Delete(F_Image); 
				Delete(R_field);

		end;		
//--------------------> end of function ImgCENT <--------------------------------- 

{************************************************************************}
{ ***	                      function DAT(HALF)				  	  ***}									   
{************************************************************************}
{This procedure will read an ASCII file}
procedure DAT(HALF);
//----->
	var
   	   WrkSht; 		   							 //name for Excel worksheet
   	   vCh;									 	 // DDE channels 		
		begin
				   Data:=CreateArray(single,1,HALF);
				   
				   WrkSht := Trim(ChangeFileExt( extFile, '' )) ;
				   WriteStatus(extFile);

	 		   Execute('C:\Program Files\Microsoft Office\Office11\EXCEL.EXE '+Fnam);
			   WrkSht := Trim(ChangeFileExt( extFile, '' )) ;
				   
	  			   vCh := DdeInitiate( 'Excel',WrkSht ) ;
  	  			if vCh = 0 then halt('Communication problem!!!') ;
  
  	  			   for i:=1 to HALF do
	  	  		   	   begin
			   		   		cellY:= 'R'+Str(i+1)+'C2';
			   				Data[0,i-1] := DdeRequest( vCh, cellY ,fmt_Number ) ;
  		   				end;	 
  					DdeTerminate(vCh);
  					SendMessage( FindWindow( 'XLMAIN',0 ),wm_SysCommand,sc_Close,0 ) ;
		end;			
//--------->  

{************************************************************************}
{ ***	                      function iRAT(Fst, Sec)				  ***}									   
{************************************************************************}
//------> this function will generated a ratio of FIRST image over SECOND image

function iRAT(Fst, Sec);
		 begin
		 	  iRAT:= Fst*(not (Sec = 0))*(not (Fst = 0))/(Sec+(Sec = 0))
		 end;
//--------------------> end of function iRAT <---------------------------------

{************************************************************************}
{ ***	                      function minPAT						  ***}									   
{************************************************************************}
//------> this function return a coordinate of the minimum of an array

function minPAT;
	var
	   ind;
	   minV;	 
		 begin
		 	minV:=MinOf(PAT[2,..]);  		 
				for ind:=0 to arSz-1 do
					begin	
						if (PAT[2,ind]=minV) then minPAT:=ind;				 
					end;	

		 end;
//--------------------> end of function minPAT <---------------------------------

{************************************************************************}
{ ***	                      function VARI(iM)				          ***}									   
{************************************************************************}
//----> this function return variance over an image for all non zero pixels

function Vari(iM);
	var
	   pix;
	   MeanImg;
	   MS;
		 begin
		 	   	  		MS:= not(iM = 0); 	   	  														  
						pix:= Single(SumOf(MS));							{count all nonzero pixels}						
                        MeanImg:=Single(SumOf(iM)/pix); 	   			{mean count for selected Image}
						Vari:=SumOf(MS*sqr(iM-MeanImg));						

		
		 end;
//--------------------> end of function VARI <---------------------------------

{************************************************************************}
{ ***	                      procedure ITER(Step)			          ***}									   
{************************************************************************}

//this function return a COMBO image of a series calculated images 

function ITER(Step,X1,Y1);
		  var
		  	 jX, jY; 		   				 //indices
   			 X, Y;							 //current coordinates
			 iRR;							 //current Name
   			 NROI;							 //Cut ROI
			 v,w;
		begin	

				v:=0; 			 						
				for jX:=-S to S do
					begin	
							X:=X1+jX*Step;
				w:=0;
						for jY:=-S to S do
							begin	

									Y:=Y1+jY*Step;									
						  			iRR:='x'+Str(Word(Round(10*X)))+'y'+Str(Word(Round(10*Y)));
									iC:=ImgCENT(X,Y,iRR,sR,eR);
				
						 	 		NRAT:=iRAT(Img,iC);
									NROI:=NRAT[(X-eR)..(X+eR),(Y-eR)..(Y+eR)];									
				Combo[v*(2*eR)..(v+1)*(2*eR),w*(2*eR)..(w+1)*(2*eR)]:=NROI;
				Show(Combo,'x'+Str(Word(Round(10*X0)))+'y'+Str(Word(Round(10*Y0)))+'s'+Str(Word(Round(Step*10)))+'x'+Str(2*(iT-k)+1));
//			WriteInfo(RR);	
//						 			Show(NROI, 'ROI'+RR);
//									SetDisplayZoom(NRAT,50);									
						 			SetDisplayRange( Combo , 0.9, 1.1 );
									PAT[0,cur]:=X;
									PAT[1,cur]:=Y;
									PAT[2,cur]:=Vari(NRAT);																		
									cur:=cur+1;
								Free(NRAT);	
								Free(NROI);	
					w:=w+1;		
						 	end;			  
					v:=v+1;		
					end;	 
				ITER:=PAT;	
			end;
//--------------------> end of procedure ITER <---------------------------------		 
		 
{
 ************************************************************************
 ************************************************************************
 ***                                                                  ***
 ***	                      Main program							  ***
 ***																  ***
 ************************************************************************ 
 ************************************************************************
}		  

		  begin		   
		  
//-----------------------> Initialization parameters<---------------------------------------
	 		Sel:=SELECT;												  			// selector for initialization file
			
	 			 Path:= ReadPrivateINIString( Sel, 'Paths', 'Path');	 //read a base path
	 			 PathU:= ReadPrivateINIString( Sel, 'Paths', 'PathU');	 //read a path for Masks
				 PathR:=ReadPrivateINIString( Sel, 'Paths', 'PathR');	 //read a path for polar image				 	
				 PathC:=ReadPrivateINIString( Sel, 'Paths', 'Center');	 //read a path for output file				 
				 

				 					  
//--------> Get image file
			  	
			   iNam:=GetOpenFileName( 'Open','Image Files (*.tif)|*.tif','' );
			   Open(iNam, Img);			  				//open default Mask
//			   Show(Img, ExtractFileName(iNam));

			   
//--------> Get 1D file			    			   
			   FNam:=GetOpenFileName( 'Open','Radial Files (*.csv)|*.csv','' );
			   extFile:=ExtractFileName(Fnam);			   

//			   Open(PathU+DM, I_Mask);			  				//open default Mask	   
//-------->get apparatus mask				 
				 AppMask:=ReadPrivateINIString( Sel, 'Images', 'AppMask'); 		//apparatus mask	 
 		    	 Open(PathU + AppMask,I_Mask);							 

                   Size_x:=GetXSize(I_Mask);				  
                   Size_y:=GetYSize(I_Mask);					  
				   HALF:=Integer(Size_x/2);
				   DAT(HALF);						  //read ASCII file				   
//------> Default center

				 X0:=Val(ReadPrivateINIString( Sel, 'Center', 'cX'));	 //read a center coordinates for X
				 Y0:=Val(ReadPrivateINIString( Sel, 'Center', 'cY'));	 //read a center coordinates for Y

					GetNumber('Enter the X0 coordinate',X0);
					GetNumber('Enter the Y0 coordinate',Y0);

//------> Search limits		  
		  		 	   		sR:=10;
							eR:=125;							
					GetNumber('Enter the search RADIUS (pixel)',eR);

							S:=2;
							minS:=0.5;	 
					
					GetNumber('Enter the GRID parameter',S);
					GetNumber('Enter the MINIMUM step (pixel)',minS);
					
					RXY:='x'+Str(Word(Round(10*X0)))+'y'+Str(Word(Round(10*Y0)))+'s'+Str(Word(Round(10*minS)));

					
							
//------>Iterations
				   			iT:=1;
					GetNumber('Enter the number of ITERATIONS ',iT);
												
							arSz:=Integer(iT*sqr(2*s+1));
						PAT:=CreateArray(single,3,arSz);
						PAT:=1111111111;
						cur:=0;												

				for k:=1 to iT do									
					begin
Combo:=CreateImage(single, Integer((2*S+1)*2*eR+1),Integer((2*S+1)*2*eR)+1);
Combo:=1;						

						 ST:=minS*(2*(iT-k)+1);
						 WriteStatus(ST);
								PAT:=ITER(ST,X0,Y0);
								cP:=minPAT;		
										X0:=PAT[0,cP]; 
										Y0:=PAT[1,cP];
				
				    Save(Combo,Path+PathC+RXY+'.tif');
					Free(Combo);
					end;	


{					
					Ed:=CreateEditor('Variance');
							for i:=0 to arSz-1 do
								begin	
									WriteLn(Ed, PAT[0,i], ', ',PAT[1,i], ', ',PAT[2,i])				 
								end;

}
{
						  			RR:='x'+Str(Word(Round(10*X0)))+'y'+Str(Word(Round(10*Y0)));
									iC:=ImgCENT(X0,Y0,RR,0,HALF-1);
				
						 	 		NRAT:=iRAT(Img,iC);
									Save(NRAT,Path+PathC+'F'+RXY+'.tif');
						 			Show(NRAT, 'F'+RR);
//									SetDisplayZoom(NRAT,50);
						 			SetDisplayRange( NRAT , 0.9, 1.1 ) ;
						WriteInfo('x=  '+ Str(PAT[0,cP])+'  y= '+ Str(PAT[1,cP]) + '  var= '+Str(PAT[2,cP]));			
}													
				Delete(Data);
				Delete(I_Mask);				
				Delete(Img);
				Free(iC);
				Free(PAT);   
				Free(NRAT);
			        PlaySound( 'C:\Program Files\Digital Optics\V++\Library\Mac.wav' ) ;								
		  end
