{еееееееееееееееееееееA set of macros intented to ease QFISH analysis of fluorescent signals on metaphasic chromosomesееееееееееееееееееее}
{*****************************************************************************************************************************************}
{*********************************************************			Macro  V1.0			**************************************************}
{***********************************************			    Jean-Patrick Pommier		     *****************************************}
{*****************************************************************************************************************************************}
                 {Global var for different macro}
var
{----------------Files handling------------------}
disk:string;
WorkDir:string;
Slide:string;
metaphase:integer;
StrMetaphase:string;
CounterStain,Probe1,Probe2,Probe3:string;
FluoNb:integer;
Init:boolean;
path2imageExch:string;
IterDilCStain:integer; {Nber of time a segmented counterstain mask must be dilated to mask noisy probe signal}
chromosome,delta:integer;
cheminFiltre:string;
{----------------Image display------------------}
PidLabelCyto,PidLabelCtd,PidLabelHomolog,pidLabelChr,PidLabelKar,PidLHS1,PidLabelHOMStep2:integer;
{----------------mesurements--------------------}
pidmask,pidtarget:integer;
{---------------image characteristics-----------}
ImWidth,ImHeigth:integer;

{***********************Var for image processing***************************************}
Path2Filters,FilterMask:string;
FilterMask:string;
{+++++++++++++++++++++++ CounterStain Parameters }

{+++++++++++++++++++++++ Probe Parameters }
BackgroundSize: integer;
FilterMask:string;
ConstantBackground:integer;
ReductionFactor,MagnificationFactor:integer; {WARNING !!:MagnificationFactor=1/ReductionFactor};

{&&&&&&&&&& Procedure(s) &&&&&&&&&&&&&&&&}
procedure InitProbeProcessingParametres;
var
	StartUpPath,messagedebug:string;
begin
	BackgroundSize:=4;
	ConstantBackground:=-5;
	ReductionFactor:=0.2;MagnificationFactor:=5;
	StartUpPath:=GetPath('startup');
	Path2Filters:=concat(StartUpPath,'Kernels');
	FilterMask:=':Gauss(7x7)';
	ImWidth:=1536;
	ImHeigth:=1024;
end;

{**************************************************************************************}

{----------------------------------       Procedures    -------------------------------}
procedure RemoveSpaceFromString(Mystring:string);
var
j:integer;
begin
	j:=pos(' ',StrMetaphase);
	while (j>0) do
	begin
		j:=pos(' ',StrMetaphase);
		delete(StrMetaphase,j,1);
	end;
end;
procedure MorphoOpen(iter,size:integer);
var
i:integer
begin
	SetBinaryCount(size);
	for i:=1 to iter do
	begin
		erode;
	end;
	for i:=1 to iter do
	begin
		dilate;
	end;
end;

procedure MorphoDilate(iter,size:integer);
var
i:integer
begin
	SetBinaryCount(size);
	for i:=1 to iter do
	begin
		dilate;
	end;
end;

procedure LabellingContext(palette:string,ForeCol,BackCol,ResCol:integer);
begin
        SetPalette(palette,ResCol);
        SetForegroundColor(ForeCol);
        SetBackgroundColor(BackCol);
        SelectTool('wand');
        SetDensitySlice(254,254);     
end;
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}

{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{еееееееееееееееееееееееееProcedures dedicaced to homologs labellingеееееееееееееееее}
{ееееееееееееееееееееееееееееееееuse global variables :    ееееееееееееееееееееееееее}
{е                                              in QFISH macro                      е}
{е             disk:string;                                                         е}
{е             WorkDir:string;                                                      е}
{е             Slide:string;                                                        е}
{е             metaphase:integer;                                                   е}
{е             StrMetaphase:string;                                                 е}
{е             CounterStain,Probe1,Probe2,Probe3:string;                            е}
{е             PidLabelCyto,PidLabelCtd,PidLabelHomolog,pidLabelChr,PidLabelKar     е}
{е             PidLabelHOMStep1,PidLabelHOMStep2                                    е}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}  

procedure InitHomologs;
var
	Path2ImgCHR,Path2ImgKAR                     :string;
	width,height                                :integer;
begin
	DisposeAll;
	path2ImgCHR:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':','Chr-Label');  {##FILE NAME='Chr-Label'}
	Open(Path2ImgCHR);
	pidLabelCHR:=pidnumber;
	path2ImgKAR:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':','Kar-Label');  {##FILE NAME='Kar-Label'}
	Open(Path2ImgKAR);
	pidLabelKAR:=pidnumber;
	GetPicSize(width,height);
	SetNewSize(width,height);
	SetBackgroundColor(0);SetForegroundColor(0);
	MakeNewWindow('Homologous chromosomes');pidLabelHomolog:=pidnumber;
	SetBackgroundColor(0);SetForegroundColor(0);
	MakeNewWindow('HomChrSearch Step1');pidLHS1:=pidnumber;
	SetBackgroundColor(0);SetForegroundColor(0);
	MakeNewWindow('HomChrSearch Step2');pidLabelHOMStep2:=pidnumber;
	
end;

procedure MakeAMaskWith(ValueToKeep:integer);
var
 InfValue,SupValue:integer;
begin
	
end;

procedure SelectKar(PairOfChr:integer);
var
 InfValue,SupValue:integer;
begin
	ChoosePic(pidLabelKAR);
	SelectAll;
	Copy;
	ChoosePic(pidLHS1);
	Paste;
	KillROI;
	InfValue:=PairOfChr-1;
	SupValue:=PairOfChr+1;
	ChangeValues(0,InfValue,0);
	ChangeValues(PairOfChr,PairOfChr,1);
	ChangeValues(SupValue,255,0);
	{exit('test selectKar result');}
end;

procedure SelectIndexOfKar;
begin
	ChoosePic(pidLabelCHR);
	SelectAll;
	Copy;
	KillROI;
	{exit('test SelectIndexOfKar 1/4');}
	Choosepic(pidLabelHOMStep2);
	Paste;
	KillROI;
	{exit('test SelectIndexOfKar 2/4');}
	Choosepic(pidLHS1);
	SelectAll;
	Copy;
	{exit('test SelectIndexOfKar 3/4');}
	Choosepic(pidLabelHOMStep2);
	ScaleMath(False);
	Paste;
	{exit('test SelectIndexOfKar 3a/4');}
	Multiply;
	KillROI;
end;

procedure LabelAsHomologs;
var
	chrom,NbreHomol,width,height,ImgSize,ObjectArea,TotalObject,WhitePix,BlackPix:integer;
begin
	Choosepic(pidLabelHOMStep2);
	GetPicSize(width,height);
	ImgSize:=width*height;
	SelectAll;
	gethistogram(0,0,width,height);
	WhitePix:=histogram[0];
	BlackPix:=histogram[255];
	TotalObject:=WhitePix+BlackPix;
	NbreHomol:=0;
	chrom:=1;
	repeat
		ObjectArea:=histogram[chrom];
		if ObjectArea>0 then
		begin
			NbreHomol:=NbreHomol+1;
			TotalObject:=TotalObject+ObjectArea;
			ChangeValues(chrom,chrom,NbreHomol);
		end;{if}
	chrom:=chrom+1;
	until ImgSize=TotalObject;
	KillROI;
end;

procedure CumulateHomologs;
begin
	ChoosePic(pidLabelHOMStep2);
	SelectAll;
	copy;
	KillROI;
	ChoosePic(PidLabelHomolog);
	paste;
	DoOR;
end;

procedure CleanIntermediatesImages;
begin
	Choosepic(pidLabelHOMStep1);
	ChangeValues(1,255,0);
	Choosepic(pidLabelHOMStep2);
	ChangeValues(1,255,0);
end;

{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}

procedure LabelHomologousChromosomes(PairOfChromosomes:integer);
begin
	SelectKar(PairOfChromosomes);
	SelectIndexOfKar;
	LabelAsHomologs;
	CumulateHomologs;
	{CleanIntermediatesImages;}
end;

{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{е                                    13/01/2003                                       е}
{еThis procedure takes two images as input                                             е}
{е           1- A connected componant labelled image of chromosomes                    е}
{е           2- A karyotype labelled Image of the same metaphase                       е}
{еand produce an image where each karyotyped chromosomes is labelled alternatively     е}
{еwith the grey level 1 or 2 (for a diploid metaphase)                                 е}
{е                                                                                     е}
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
 procedure LabelAllHomologs;
var
	width,height,ImgSize,WhitePix,BlackPix,TotalObject,kar,loop,grey:integer;
	swhitepix,sblackpix,StotalArea,sloop,Sarea,Sgrey,CStain:string;
begin
	{disk:='Huge:QTeloFISH';}
	{workdir:='jppAnimal';}
	{slide:='jpp50';}
	{strmetaphase:='12';}
	{Counterstain:='DAPI';}
	
	InitHomologs;
	 {exit;}
	TileWindows;
	ChoosePic(pidLabelKAR);
	GetPicSize(width,height);
	ImgSize:=width*height;
	Sarea:=concat(ImgSize);{putmessage('img area ',Sarea);}
	SelectAll;
	gethistogram(0,0,width,height);
	KillROI;
	WhitePix:=histogram[0];swhitepix:=concat(WhitePix);
	BlackPix:=histogram[255];sblackpix:=concat(BlackPix);
	{putmessage(swhitepix);}
	TotalObject:=WhitePix+BlackPix;
	StotalArea:=concat(TotalObject);
    {putmessage(StotalArea);}
    loop:=1;
    kar:=1;
	repeat
		ChoosePic(pidLabelKAR);
		gethistogram(0,0,width,height);
		grey:=histogram[kar];
		Sgrey:=concat('chromosomes pair:',grey);
		showmessage(Sgrey);
		if grey>0 then
		begin
			LabelHomologousChromosomes(kar);
			TotalObject:=TotalObject+grey;
			StotalArea:=concat('StotalArea',TotalObject);
			showmessage(StotalArea);
		end;{if}
		kar:=kar+1;
	until TotalObject=ImgSize;
	CStain:='Hmlg-Label'; {еееееFILE NAME='Hmlg-Label'}
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',CStain);
	SetSaveAs('TIFF');
	SaveAs(Image2Save);
end;
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{--------------------------------------------------------------------------------------}

macro '(                       QFISH macro ' begin end;
macro '(-' begin end;
{****************************************************************************}
{                          Setting Macro                                     }
{****************************************************************************}
macro '(Settings         ' begin end;

macro 'Set Dir'; {A macro to set the path to images}
begin
   metaphase:=1;
   FluoNb:=0; 
	  disk:=GetString('Disk Name ?','Huge');
   WorkDir:=GetString('Path to working Dir ?','QTeloFISH:JPPAnimal');
	  Slide:=GetString('Slide Name?','JPP50');
   CounterStain:=GetString('CounterStain?','DAPI'); 
	  repeat
		   FluoNb:=GetNumber('Number of fluorochromes (max 3)?',1,0);
   until (FluoNb>0) AND (FluoNb<4);
   Probe1:=GetString('Probe1 (telomere for ex) ?','CY3');
   if FluoNb=2 then Probe2:=GetString('Probe2 ?','FITC');
   if FluoNb=3 then
   begin  
     Probe2:=GetString('Probe2 ?','FITC');
					Probe3:=GetString('Probe3 ?','CY5');
		 end;
			init:=true;
end;
macro '(-' begin end;

{****************************************************************************}




{*************************Images Browing**************************}
macro '(-' begin end;
macro '(Browsing Images' begin end;
Macro 'Next metaphase...                 [n]';
begin
if metaphase<256 then metaphase:=metaphase+1;
strmetaphase:=concat(metaphase);
RemoveSpaceFromString(strmetaphase);
ShowMessage('Metaphase:',strmetaphase);
end;
{----------------------------------------------------------------}
Macro 'Previous metaphase...        [b]';
begin
if metaphase>1 then metaphase:=metaphase-1;
strmetaphase:=concat(metaphase);
RemoveSpaceFromString(strmetaphase);
ShowMessage('Metaphase:',strmetaphase);
end;



macro '(-' begin end;
macro '(Low level processing and segmentation' begin end;
{****************************************************************************}

macro'Process Chromosomes 12 bits                   [c]'
var
	path2image:string;
	sep:string
	suffix:string;
	Image:string;
	iCStainHP:string;
	pid1,pid2,pid3,pid4:integer;
begin
	StrMetaphase:=concat(metaphase);
	RemoveSpaceFromString(StrMetaphase);
	suffix:='.tif';
	Image:='1';
	RemoveSpaceFromString(Image);
	path2image:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',Image,suffix);
	showmessage(path2image);  
	SetImport('TIFF;16-bits Unsigned;Swap bytes;Fixed Scale');{Import 12 bits image PC}
	SetImportMinMax(0,4095);
	SetCustom(1536,1024,8,1);  
	import(path2image);
	invert;
	SubtractBackground('2D Rolling Ball (faster)',25);
	AddConstant(0);
	SetPicName(CounterStain);
	pid1:=pidnumber;
	SetScaling('Nearest;New Window');
	ScaleAndRotate(0.125,0.125,0);
	SetPicName('Blur small');
	pid2:=pidnumber;
	Convolve('tmp:applications:science:imaging:NIH image 1.61:Kernels:Gauss(7x7)');
	SetScaling('Bilinear;New Window');
	ScaleAndRotate(8,8,0);
	MultiplyByConstant(0.3);
	pid3:=pidnumber;
	SetPicName('Blur');
	ChoosePic(pid2);{small blurred image}
	dispose;
	ImageMath('sub',pid1,pid3,1.5,0,'High-Pass iDAPI');
	{pid4:=pidnumber;
	ImageMath('mul',pid4,pid4,0.0039,0,'High-Pass iDAPI Gamma2');}
	ChoosePic(pid3);{large blurred image}
	dispose;
	TileWindows;
	SetSaveAs('TIFF');
	{inverse CounterStain after High-Pass filtering}
	iCStainHP:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':','i',CounterStain,'.TIF');
	SaveAs(iCStainHP);
end;

macro'Process Probe1 12 bits                         [p]' {*@*@*@*@*}
var
	path2image,Probe1NoBack,Image2Save:string;
	sep:string
	suffix:string;
	ConvolutionMask:string
	Image,Probe1Seg,CStainMask:string;
	pid0,pid1,pid2,pid3,pid4,pid5,pid6, pid7,pidTelobin,RightSizepid:integer;
begin
	InitProbeProcessingParametres;
	StrMetaphase:=concat(metaphase);
	RemoveSpaceFromString(StrMetaphase);
	suffix:='.tif';
	Image:='1';
	RemoveSpaceFromString(Image);
	path2image:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Image,suffix);
	showmessage(path2image);  
	SetImport('TIFF;16-bits Unsigned;Swap bytes;Fixed Scale');{Import 12 bits image PC}
	SetImportMinMax(0,4095);
	SetCustom(ImWidth,ImHeigth,8,1);  
	import(path2image);
	SetPicName(Probe1);
	pid0:=pidnumber;
	Invert;
	SubtractBackground('2D Rolling Ball (faster)',BackgroundSize);
	AddConstant(ConstantBackground);
	SetSaveAs('TIFF');
	Probe1NoBack:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','NoBack.tif');
	SaveAs(Probe1NoBack);
	SetPicName(Probe1);
	pid1:=pidnumber;
	SetScaling('Nearest;New Window');
	ScaleAndRotate(ReductionFactor,ReductionFactor,0);
	SetPicName('Blur small');
	pid2:=pidnumber;                                 {Blur small}
	{Duplicate('Blur');}
	ConvolutionMask:=concat(Path2Filters,FilterMask);
	{putmessage(ConvolutionMask);exit;}
	Convolve(ConvolutionMask);
	SetScaling('Bilinear;New Window');
	ScaleAndRotate(MagnificationFactor,MagnificationFactor,0);
	pid3:=pidnumber;                                 {Blur large}
	SetPicName('Blur');
	ChoosePic(pid2);
	dispose;                                                {еdelete Blur small}
	SetNewSize(ImWidth,ImHeigth);
	MakeNewWindow('right size blur Image');
	RightSizepid:=pidnumber;
	ChoosePic(pid3); {this image has not the right size due to rescaling}
	SelectAll;
	copy;
	ChoosePic(RightSizepid);
	paste;
	ChoosePic(pid3);
	dispose;
	ImageMath('sub',pid1,RightSizepid,1,0,'S');
	setthreshold(1);
	makebinary;
	MorphoOpen(1,7);
	Probe1Seg:=concat(probe1,' ','Segmentation 1');
	SetPicName(Probe1Seg);
	pidTelobin:=pidnumber;
	ChoosePic(pid1);
	dispose;
	ChoosePic(RightSizepid);
	dispose;                                                      {еdelete Blur}
	{open High passed counterstain image (ex DAPI) to make a binary mask}
	CStainMask:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':','i',CounterStain,'.TIF');
	open(CStainMask);
	pid4:=pidnumber;    
	Duplicate(' Chr tmp');                         {еfuture mask to clean binary img of probe1, gray component(chr)}
	pid5:=pidnumber; 
	setthreshold(2);
	makebinary;
	MorphoOpen(2,4);
	MorphoDilate(5,1); 
	ImageMath('and',pidTelobin,pid5,1,0,'Probe1 tmp'); {binary chr masks probe1 spots}
	pid6:=pidnumber;                                {еfuture mask of probe1, probe component}
	Probe1Seg:=concat(probe1,'-','Mask'); {еееееFILE NAME='CY3 Mask'}
	SetPicName(Probe1Seg);
	ChoosePic(pid5);
	dispose;
	AddConstant(-1);
	ChangeValues(1,6,0);  
	ImageMath('or',pid6,pid4,1,0,Probe1Seg);
	pid7:=pidnumber;
	AddConstant(-1);   
	ChoosePic(pid6);
	dispose;
	ChoosePic(pidTelobin);
	dispose;
	ChoosePic(pid4);
	dispose;
	ChoosePic(pid7);
	SetDensitySlice(254,254); {display binary probe1 over chromosomes}
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Seg);
	SetSaveAs('TIFF');
	SaveAs(Image2Save);
	TileWindows;
end;

{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro '(-' begin end;
macro '(Editing CounterStain images' begin end;
{------------------------------------------------------}
Macro 'Load labelled chromosomes     [/l] '
var
CStain,Image2Load:string;
begin
	CStain:='Chr-Label'; {еееееFILE NAME='Chr-Label'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',CStain);
	pidLabelChr:=pidnumber;
	SetPalette('system',0);
	setforeground(0);
	setbackground(0);
	SelectTool('drawline');     
end;
Macro 'Save labelled chromosomes     '
var
CStain,Image2save:string;
begin
	CStain:='Chr-Label'; {еееееFILE NAME='Chr-Label'}
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',CStain);
	choosepic(pidLabelChr);
	SetPalette('system',0);
	setforeground(0);
	setbackground(0);
	SetSaveAs('TIFF');
	SaveAs(Image2Save);
end;
{еееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro '(-' begin end;
macro '(-' begin end;
macro '(Editing Probe1 images' begin end;

Macro 'Load mask             [F1]'
var
Probe1Seg,Image2Load:string;
begin
Probe1Seg:=concat(probe1,'-','Mask'); {еееееFILE NAME='CY3-Mask'}
Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Seg);
{putmessage(Image2Load);}
open(Image2Load);
SetDensitySlice(254,254);
end;

Macro 'Save Mask              [F2]'
var
Probe1Label,Image2Save:string;
begin
Probe1Label:=concat(probe1,'-','Mask'); {еееееFILE NAME='CY3 Mask'}
Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Label);
SetSaveAs('TIFF');
SaveAs(Image2Save);
end;

Macro 'Save Cyto label    [F3]'
var
Probe1Label,Image2Save:string;
begin
Probe1Label:=concat(probe1,'-','CytoLabel'); {еееееFILE NAME='CY3 CytoLabel'}
Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Label);
SetSaveAs('TIFF');
SaveAs(Image2Save);
end;
macro '(-' begin end;

Macro 'Save Ctd label      [F4]'
var
	Probe1Label,Image2Save:string;
	pid2renameandsave:integer;
begin
	pid2renameandsave:=PicNumber;
	Probe1Label:=concat(probe1,'-','CtdLabel'); {еееееFILE NAME='CY3 CtdLabel'}
	SetPicName(Probe1Label);
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Label);
	SetSaveAs('TIFF');
	SaveAs(Image2Save);
end;

Macro 'Load Chromatid labels'
var
	Probe1Seg,Image2Load:string;
begin
	Probe1Seg:=concat(probe1,'-','CtdLabel'); {еееееFILE NAME='CY3-CtdLabel'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Seg);
	open(Image2Load);
	SetPalette('Grayscale', 6);
	SetDensitySlice(254,254);
end;

Macro 'Load Cyto label    [F5]'
var
	Probe1Seg,Image2Load:string;
begin
	Probe1Seg:=concat(probe1,'-','CytoLabel'); {еееееFILE NAME='CY3 CytoLabel'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Seg);
	open(Image2Load);
	SetPalette('Grayscale', 6);
	SetDensitySlice(254,254);
end;


{****************************************************************************************}
macro '(-' begin end;
macro '(Chromosomes Labelling' begin end;

macro 'Label chromosomes                     [L]'
{This macro labels automatically binary particules (Chromosomes) which centroids fall within them.}
{The number of particules, is limited to 254.                                       }
{version fonctionnelle 17/09/2002, modifiОe 1/10/02}
{Au Jean-Patrick Pommier}
var
	i:integer;
	j:integer;
	tag1:integer;
	tag:integer;
	tagmax:integer;
	Nivgris:integer;
	width,height:integer;
	pidChr,pidChrLabelled:integer;
	Probe1Seg,Image2Load,Image2Save:string;
	{CounterStain,Probe1 is a global var}
begin
	{open the proper image ex DAPI}
	Probe1Seg:=concat(probe1,'-','Mask'); {еееееFILE NAME='CY3-Mask'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',Probe1Seg);
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':','Chr-Label');
	open(Image2Load);
	pidChr:=pidnumber;
	GetPicSize(width,height);
	Duplicate('Labelled chromosomes');
	SetThreshold(1);
	MakeBinary;
	pidChrLabelled:=pidnumber;
	SetForeground(255);
	Setbackground(0);
	SetOptions('X-Y Center rUser1 rUser2');
	SetUser1Label('ChrTag');
	SetUser2Label('ChrObj');
	AnalyzeParticles('reset');
	SetThreshold(127);
	MakeBinary;
	tag1:=1;
	tagmax:=rcount;
	ShowMessage('N part ',tagmax);
	if tagmax<=254 then
	begin
		{ShowResults;} 
		for tag:=tag1 to TagMax do 
		begin
			Nivgris:=255;
			i:=round(rX[tag]);
			j:=round(rY[tag]);			 
			Nivgris:=getpixel(i,height-j);
			{PutPixel(i,height-j,128);}
			ShowMessage('Niv gris',Nivgris);
			if NivGris>0 then {objet convexe}
			begin  
				AutoOutline(i,height-j);
				ruser1[tag]:=tag;
				ruser2[tag]:=Nivgris;
				SetForeground(tag);
				Fill;
				Killroi;
			end;{if}
		end;{for tag}
	end;{if tagmax}
	SetPalette('systeme Palette',0);
	ChoosePic(pidChrLabelled);
	SetSaveAs('TIFF');
	SaveAs(Image2Save);
	dispose;
	ChoosePic(pidChr);
	dispose;
end;

macro '(-' begin end;

Macro 'Edit Chr label                      [F6]'
var
	ChrLabel,Image2Load:string;
begin
	ChrLabel:=concat('Chr-Label'); {еееееFILE NAME='Chr-Label'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',ChrLabel);
	{PutMessage(Image2Load);}
	open(Image2Load);
	pidLabelChr:=PidNumber; {global var}
	SetPalette('System',0);
end;

Macro 'Save Chr label                      [F7]'
var
	ChrLabel,Image2Save:string;
begin
	ChrLabel:=concat('Chr-Label');
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',ChrLabel);
	if pidexists(pidLabelChr) then
	begin
		SetSaveAs('TIFF');
		SaveAs(Image2Save);
		ChoosePic(pidLabelChr);
		dispose;
	end
else
	begin
		PutMessage('Open/Edit a ChrLabel Image first');
	end;
end;

Macro 'Edit Karyotype                       [F8]'
var
	KarLabel,Image2Load:string;
begin
	KarLabel:=concat('Kar-label'); {еееееFILE NAME='Kar-label'}
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',KarLabel);
	open(Image2Load);
	PidLabelKar:=PidNumber; {global var}
	SetPalette('System',0);
end;

Macro 'Save Karyotype                     [F9]'
var
KarLabel,Image2Save:string;
begin
	KarLabel:=concat('Kar-label');
	Image2Save:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',KarLabel);
	if pidexists(PidLabelKar) then
		begin
			SetSaveAs('TIFF');
			ChoosePic(PidLabelKar);
			SaveAs(Image2Save);
			LabelAllHomologs;{ееееееееееCall a procedure make a homolog labelling of the "Kar-label" image}
			disposeAll;
		end
	else
		begin
			PutMessage('Open/Edit a Kar-Label Image first');
		end;
end;

Macro 'Chr Labelling Settings                  [S]'
var
	chrom1,chrom2:integer;
begin
	SetPalette('systeme Palette');
	chrom1:=GetNumber('First chromosome color label',5,0);
	chrom2:=GetNumber('╞ color between 2 chrom.',5,0);
	chromosome:=chrom1;
	delta:=chrom2;
	SetForeground(chromosome);
	PutMessage('Work on binary image');
end;

Macro 'Prev chr                                             [w]'
begin 
if (chromosome-delta)=<1 then
 begin
  beep;
 	PutMessage('Color label limited to 1-255 !');
  exit;
 end;
chromosome:=chromosome-delta;
SetForeground(chromosome);
SelectTool('paintbucket');
end;

Macro 'Next chr                                              [x]'
begin
if (chromosome+delta)>=255 then
 begin
  beep;
 	PutMessage('Color label limited to 1-255 !');
  exit;
 end;
chromosome:=chromosome+delta;
SetForeground(chromosome);
SelectTool('paintbucket');
end;

{****************************************************************************************}
macro '(-' begin end;
macro '(Probe Labelling' begin end;
macro '(      Cytogenetic location' begin end;
{---------------------------------------------------------------------------------}
macro 'Select pter label                    [a]'
begin
	LabellingContext('Grayscale',2,2,6);
end;
macro 'Select qter label                     [z]'
begin
	LabellingContext('Grayscale',3,3,6);
end;
macro 'Select ITS1 label                      [e]'
begin
	LabellingContext('Grayscale',4,4,6);
end;
macro 'Select ITS2 label                      [r]'
begin
	LabellingContext('Grayscale',5,5,6);
end;
macro '(      kind of spot: single double orphean' begin end;
macro 'Single spot  chromatid 1                        [t]'
begin
	LabellingContext('Grayscale',2,2,6);
end;
macro 'Single spot  chromatid 2                        [y]'
begin
	LabellingContext('Grayscale',3,3,6);
end;
macro 'Double spot                                                 [u]'
begin
	LabellingContext('Grayscale',4,4,6);
end;
macro 'Orphean spot                                               [i]'
begin
	LabellingContext('Grayscale',5,5,6);
end;
{---------------------------------------------------------------------------------}
macro '(-' begin end;
macro '(Measure and extract labels' begin end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{еееееееееееееееееееееееееееееееееееее  Extractions des mesures  ееееееееееееееееееееееееееееееееееее}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
procedure OpenMask;
begin
	MaskImage:=concat(probe1,'-','Mask');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',MaskImage);
	open(Image2Load);
	pidmask:=pidnumber;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
procedure ExtractMinimalMeasurements;
var 
	MaskImage, TargetImage,Image2Load,Data:string;
begin
	disposeall;
	
	TargetImage:=concat('noBack.tif');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	{####################### mesure de la fluo#############}
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Area Mean');
	SetPrecision(3,2);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#QFluo.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
	
	{####################### reccup des labels cyto#############}
	TargetImage:=concat(Probe1,'-CytoLabel');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	Choosepic(pidmask);
	
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Min/Max');
	SetPrecision(3,0);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#Cyto.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
	{####################### reccup des labels chr#############}
	TargetImage:=concat('Chr-Label');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',CounterStain,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	Choosepic(pidmask);
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Min/Max');
	SetPrecision(0,2);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#Chr.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
	
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
procedure ExtractChromatids;
var
	MaskImage, TargetImage,Image2Load,Data:string;
	TargetName:string;
begin
	TargetName:=concat('CtdLabel');
	TargetImage:=concat(probe1,'-',TargetName);
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	{####################### reccup du label#############}
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Min/Max');
	SetPrecision(0,2);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#Ctd.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
procedure ExtractKaryo;
var
	MaskImage, TargetImage,Image2Load,Data:string;
	TargetName:string;
begin
	TargetImage:=concat('kar-label');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',counterstain,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	{####################### reccup du label karyo#############}
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Min/Max');
	SetPrecision(0,2);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#Kar.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
procedure ExtractHomologs;
var
	MaskImage, TargetImage,Image2Load,Data:string;
	TargetName:string;
begin
	TargetImage:=concat('Hmlg-label');
	Image2Load:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',counterstain,':',TargetImage);
	open(Image2Load);
	pidTarget:=pidnumber;
	OpenMask;
	{####################### reccup du label homologs#############}
	
	SetDensitySlice(254,254);
	SetScale(1,'pixel');
	SetOptions('Min/Max');
	SetPrecision(0,2);
	redirect(true);
	AnalyzeParticles('reset');
	Data:=concat(disk,':',WorkDir,':',Slide,':',StrMetaphase,':',Probe1,':','#Hmlgs.txt');
	SetExport('Measurements');
	Export(Data);
	ResetCounter;
	DisposeAll;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro 'Extract Minimal Measurements *no chromatids, no Karyo*';
begin
	ExtractMinimalMeasurements;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro 'Extract Basic Measurements *+ chromatids, no Karyo*';
begin
	ExtractMinimalMeasurements;
	ExtractChromatids;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro 'Extract Minimal Measurements *no chromatids, + Karyo*';
begin
	ExtractMinimalMeasurements;
	ExtractKaryo;
	ExtractHomologs;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro 'Extract Full Measurements *+ chromatids, + Karyo*';
begin
	ExtractMinimalMeasurements;
	ExtractChromatids;
	ExtractKaryo;
	ExtractHomologs;
end;
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
{ееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееееее}
macro '(-' begin end;
Macro 'Close all        {cmd-SPACE}          [/ ]'
begin
	DisposeAll;
end;
Macro 'Reset LUT        [/@]'
begin
	SetPalette('grayscale',0);
	SetDensitySlice(254,254);
end;
	Macro 'Spectrum LUT [/&]'
begin
	SetPalette('Spectrum',0);
end;
Macro 'System LUT       [/О]'
begin
	SetPalette('System',0);
end;
Macro 'Pseudo color LUT [/"]'
begin
	SetPalette('PseudoColor',0);
end;
macro '(-' begin end;
macro'Log       [/p]';
var
	year, month, day, hour, minute, second, dayofweek:integer;
begin
	GetTime(year, month, day, hour, minute, second, dayofweek);
	NewTextWindow('LOG',260,50);
	writeln('*************** Day     ',day,'/',month,'/',year,'           Time:',hour,':',minute);
	writeln('Slide:',slide,'--','metaphase ',strmetaphase);
	writeln ('        Counterstain:', CounterStain,'--','Probe :',probe1);
end;