procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;


procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please make a rectangular selection.');
    exit;
  end;
end;


procedure CropAndScale(fast:boolean; angle:real);
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);
  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;
  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;
  if not OneToOne then begin
    if fast 
      then SetScaling('Nearest; Create New Window')
      else SetScaling('Bilinear; Create New Window');
  end;
  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;

macro 'Crop and Scale-Fast [1]';
begin CropAndScale(true, 0); end;

macro 'Crop and Scale-Smooth [2]';
begin CropAndScale(false, 0); end;

macro '(-' begin end;


macro 'Average stack [A]';
var
  i,invno,width,height,OldStack:integer;
begin
	GetPicSize(width,height);
	SetNewSize(width,height);
  CheckForStack;
	invno:=1/nSlices;
  OldStack:=PicNumber;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   MultiplyByConstant(invno);
  end;
  for i:= 1 to nSlices-1 do begin
   SelectSlice(i);
   SelectAll;
   Copy;
   SelectSlice(i+1);
   Paste;
   Add; 
  end;
SelectAll;
Copy;
MakeNewWindow('Average');
Paste;
  SelectPic(OldStack);
  Dispose;
end;


macro 'Max of stack [Z]';
var
  i,OldStack,NewImage,TempImage:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;

begin
  CheckForStack;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  SelectAll;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  SetNewSize(RoiWidth,RoiHeight);
  MakeNewWindow('Max');
  NewImage:=PicNumber;

  SelectPic(OldStack);
  SelectSlice(1);
	 SelectAll;
		Copy;
	 SelectPic(NewImage);
		Paste;
 
    for i:= 2 to N do begin
    SelectPic(OldStack);
    SelectSlice(i);
    Duplicate('Temp');
   TempImage:=PicNumber;
 
    ImageMath('Max',TempImage,NewImage,1.00,0,NewImage);
 
   SelectPic(TempImage);
   Dispose;
   end;
end;


macro 'Max of windows [W]';
var
  i,invno,width,height,OldStack:integer;
   pic1,pic2,pic3,w,h:integer;
begin

SelectPic(1);
pic1:=PidNumber;
  for i:= 2 to nPics do begin
  SelectPic(i);
  pic2:=PidNumber;
  ImageMath('max',pic1,pic2,1.00,0,pic1)
  end;
end;

macro '(-' begin end;


macro 'Median filter stack [U]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('median');
  end;
end;

macro 'Sobel stack [O]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('sobel');
  end;
end;

macro 'Sharpen stack [H]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('sharpen');
  end;
end;


macro 'Enhance stack [C]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   EnhanceContrast;
   ApplyLUT;
  end;
end;


macro 'Threshold stack [B]';
var
  i,invno,width,height,OldStack:integer;
  thresh: integer;
begin
  CheckForStack;
  thresh:= GetNumber('threshold?', 128);
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  SetThreshold(thresh);
  ApplyLUT;
  end;
end;


macro 'Adaptive -mean- threshold stack [G]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max: integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Measure;
   GetResults(n,mean,mode,min,max);
  SetThreshold(mean);
  ApplyLUT;
  end;
end;


macro 'Adaptive -mode- threshold stack [V]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max: integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Measure;
   GetResults(n,mean,mode,min,max);
  SetThreshold(mode);
  ApplyLUT;
  end;
end;


macro 'Adaptive -mixed- threshold stack [N]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max,mix: integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Measure;
   GetResults(n,mean,mode,min,max);
   mix=(mode*mean)/2;
  SetThreshold(mix);
  ApplyLUT;
  end;
end;


macro 'Density slice stack [D]';
var
  i,invno,width,height,OldStack:integer;
   v1,v2,v3:integer;
begin
  CheckForStack;
  v1:= GetNumber('width about 128 ?', 16);
  v2:= 128-v1;
  v3:= 128+v1;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(0,v2,255);
  end;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(v2,v3,0);
  end;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(v3,255,255);
  end;
end;


macro 'Skeletonize stack [K]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Skeletonize;
  end;
end;



macro 'Prune stack [P]';
var
  i,j,invno,width,height,OldStack:integer;
  begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;

SetBinaryCount (7);
for j:=1 to 20 do begin
Erode;
end;

  end;
end;


macro '(-' begin end;


macro 'Median filter image [M]';
var
  i,invno,width,height,OldStack:integer;
begin
   SelectAll;
   Filter('median');
end;

macro 'Prune image [I]';
var
  i,j,invno,width,height,OldStack:integer;
  begin

SetBinaryCount (7);
for j:=1 to 20 do begin
Erode;
end;

end;

macro 'Skeletonize image [J]';
var
  i,j,invno,width,height,OldStack:integer;
  begin

Skeletonize;
end;

end;

macro 'Density slice image [E]';
var
  i,invno,width,height,OldStack:integer;
   v1,v2,v3:integer;
begin
  v2:= GetNumber('lower bound ?', 100);
  v3:= GetNumber('upper bound ?', 200);
   SelectAll;
  ChangeValues(0,v2,0);
  ChangeValues(v3,255,0);
  ChangeValues(v2,v3,255);
end;


macro 'Density slice image about 128 [L]';
var
  i,invno,width,height,OldStack:integer;
   v1,v2,v3:integer;
begin
  v1:= GetNumber('width about 128 ?', 16);
  v2:= 128-v1;
  v3:= 128+v1;
   SelectAll;
  ChangeValues(0,v2,255);
  ChangeValues(v2,v3,0);
  ChangeValues(v3,255,255);
end;


macro 'Thicken lines [T]';
var
  i,invno,width,height,OldStack:integer;
   pic1,pic2,pic3,w,h:integer;
begin

  SelectAll;
   Copy;
   MoveRoi(1, 0);
   Paste;
   DoOr;

  SelectAll;
   Copy;
   MoveRoi(0, 1);
   Paste;
   DoOr;

  end;
end;

macro '(-' begin end;

macro 'Info on histo [F]';
var
  x,y,z,w,h ,i,j,k,mode,n:integer;
  mean,mode,min,max,StdDev:real;
begin
SelectAll;
Measure;
GetResults(n,mean,mode,min,max);
PutMessage(' mean = ',mean,' mode = ',mode,' min= ', min,' max = ',max);
end;


macro 'make ROI by width of rim [4]';
var
 crop,left,top,width,height:integer;
begin
	GetPicSize(width,height);
 crop:=GetNumber('width of cropped rim ?',10);
 left:=crop;
 top:=crop;
 width:=width-2*crop;
 height:=height-2*crop;
MakeRoi(left,top,width,height);
end;
 
macro 'cut away rim [5]';
var
 crop,left,top,width,height:integer;
begin
	GetPicSize(width,height);
 crop:=GetNumber('width of cropped rim ?',10);
 left:=crop;
 top:=crop;
 width:=width-2*crop;
 height:=height-2*crop;
MakeRoi(left,top,width,height);
Copy;
SelectAll;
Clear;
Paste;
SelectAll;
end;
 
macro 'Smooth image [6]';
begin
Filter('Smooth');
end;

macro 'Smooth image more [7]';
begin
Filter('Smooth more');
end;

macro 'Smooth enlarge outlines [8]';
var
n,mean,mode,min,max:integer;
i,j,x,y,w,h,xoff,yoff: integer;
ScaleFactor:real;
name:string;
begin
name:=WindowTitle;
ScaleFactor:=GetNumber('Scale factor:',2.0);
SelectAll;
Filter('smooth');
Copy;
GetRoi(x,y,w,h);
i:=ScaleFactor*w;
j:=ScaleFactor*h;
SetScaling('New window');
SetScaling('bilinear');
ScaleAndRotate(ScaleFactor,ScaleFactor,0.);
Filter('Smooth');
Filter('Smooth');
   Measure;
   GetResults(n,mean,mode,min,max);
  SetThreshold(mean);
  MakeBinary;
Skeletonize;
SaveAs(name,'*',Scalefactor:2);
end;
end;
end;


macro 'Invert image [Y]';
begin
Invert;
end;

macro 'Scale to pixel  [0]';
begin
SetScale(0,'pixel');
end;