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;


MACRO 'Detail of pile [D]';
VAR
    left,top,width,height,i : INTEGER;
BEGIN
  left := GetNumber('Left ', 80);
  top := GetNumber('Top ', 18);
  width := GetNumber('Width ', 48);
  height := GetNumber('Height ', 40);
  	for i:=1 to nPics do begin
 	MakeRoi(left,top,width,height);
	SetPicName('DETAIL',i:2);
  	SaveAs;
 	NextWindow;
	end;
END;


MACRO 'Enlarged detail of pile [E]';
VAR
    left,top,width,height,i,ii,factor : INTEGER;
BEGIN
  factor := GetNumber('Factor ', 10);
  left :=GetNumber('Left ', 80);
  top := GetNumber('Top ', 18);
  width := GetNumber('Width ', 48);
  height := GetNumber('Height ', 40);
  SetScaling('Nearest Neighbor; New Window');
  	for i:=1 to nPics do begin
	SelectPic(i);
 	MakeRoi(left,top,width,height);
 	ScaleAndRotate(factor,factor,0.0);
	SetPicName('E-DETAIL',i:2);
  	SaveAs;
	Dispose;
	end;
END;


macro '(-' begin end;


macro 'make ROI [S]';
var
x,y,left,top,width,height:integer;
begin
GetPicSize(width,height);
 left:=GetNumber('left:',300);
 top:=GetNumber('top:',200);
 width:=GetNumber('width:',786);
 height:=GetNumber('height:',626);
MakeRoi(left,top,width,height);
end;
 

macro 'make ROI to low-right corner [¤]';
var
x,y,left,top,width,height:integer;
begin
GetPicSize(width,height);
GetMouse(x,y);
width:=width-x;
height:=height-y;
 left:=GetNumber('left:',x);
 top:=GetNumber('top:',y);
 width:=GetNumber('width:',width);
 height:=GetNumber('height:',height);
MakeRoi(left,top,width,height);
end;
 

macro 'make ROI  there [X]';
var
x,y,left,top,width,height:integer;
begin
GetMouse(x,y);
GetPicSize(width,height);
 left:=GetNumber('left:',x);
 top:=GetNumber('top:',y);
 width:=GetNumber('width:',620);
 height:=GetNumber('height:',620);
MakeRoi(left,top,width,height);
end;
 

macro 'make ROI top half [F]';
var
x,y,left,top,width,height:integer;
begin
GetPicSize(width,height);
 left:=GetNumber('left:',0);
 top:=GetNumber('top:',0);
 width:=GetNumber('width:',width);
GetMouse(x,y);
 height:=GetNumber('height:',y);
MakeRoi(left,top,width,height);
end;
 

macro 'make ROI left half [G]';
var
x,y,left,top,width,height:integer;
begin
GetPicSize(width,height);
 left:=GetNumber('left:',0);
 top:=GetNumber('top:',0);
GetMouse(x,y);
 width:=GetNumber('width:',x);
 height:=GetNumber('height:',height);
MakeRoi(left,top,width,height);
end;
 

macro '(-' begin end;


macro 'move ROI right [5]';
begin
SelectAll;
Copy;
MoveRoi(10,0);
Paste;
end;
 

macro 'move ROI down [6]';
begin
SelectAll;
Copy;
MoveRoi(0,10);
Paste;
end;
 

macro 'move ROI left [7]';
begin
SelectAll;
Copy;
MoveRoi(-10,0);
Paste;
end;
 

macro 'move ROI up [8]';
begin
SelectAll;
Copy;
MoveRoi(0,-10);
Paste;
end;
 

macro 'make center ROI [C]';
var
 crop,left,top,width,height:integer;
begin
	GetPicSize(width,height);
 crop:=GetNumber('crop to 1/n of image    n = ?',4);
 left:=0.5*(crop-1)*width/crop;
 top:=0.5*(crop-1)*height/crop;
 width:=width/crop;
 height:=height/crop;
MakeRoi(left,top,width,height);
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;


macro '(-' begin 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 'rotate to 0¡ EOS stack for cirpol=20 [R]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  OldStack:=PicNumber;
  for i:= 1 to 18 do begin
   SelectSlice(i+1);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,i*10.)
  end;
  for i:= 19 to 21 do begin
   SelectSlice(i+1);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,180.)
  end;
end;


macro 'rotate to 0¡ EOS stack for cirpol=1 [P]';
var
  n,i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  OldStack:=PicNumber;
n:=GetNumber('number of slices ? ',nSlices);
 for i:= 1 to 18 do begin
   SelectSlice(i+2);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,i*10.)
  end;
  for i:= 21 to n do begin
   SelectSlice(i);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,180.)
  end;
end;


macro 'rotate entire EOS stack180¡ [Q]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  OldStack:=PicNumber;
  for i:= 1 to 22 do begin
   SelectSlice(i);
   SelectAll;
	 FlipHorizontal;
  FlipVertical;
  end;
end;


macro 'Crop center of EOS [3]';
var
x,y,w,h: integer;
begin
x:=GetNumber('left (x)',0);
y:=GetNumber('top (y)',0);
w:=GetNumber('width',0);
h:=GetNumber('height',0);
MakeRoi(x,y,w,h);
CropAndScale(true, 0);
end;


macro '(-' begin end;


MACRO 'post stack crop  [-]';
   BEGIN
   MakeRoi(2,2,620,780);
            Export;
            Dispose;
   END;


MACRO 'Pict to raw and close  [$]';
   BEGIN
            Export;
            Dispose;
   END;


MACRO 'Move dx dy  [M]';
var
    dx, dy : INTEGER;
begin
  dx := GetNumber('(0,0)=top/left.  dx ?', 0)
  dy := GetNumber('(0,0)=top/left.  dy ?', 0)
  SelectAll;
  Copy;
  MoveRoi(dx, dy);
  Paste;
end;



MACRO 'Rotate  [N]';
var
    ang : REAL;
begin
  ang := GetNumber('positive = clockwise.  angle?', 0.01)
  SelectAll;
  ScaleAndRotate(1.0,1.0, ang);
end;



MACRO 'Rotate 180 [T]';
var
    ang : REAL;
begin
  SelectAll;
	 FlipHorizontal;
  FlipVertical;
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 '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 '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 'set 0-32 to 0  [0]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(0,32,0);
  ApplyLUT;
  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 '(-' begin end;

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

SelectPic(1);
pic1:=PidNumber;

GetPicSize(w,h);
SetNewSize(w,h);
MakeNewWindow('max of stack');

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


macro 'max of stacked 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;