macro 'Vectorized Stereology'
var
nPixels,mean,mode,min,max, count:integer;n,row,column:integer;Count,
Threshold:integer;StdDev,TheMean,MultFactor:real;sum0;real;sum1:real;
sum2:real;i:integer;test:integer;stcount:integer;w:integer;h:integer;dim:integer;
begin
SetPicSize(w,h);
if(w > h) then RotateRight; dim:= h -10;
if(w < h) then dim:= w -10;
if(w = h) then dim:= h -10;
Invert;
ResetCounter;
Measure;
count:=rCount;
min :=rMin[count];
max:=rMax[count];
KillROI;
SelectAll;
AddConstant(-min);
Max:=Max-min;
MultiplyByConstant(255/max);
{Multifactor := 1.0;}
ResetCounter;
Measure;
StdDev := rStdDev[rCount];
TheMean :=rMean[rCount];
{Apply the multiplication and the threshold to the image}
Threshold := TheMean + round(MultFactor*StdDev);
ResetCounter;
SeThreshold(Threshold);
MakeBinary;
SetScale(1,'pixel');
outline;
KillRoi;
MakeRoi(1,258,dim,1);
SetOptions('User1');
{TraceEdges;
Shadow;
Dilate;
Erode;}
Skeletonize;
ReduceNoise;
SetLineWidth(1);
RequiresVersion(1.44);
SetUser1Label('AVG_Cross');
Measure;
sum0:= 0.0;
sum1:= 0.0;
sum2:= 0.0;
for i:=2 to (dim -1) do begin
if(GetPixel(i-1,158) =0) and (GetPixel(i,158) = 255) and (GetPixel(i+1,158) = 0)
then
sum0:= sum0 +1.0;
if(GetPixel(i-1,258) = 0) and (GetPixel(i,258) = 255) and (GetPixel(i+1,258 = 0)
then
sum1:= sum1 +1.0;
if(GetPixel(i-1,358) = 0) and (GetPixel(i,358) =255) and (GetPixel(i+1,358 = 0)
then
sum2:= sum2 +1.0;
end;
rUser1[rCount]:=(sum0 + sum1 + sum2)/6.0;
DrawBouundary;
SetPicName('0 degree Crossings');
MoveTo(1,158);
LineTo(dim +1,158);
MoveTO(1,358);
LineTo(dim +1,358);
MoveTo(390,250);
SetFontSize(18);
SetText('Bold, Shadow');
DrawText(' Vector 0.00');
KillROI;
SelectAll;
RotateRight(true);
KillRoi;
MakeRoi(1,220,dim,1);
Measure;
sum0:= 0.0;
sum1:= 0.0;
sum2:= 0.0;
for i:=2 to (dim -1) do begin
if(GetPixel(i-1,120) = 0) and (GetPixel(i,120) = 255) and (GetPixel(i+1,120) = 0)
then
sum0:= sum0 +1.0;
if(GetPixel(i-1,220) = 0) and (GetPixel(i,220) = 255) and (GetPixel(i+1,220) = 0)
then
sum1:= sum1 +1.0;
if(GetPixel(i-1,320) = 0) and (GetPixel(i,320) = 255) and (GetPixel(i+1,320) = 0)
then
sum2:= sum2 +1.0;
end;
rUser1[rCount]:=(sum0 + sum1 + sum2)/6.0;
{rUser1[rCount]:=sum -3;}{Correction for transection}
DrawBoundary;
SetPicName('0,90 degree Crossings');
MoveTo(dim + 2,240);
SetFontSize(18);
DrawText(' Vector 0.90');
MoveTo(1,120);
LineTo(dim + 1,120);
MoveTo(1,320);
LineTo(dim + 1,320);
KillROI;
SelectAll;
RotateRight(true);
ScaleAndRotate(1,1,45);
KillRoi;
MakeRoi(1,190,dim,1);
Measure;
sum0:= 0.0;
sum1:= 0.0;
sum2:= 0.0;
for i:=2 to (dim -1) do begin
if GetPixel(i-1,120) = 0) and (GetPixel(i,120) = 255) and (GetPixel(i+1,120 = 0)
then
sum0:= sum0 +1.0;
if(GetPixel(i-1,220) = 0) and (GetPixel(i,220) = 255) and (GetPixel(i+1,220) = 0)
then
sum1:= sum1 +1.0;
if(GetPixel(i-1,320) = 0) and (GetPixel(i,320) = 255) and (GetPixel(i+1,320) = 0)
then
sum2:= sum2 +1.0;
end;
 rUser1[rCount]:=(sum0 + sum1 + sum2)/6;
{rUser1[rCount]:=sum -2;}{Correct for the transecting vectors}
DrawBoundary;
SetPicName('0,90,45 degree Crossings');
MoveTo(1,90);
LineTo(dim + 1,90);
MoveTo(1,290);
LineTo(dim + 1,290);
MoveTo(dim + 2,170);
SetFontSize(18);
DrawText('Vector 0.45');
UpdateResults;
ShowResults;
end;

macro 'Version 1- Compute Averaged and Total Open Pore Areas';
var
nPixels,mean,mode,min,max,count:integer;n,row,column:integer;Count,Threshold:integer;StdDev,TheMean,MultFactor:real; i:integer;sum:real;x,y:real;
begin
ResetCounter;
  Measure;
  count:=rCount;
  min :=rMin[count];
  max:=rMax[count];
  KillROI;
  SelectAll;
  AddConstant(-min);
  Max:=Max-min;
  MultiplyByConstant(255/max);
{Multifactor := 1.0;}
ResetCounter;
Measure;
StdDev := rStdDev[rCount];
TheMean :=rMean[rCount];
{Apply the multiplication and the threshold to the image}
Threshold := TheMean + round(MultFactor*StdDev);
SetThreshold(Threshold);
MakeBinary;
SetScale(1,'pixel');
RequiresVersion(1.44);
  SelectAll;
  SaveState; {Inverts Y status saved starting with V1.44b21}
  InvertY(false);
  SetForegroundColor(255); {black}
SetUser1Label('Total');
SetUser2Label('AVG');
SetOptions('rUser1;rUser2'); {I think this is SetOptions, page was damaged}
SetOptions('Area; rUser1;rUser2'); {I think this is SetOptions, page was damaged}
Measure;
  KillRoi;
  {x:=rX[rCount];
  y:=rY[rCount];
MoveTo(x-5,y);
  LineTo(x+5,y);
  MoveTo(x,y-5);
  LineTo(x,y+5);
  RestoreState;
end;
LabelParticles(true);
  IncludeInteriorHoles(false);
  WandAutoMeasure(true);
IgnoreParticlesTouchingEdge(False);
  SetParticleSize(15,99999);
  AnalyzeParticles;
sum:=0.0;
for i:=1 to rCount do
sum:= sum + rArea[i]:
rUser1[rCount]:= sum;
rUser2[rCount]:= sum/rCount;
   SelectAll;
   Clear;
ShowResults;
end;

macro 'Version 2- Compute Averaged and Total Open Pore Areas';
var
nPixels,mean,mode,min,max,count:integer;n,row,column:integer;Count,Threshold:integer;StdDev,TheMean,MultFactor:real;i:integer;sum:real;x,y:real;
begin
ResetCounter;
  Measure;
  count:=rCount;
  min :=rMin[count];
  max:=rMax[count];
  KillROI;
  SelectAll;
  AddConstant(-min);
  Max:=Max-min;
  MultiplyByConstant(255/max);
{Multifactor := 1.0;}
ResetCounter;
Measure;
StdDev := rStdDev[rCount];
TheMean :=rMean[rCount];
{Apply the multiplication and the threshold to the image}
Threshold := TheMean + round(MultFactor*StdDev);
SetThreshold(Threshold);
MakeBinary;
SetScale(1,'pixel');
RequiresVersion(1.44);
  SelectAll;
  SaveState; {Invert Y status saved starting with V1.44b21}
  InvertY(false);
  SetForegroundColor(255); {black}
SetUser1Label('Total');
SetUser2Label('AVG');
SetOptions('rUser1;rUser2'); {I think this is SetOptions, page was damaged}
SetOptions('Area'; rUser1;rUser2'); {I think this is SetOptions, page was damaged}
 Measure;
  KillRoi;
  {x:=rX[rCount];
  y:=rY[rCount];
MoveTo(x-5,y)
 LineTo(x+5,y);
 MoveTo(x,y-5);
 LineTo(x,y+5);
 RestoreState;
end;
LabelParticles(true);
  IncludeInteriorHoles(true);
  WandAutoMeasure(true);
IgnoreParticlesTouchingEdge(true);
   SetParticleSize(190,40000);
   AnalyzeParticles;
sum:=0.0;
for i:=1 to rCount do
sum:= sum + rArea[i];
rUser1[rCount]:= sum;
rUser2[rCount]:= sum/rCount;
   SelectAll;
   Clear;
ShowResults;
end;

macro 'Filtered, Ameboid Inclusion of Pore Measurements';
var
nPixels,mean,mode,min,max,count:integer;n,row,column:integer;Count,Threshold:integer;StdDev,TheMean,MultFactor:real;sum:real;i:integer;
begin
ResetCounter; {I think this is ResetCounter, page was damaged}
  Measure;
  count:=rCount;
  min :=rMin[count];
  max:=rMax[count];
  KillROI;
  SelectAll;
  AddConstant(-min);
  Max:=Max-min;
  MultiplyByConstant(255/max);
{Multifactor := 1.0;}
ResetCounter;
Measure;
StdDev := rStdDev[rCount];
TheMean :=rMean[rCOunt];
{Apply the muliplication and the threshold to the image}
Threshold := TheMean + round(MultFactor*StdDev);
SetThreshold(Threshold);
MakeBinary;
ResetCounter;
SetScale(1,'pixel');
  RequiresVersion(1.44);
SelectAll;
InvertY(false); {I think this is InvertY, page was damaged}
ForegroundColor(255); {I think this is ForegroundColor, page was damaged}
SetUser1Label('% Black');
SetUser2Label('% White');
Measure;
GetResults(nPixels,mean,mode,min,max);
  rUser1[rCount]:=histogram[255]/nPixels;
  rUser2[rCount]:=histogram[0]/nPixels;
{SetUser1Label('AVG');
  SetUser2Label('Total');}
  SetOptions('Area;major;minor;User1; User2');
  Measure;
LabelParticles(true);
OutlineParticles(true);
  IncludeInteriorHoles(true);
IgnoreParticlesTouchingEdge(true);
  WandAutoMeasure(true);
   SetParticleSize(190,40000);
   AnalyzeParticles;
  sum:=0;
  for i:=1 to rCount do sum:=sum+rArea[i];
  rUser1[rCount]:=sum;
  rUser2[rCount]:=sum/rCount;
  SelectAll;
Clear;
ShowResults;
end;


macro 'Validation of Porosity Measure Using Phantoms';
var
  x,y,rows,columns,maxradius,radius:integer;
begin
  SaveState;
  row:=5; columns:=5;
  maxradis:=rows*columns;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  MakeNewWindow('Phantom Pores');
  radius:=1;
  for y:=0 to columns-1 do
    for x:=0 to rows-1 do begin
      MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
      Fill;
      radius:=radius+1;
    end;
  KillRoi;
  SetParticleSize(1,9999);
  LabelParticles(true);
  OutlineParticles(true);
  SetOptions('Area, Perimeter, Major, Minor');
  AnalyzeParticles;
  SetUser1Label('Perim.d');
  SetUser2Label('Area');
  for radius:=1 to maxradius do begin
    rUser1[radius]:=2*3.14159*radius;
    rUser2[radius]:=3.14159*sqr(radius);
 end; {I think this is end, page was damaged}
 ShowResults;
 RestoreState;
end;



macro 'Manual Stereology';
 {Finds center to edge distances along radial lines and displays them in User1.}
var
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  x1,y1,x2,y2,count,ppv:integer;
  pi,angle,delta,min,max,scale:real; {I think this is pi..., page was damaged}
  line,i,nLines,radius,r:integer;
  unit:string;
begin
  RequiresVersion(1.55);
  SaveState;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  if RoiWidth=0 then begin
    PutMessage('Selection Required.');
    exit;
  end;
  GetScale(scale,unit);
  MoveRoi(-RoiLeft,-RoiTop);
  KillRoi;
  RestoreRoi;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(RoiWidth,RoiHeight);
  MakeNewWindow('Delta to Intersect');
  RestoreRoi;
  SetOptions('X-Y Center');
  Measure;
  DrawBoundary;
  KillRoi;
  x1:=rX[rCount]*scale;
  y1:=rY[rCount]*scale;
  radius:=sqrt(sqr(x1)+sqr(y1));
  r:=sqrt(sqr(RoiWidth-x1)+sqr(y1));
  if r>radius then radius:=r;
  r:=sqrt(sqr(RoiWidth-x1)+sqr(RoiHeight-y1));
  if r>radius then radius:=r;
  r:=sqrt(sqr(x1)+sqr(RoiHeight-y1));
  if r>radius then radius:=r;
  nLines:=36;
  pi:=3.14159;
  delta:=2.0*pi/nLines;
  angle:=0.0;
  ResetCounter;
  SetUser1Label('Dist.');
  SetOptions('User1');
  for line:=1 TO nLines do begin
    x2:=x1+round(radius*cos(angle));
    y2:=y1+round(radius*sin(angle));
    MakeLineRoi(x1,y1,x2,y2);
    GetPlotData(count,ppv,min,max);
    Fill;
    i:=count;
    repeat {I think this is repeat, page was damaged}
    pi:=i-1; {I think this is pi, page was damaged}
    until (i<=0) or (PlotData[i]>0);
    rUser1[line]:=i;
    angle:=angle+delta;
  end;
  KillRoi;
  if scale<>1 then
    for i:=1 to nLines do rUser1[i]:=rUser1[i]/scale;
  SetCounter(nLines);
  RestoreState;
  ShowResults;
end;

macro 'UNDER DEVELOPMENT Mark Center of Each Pore Detected Scan';
{Replaces each object in the image with a single pixel.}
var i:integer;
begin
   Duplicate('Center');
   SetScale(1,'pixel');
   AutoThreshold;
LabelParticles(true);
OutlineParticles(true);
  IncludeInteriorHoles(true);
{IgnoreParticlesTouchingEdge(true);}
  WandAutoMeasure(true);
   SetParticleSize(50,40000);
   AnalyzeParticles;
   SelectAll;
   Clear;
   For i:=1 to rCount do
     PutPixel(rX[i],rY[i],255);
end;
end;

macro 'UNDER DEVELOPMENT Report # Pores at Random Locations';
var
  n,i,width,height,PicID,nLocations:integer; {I think 1st char is n..., page was damaged}
  size:real;
begin
SetScale(1,'pixel');
  RequiresVersion(1.44);
  nLocations:=10;
  size:=0.25;
  n:=1;
  GetPicSize(width,height);
  PicID:=PicNumber;
  SetUser1Label('Count');
  SetOptions('User1');
  SetParticleSize(190,40000);
  LabelParticles(true);
  OutlineParticles(true);
  for i:=1 to nLocations do begin
    SelectPic(PicID);
    MakeRoi((1-size)*width*random, (1-size)*height*random,size*width,size*height);
    Duplicate('Random Sample');;
    SetDensitySlice(156,255);
    AnalyzeParticles;
    Dispose;
    rUser1[i];=rCOunt;
  end;
 KillRoi;
 ResettCounter(nLocations);
  ShowResults;
end;


macro 'UNDER DEVELOPMENT Report Stereology at Pores at Random Locations';
var
  n,i,width,height,PicID,nLocations:integer;
  size:real;
begin
  RequiresVersion(1.44);
  nLocations:=20; {I think 1st char is nLocations, page was damaged}
  size:=0.25;
  n:=1;
  GetPicSize(width,height);
  PicID:=PicNumber;
  SetUser1Label('Count');
  SetOptions('User1');
  SetParticleSize(1,9999);
  LabelParticles(true);
  OutlineParticles(true);
  SetOptions('Area, Perimeter, Major, Minor');
  for i:=1 to nLocations do begin
    SelectPic(PicID);
    MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
    Duplicate('Random Sample');;
     SetDensitySlice(156,255);
    AnalyzeParticles;
    Dispose;
    rUser1[i]:=rCount;
  end;
  KillRoi;
  SetCounter(nLocations);
  ShowResults;
end;

macro 'UNDER DEVELOPMENT Measure All Currently Opened Images';
{Measures all currently open images using the current selection.  There is}
{an implied "Select All" if the active image doesn't have a selection.}
var
  i,left,top,width,height:integer;
begin
  ResetCounter;
  for i:=1 to nPics do begin
    SelectPic(i);
    RestoreROI;
    Measure;
  end;
end;


macro 'UNDER DEVELOPMENT Make Measure in Batch from Disk';
{
Reads from disk and measures a set of images too large to simultaneously
fit in memory.  The image names names must be in the form '01', '02', etc.
Before starting, open and outline the first image('01').
}
var
 i,width,height:integer; {I think 1st char is "i", page was damaged}
begin
  GetPicSize(width,height);
  if width=0 then begin
    PutMessage('Before running this macro, open and outline the first image("01") in the series.');
    exit;
  end;
  ResetCounters;
  Measure;
  close;
  for i:=2 to 1000 do begin
    open(i:2);
    RestoreROI;
    Measure;
    close;
  end;
end;