{Macro for automating analysis of cloudscope data.}
{By Pat Arnott. Started 1/31/98}
{Download this file and save as a text file. Use it with NIH Image.}
{Use it and abuse it at your own risk.}
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 SeparateStack;
{Breaks a large Stack into smaller stacks of 20 frames or less, prior to analyzing,
to handle high data density per frame (ie maximum count in results is 8000)}
var
i, j, maxStackSize, subStackSize,numSubStacks,ThreshVal: integer;
OldStack: integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight: integer;
begin
SaveState; {Perform preliminary initialization}
maxStackSize:=20;
for i:=1 to 16 do begin
rUser1[i] := i;
end;
{Set up the new stack}
CheckForStack; {Verify that the current active window is a stack}
SelectAll;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
OldStack:=PicNumber; {Get the ID of the current (Old Stack)}
if nSlices > maxStackSize then begin
numSubStacks := nSlices/maxStackSize + 1;
for i:=1 to numSubStacks do begin
{Create a new image window of specified size}
SetNewSize(RoiWidth,RoiHeight);
MakeNewStack(rUser1[i]); {Create a new stack named 'i'}
rUser2[i]:=PicNumber; {get an ID number for the new stack}
SelectPic(OldStack); {reactivate the OldStack}
if nSlices >= maxStackSize then subStackSize := maxStackSize;
if nSlices < maxStackSize then subStackSize := nSlices;
for j:= 1 to subStackSize do begin
SelectSlice(1); {from the old stack.}
SelectAll; {The complete image is the region of interest ROI}
Copy; {Copy the ROI to the clipboard}
SelectPic(rUser2[i]); {Activate the new stack}
if j<>1 then AddSlice; {if the slice number is not 1 then add a slice}
Paste; {Paste the Clipboard image onto the new slice}
SelectPic(OldStack); {Reactivate the Old Stack}
DeleteSlice; {To save memory delete the current slice from the old stack}
end;
end;
Dispose; {OldStack}
end;
RestoreState;
end; {of procedure Separate Stack macro}
macro 'Set Video for Movie Capture'; begin SetVideo(' ',200,98) end;
macro '(-' begin end;
procedure MakeMov(frames:integer,fps:real,bufcap:boolean);
var
x, y, w, h,frameact: integer;
interval,dur:real;
begin
frameact:=frames+1;
interval:=1./fps;
dur:=frames/fps;
PutMessage('Movie duration = ',dur:4,' seconds, follow instructions in Info window');
Capture;
SelectAll;
GetRoi(x, y, w, h);
if bufcap then
MakeMovie('trigger first, blind, buffer ', frameact, interval);
if not(bufcap) then
MakeMovie('trigger first, blind', frameact, interval);
SelectSlice(1); DeleteSlice;
end;
{Below, true indicates use of memory buffer on LG-3 card, desirable.}
macro 'Movie 200 frames, 0.5 fps'; begin MakeMov(200,0.5,false); end;
macro 'Movie 200 frames, 1 fps'; begin MakeMov(200,1,false); end;
macro 'Movie 200 frames, 2 fps'; begin MakeMov(200,2,false); end;
macro 'Movie 200 frames, 5 fps'; begin MakeMov(200,5,false); end;
macro 'Movie 127 frames, 10 fps'; begin MakeMov(127,10.,true); end;
macro 'Movie 127 frames, 15 fps'; begin MakeMov(127,15.,true); end;
macro 'Movie 127 frames, 30 fps'; begin MakeMov(127,30.,true); end;
macro 'Movie User Select ...'
var
frames:integer; fps,mem:real;
begin
mem:=Get('MaxBlock');
mem:=(mem/307200.)-1.; {Maximum number of frames}
PutMessage('Memory allows maximum number of frames=',mem:0);
frames:=GetNumber('Number of frames ',100);
if frames > mem then begin
PutMessage('Too many frames..., use ',mem:0,' frames or less');
exit;
end;
fps:=GetNumber('frame rate ',30);
if fps > 30 then begin
PutMessage('Frame rate too fast, use 30 or less.');
exit;
end;
if (fps > 5) AND (frames > 127) then
PutMessage('Warning: Check actual frame rate in Info window');
if (frames<127) then
MakeMov(frames,fps,true) {Use buffer capture}
else
MakeMov(frames,fps,false); {Can't use buffer capture}
end;
macro '(-' begin end;
macro 'Goto the First Slice'; begin CheckForStack; SelectSlice(1) end;
macro 'Goto the Last Slice'; begin CheckForStack; SelectSlice(nSlices) end;
macro 'Break Up Stack into 20 Slice or Less Stacks'; begin SeparateStack; end;
macro '(-' begin end;
macro 'Make fft filter from stack: step 1'
var
OldStack,pid1,fft1:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
xs,ys,xsi,ysi:real; {scale factor and inverse}
begin
InvertY(false);
CheckForStack;
SelectAll;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
xs:=1.0;
ys:=1.0;
if (RoiWidth=640) or (RoiWidth=320) then xs:=0.8;
if (RoiHeight=480) or (RoiHeight=240) then ys:=1.06666667;
xsi:=1./xs; ysi:=1./ys; {Inverse of scaling factors.}
OldStack:=PicNumber;
SetNewSize(RoiWidth,RoiHeight);
SelectPic(OldStack);
SelectSlice(1); {from the old stack.}
SetNewSize(RoiWidth*xs,RoiHeight*ys);
SetScaling('Bilinear; Create New Window');
ScaleAndRotate(xs,ys,0.);
pid1:=PidNumber;
fft('Foreward');
fft1:=PidNumber;
SelectPic(pid1);
Dispose;
SelectPic(fft1);
SaveAs('fftFilter');
PutMessage('NOW BLOCK VARIOUS COMPONENTS USING WHITE TOOLS AND SAVE RESULT');
SelectTool('brush');
end;
macro 'Make fft filter from stack: step 2'
begin
SelectTool('grabber');
PutMessage('Press enter when ready to open your fft filter');
Open('fftfilter');
SetThreshold(1);
ApplyLUT;
Save;
PutMessage('READY NOW TO RUN FFT FILTER ON WHOLE STACK');
Close;
end;
procedure Prepare(backgnd:boolean);
var
i,OldStack,NewStack:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
xs,ys,xsi,ysi:real; {scale factor and inverse}
N,pid1,pid2,pid3,fft1,fft2:integer;
begin
InvertY(false);
CheckForStack;
SelectAll;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
xs:=1.0;
ys:=1.0;
if (RoiWidth=640) or (RoiWidth=320) then xs:=0.8;
if (RoiHeight=480) or (RoiHeight=240) then ys:=1.06666667;
xsi:=1./xs; ysi:=1./ys; {Inverse of scaling factors.}
SaveState;
OldStack:=PicNumber;
N:=nSlices;
PutMessage('Press enter when ready to open your fft filter');
Open('fftfilter');
pid3:=PidNumber;
SetNewSize(RoiWidth,RoiHeight);
MakeNewStack('Filtered Stack');
NewStack:=PicNumber;
SelectPic(OldStack);
for i:= 1 to N do begin
SelectSlice(1); {from the old stack.}
SetNewSize(RoiWidth*xs,RoiHeight*ys);
SetScaling('Bilinear; Create New Window');
ScaleAndRotate(xs,ys,0.);
pid1 := pidNumber;
fft('Foreward');
fft1:=PidNumber;
SelectPic(pid3);
SelectAll;
Copy;
SelectPic(fft1);
Paste;
fft('Inverse with filter');
SetNewSize(RoiWidth,RoiHeight);
SetScaling('Bilinear; Create New Window');
ScaleAndRotate(xsi,ysi,0.);
pid2:=pidNumber;
if backgnd then begin
SubtractBackground('2D Rolling Ball (faster)',125);
EnhanceContrast;
ApplyLUT;
end;
SelectAll;
Copy;
SelectPic(NewStack);
if i<>1 then AddSlice;
Paste;
SelectPic(fft1);
Dispose;
SelectPic(pid1);
Dispose;
SelectPic(pid2);
Dispose;
SelectPic(OldStack);
DeleteSlice;
end;
Dispose; {OldStack}
RestoreState;
SelectPic(pid3);
Dispose;
end;
macro 'Step 3: PREPARE STACK fft filter'; begin Prepare(false); end;
macro 'or Step 3: PREPARE STACK fft filter & backgnd removal'; begin Prepare(true); end;
macro '(-' begin end;
procedure Analyze(clean:boolean);
var
i,j,N:integer;
ys,ye:integer; {Start and finish counts for measurements}
OldStack,NewStack:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
begin
{Perform preliminary initialization}
SaveState;
InvertY(false);
SetExport('Measurements');
SetScale(0,'pixel'); {Work directly in pixel units.}
ResetCounter;
SetUser1Label('Frame');
SetUser2Label('PixNum');
ScaleConvolutions(true);
SetBinaryCount(4);
SetDensitySlice(0,0); {disable density slice}
{Analyze options}
SetOptions('Area; X-Y Center;Perimeter;Major;Minor;Angle,User1;User2');
Redirect(false);
LabelParticles(true);
OutlineParticles(true);
IgnoreParticlesTouchingEdge(false);
IncludeInteriorHoles(true);
WandAutoMeasure(false);
AdjustAreas(false);
SetParticleSize(200,999999); {Range in pixels}
SetPrecision(2); {digits, fieldwidth for measurements}
{Set up the new stack}
CheckForStack;
SelectAll;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
OldStack:=PicNumber;
SetNewSize(RoiWidth,RoiHeight);
MakeNewStack('Analyzed Stack');
NewStack:=PicNumber;
SelectPic(OldStack);
N:=nSlices;
for i:= 1 to nSlices do begin
SelectSlice(1); {from the old stack.}
ys:=rCount+1;
if clean then begin
SubtractBackground('2D Rolling Ball (faster)',125);
EnhanceContrast;
ApplyLUT;
end;
SetThreshold(98);
{AutoThreshold;}
MakeBinary;
Erode;
Erode;
Dilate;
Dilate;
AnalyzeParticles('label;outline;include');
ye:=rCount;
for j:=ys to ye do begin
rUser1[j]:=i;
rUser2[j]:=rX[j]+(rY[j]-1)*640.
end;
UpdateResults;
SelectAll;
Copy;
SelectPic(NewStack);
if i<>1 then AddSlice;
Paste;
SelectPic(OldStack); DeleteSlice;
end;
Dispose; {OldStack}
RestoreState;
ShowResults;
end; {of macro}
macro 'ANALYZE STACK with cleaning'; begin Analyze(true); end;
macro 'ANALYZE STACK no cleaning'; begin Analyze(false); end;