{Cell Analysis Macros See "http://pages.wooster.edu/billingsj/HowTo/IS-Howto.html" for documentation.} var n,threshhold:integer; {==================================================================} 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 'First Slice [F]'; begin CheckForStack; SelectSlice(1) end; {==================================================================} macro 'Last Slice [L]'; begin CheckForStack; SelectSlice(nSlices) end; {==================================================================} macro 'Select SliceÉ [S]'; begin CheckForStack; n:=GetNumber('Slice Number:',trunc(nSlices/2)); SelectSlice(n) end; {============================================================= This procedure Prepares the image so the cells can be counted or measured. It removes the background noise, and makes the cells more obvious. First it copies the image to another window, makes a mask, and divides the image by the mask, so all thats left is what was in the mask.} procedure prep(iten,dithercount, erodecount:integer); var mean, mode, min, max:integer; begin ResetCounter; {Smooth;} {SubtractBackground('2D Rolling Ball (faster)', 0);} Sharpen; Filter('find edges'); SetThreshold(threshhold); SetBinaryCount(dithercount); for n :=1 to iten do Dilate; SetBinaryCount(erodecount); for n :=1 to (iten-2) do Erode; ReduceNoise; end; {============================================================= Procedure CellScope } procedure cellscope; var totalcells:integer; begin totalcells:=rcount; for n:=1 to totalcells do begin if (rminor[n]<>0) and (rArea[n]>0) then begin if (rmajor[n] / rminor[n] <5) then ruser1[n]:=(rmajor[n] / rminor[n]); end else ruser1[n]:=255 ; end; end; {=============================================================} procedure getcells(small,large:integer); begin {set the options for the particle analyis} setoptions('Area Angle X-Y Center Major Minor User1 User2' ); {Gets Ready to Find the cells} LabelParticles(false); OutlineParticles(false); IgnoreParticlesTouchingEdge(False); IncludeInteriorHoles(true); SetParticleSize(small, large); AnalyzeParticles; end; {=============================================================} procedure analyseSlice(small, big:integer); var i,j:integer; IsCell, NotCell:boolean; begin {This prepares the image for cell analysis} prep(4,3,4); setuser1label('Maj/Min'); {Ratio of Major Axis to minor axis} GetCells(5, 999); ShowMessage(rarea[2],'\',rX[2],'\',ry[2]); CellScope; i:=5; j:=999; NotCell:=true; for n:=1 to rcount do begin if rMinor[n] >0 then begin IsCell:=(rMajor[n]/rMinor[n] > 1.5) and (rMajor[n]/rMinor[n] < 3); if NotCell and IsCell then begin i:=rArea[n]; j:=rArea[n]; NotCell:=false; end; if iscell and (rArea[n] > i) then begin i:=rArea[n]; end else if IsCell and (rArea[n] < j) then begin j:=rArea[n]; end; end; end; small:=j; big:=i; end; {==================================================================} {Macros! } {==================================================================} macro '(-' begin end; {==================================================================} macro 'Prepare one slice' begin if nPics=0 then begin PutMessage('This macro requires a stack.'); exit; end; prep(4,2,3); end; {==================================================================} macro 'AnalyseSlice' var x,y:integer; begin prep(4,3,4); getCells(x,y); showresults; end; {==================================================================} macro '(-' begin end; {==================================================================} macro 'Prepare Stack[1]'; var i,small,big:integer; begin CheckForStack; NewTextWindow('text'); small:=50; big:=70; resetCounter; writeln('Slice',chr(9),'Particle #',chr(9),'area',chr(9),'X coordinates',chr(9),'Y coordinates',chr(9),'Maj/Min ratio',chr(9),'Angle'); for i:= 1 to nSlices do begin ChooseSlice(i); prep(4,2,3); GetCells(small,big); for n:= 1 to rCount do Writeln(i:1,chr(9),n:1,chr(9),rArea[n],chr(9), rX[n]:1:1,chr(9),rY[n]:1:1,chr(9), (rMajor[n]/rMinor[n]):1:2,chr(9),rAngle[n]:1:2); end; ResetCounter; end; SelectSlice(1); end; {==================================================================} macro 'Path Stack[2]'; var i,small,big, dist,w,h,oldx, oldy,oldangle,speed, StackPid, PathPid, AngleDiff:integer; begin CheckForStack; SetLineWidth(1); StackPid:=PidNumber; GetPicSize(w,h); MakeNewWindow('path'); SetNewSize(w,h); PathPid:=PidNumber; ChoosePic(StackPid); small:=getnumber('Enter smallest particle', 5); big:=getnumber('Enter Largest particle' ,200); dist:=getnumber('Enter Frame Difference.', 10); threshhold:=getnumber('Enter Threshhold', 100); ShowMessage('Click on the cell in the first slice.'); SelectSlice(1); SelectPic(StackPid); SetCursor('cross'); repeat until button; GetMouse(oldx, oldy); OldAngle:=0; speed:=0; SetCursor('arrow'); { NewTextWindow('Angle',200, 400);} resetCounter; for i:= 1 to nSlices do begin ChooseSlice(i); prep(10,5,5); GetCells(small,big); ChoosePic(pathpid); for n:= 1 to rCount do if ((sqrt(sqr(rX[n] - oldx) + sqr(rY[n] - oldy))) <= dist) then {the cell track <= possible distance to travel} begin moveto(oldx,oldy); lineto(rX[n], rY[n]); ImageMath('add',pathpid,stackpid,1,0,StackPid); if (abs(oldangle - rAngle[n])<90) then anglediff:= abs(oldangle - rAngle[n]) else anglediff:= (180 - abs(oldangle - rAngle[n])); rUser1[i]:=AngleDiff; rUser2[n]:=sqrt(sqr(rX[n] - oldx) + sqr(rY[n] - oldy)); Showmessage (rUser1[n],'/',rUser2[n]); oldx:=rX[n]; oldy:=rY[n]; oldangle:=rAngle[n]; end; end; SelectSlice(1); NewTextWindow('Angle Difference per frame', 150, 400); Writeln('Slice Angle Difference pixels/frame'); for i:= 1 to nSlices do Writeln(i:3, chr(9), rUser1[i]:1:3, chr(9), rUser2[i]:1:3); end;