macro 'Display Calibration Table'; { Stores 0-255(all possible gray values) in the User1 column and the 256 corresponding calibrated values in the User2 column. Max Measurements must be set to 256 or greater. Use the Export command to export the calibration table to a text file. The two columns will be identical if the image is not calibrated. } var i:integer; v:real; begin RequiresVersion(1.44); SetCounter(256); SetUser1Label('value'); SetUser2Label('cvalue'); for i:=0 to 255 do begin rUser1[i+1]:=i; rUser2[i+1]:=cvalue(i); end; ShowResults; end; macro 'Measure and draw line [L]'; var x1,x2,y1,y2,width:integer; begin GetLine(x1,y1,x2,y2,width); if x1<0 then begin PutMessage('This macro requires a straight line selection.'); exit; end; Measure; Fill; KillRoi; end; macro 'Measure and Outline [M]'; begin Measure; DrawBoundary; DrawBoundary; end; macro 'Measure All'; {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 'Measure All 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; 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; macro 'Paste Results' {Use the Measure command, the ruler tool, or the pointing tool to} {make up to about 10 measurements, then use this macro to paste} {the results into the upper left corner of the window.} begin SetFont('Monaco'); SetFontSize(9); SetText('Plain; Align Left'); SetOption; {Copy headings} CopyResults; MakeRoi(-10,0,250,150); Paste; KillRoi; ResetCounter; end; macro 'Measure Redirected and Label' begin Redirect(true); Measure; Redirect(false); MarkSelection; RestoreRoi; end; macro 'Reset Measurement Options'; {Resets the Options dialog box in the Analyze menu to the default settings.} begin RequiresVersion(1.44); SetOptions('Area; Mean'); Redirect(false); LabelParticles(true); OutlineParticles(false); IgnoreParticlesTouchingEdge(false); IncludeInteriorHoles(false); WandAutoMeasure(false); AdjustAreas(false); SetParticleSize(1,999999); SetPrecision(2); end; macro 'Set ThresholdÉ'; var lower,upper:integer; begin lower:=GetNumber('Lower:',1); upper:=GetNumber('Upper:',254); SetDensitySlice(lower,upper); end; macro 'Measure Accumulated Perimeter[A]'; { Measures perimeter and computes accumulated perimeter, storing it in the User1 column. } var i:integer; Total:real; begin SetOptions('Area; Mean; Perimeter; User1'); SetUser1Label('Total'); Measure; Total:=0; for i:=1 to rCount do Total:=Total+rLength[i]; rUser1[rCount]:=Total; UpdateResults; end; macro 'Count Black and White Pixels [B]'; { Counts the number of black and white pixels in the current selection and stores the counts in the User1 and User2 columns. } begin RequiresVersion(1.44); SetUser1Label('Black'); SetUser2Label('White'); Measure; rUser1[rCount]:=histogram[255]; rUser2[rCount]:=histogram[0]; UpdateResults; end; macro 'Compute Percent Black and White'; { Computes the percentage of back and white pixels in the current selection. This macro only works with binary images. } var nPixels,mean,mode,min,max:real; begin RequiresVersion(1.44); SetUser1Label('Black'); SetUser2Label('White'); Measure; GetResults(nPixels,mean,mode,min,max); rUser1[rCount]:=histogram[255]/nPixels; rUser2[rCount]:=histogram[0]/nPixels; UpdateResults; if (histogram[0]+histogram[255])<>nPixels then PutMessage('This macro requires a binary image.'); end; macro 'Compute Area Percentage [P]'; { Computes the percentage of foreground pixels in the current selection. } var mean,mode,min,max:real; i,lower,upper,fPixels,nPixels,count:integer; begin RequiresVersion(1.50); SetUser1Label('%'); Measure; GetResults(nPixels,mean,mode,min,max); GetThresholds(lower,upper); if (lower=0) and (upper=0) and ((histogram[0]+histogram[255])<>nPixels) then begin PutMessage('This macro requires a binary or thresholded image.'); exit; end; if nPixels=0 then begin end; if (lower=0) and (upper=0) then begin if nPixels=0 then rUser1[rCount]:=0 else rUser1[rCount]:=(histogram[255]/nPixels)*100; UpdateResults; exit; end; fPixels:=0; nPixels:=0; for i:=0 to 255 do begin count:=histogram[i]; nPixels:=nPixels+count; if (i>=lower) and (i<=upper) then fPixels:=fPixels+count; end; rUser1[rCount]:=(fPixels/nPixels)*100; UpdateResults; end; macro 'Compute Average and Total Area [T]'; { Computes average and accumulated area and stores the them in the Major and Minor Axis columns. } var i:integer; sum:real; begin RequiresVersion(1.44); SetUser1Label('Avg'); SetUser2Label('Total'); SetOptions('Area; User1; User2'); Measure; sum:=0; for i:=1 to rCount do sum:=sum+rArea[i]; rUser1[rCount]:=sum/rCount; rUser2[rCount]:=sum; UpdateResults; end; macro 'Measure Circularity'; begin SetUser1Label('Shape'); Measure; rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount])); UpdateResults; end; macro 'Measure Sum of Pixel Values'; begin SetUser1Label('Mean*Area'); Measure; rUser1[rCount]:=rMean[rCount]*rArea[rCount]; UpdateResults; end; macro 'Draw XY Center'; var left,top,width,height,x,y:real; begin RequiresVersion(1.44); GetRoi(left,top,width,height); if width=0 then begin PutMessage('This macro requires a selection.'); exit; end; SaveState; {Invert Y status saved starting with V1.44b21} InvertY(false); SetForegroundColor(255); {black} SetOptions('Area; Mean; X-Y Center'); {XY Center} 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; macro 'Compute Spatial Scale'; var scale:real; begin MakeLineRoi(0,0,100,0); Measure; KillRoi; Scale:=100/rLength[rCount]; if scale=1 then PutMessage('Image is not spatially calibrated') else PutMessage('Scale=',scale:1:4,' pixels/unit'); end; procedure StoreZeros; begin Measure; rArea[rCount]:=0; rMean[rCount]:=0; rStdDev[rCount]:=0; rX[rCount]:=0; rY[rCount]:=0; rLength[rCount]:=0; rMajor[rCount]:=0; rMinor[rCount]:=0; rAngle[rCount]:=0; rUser1[rCount]:=0; rUser2[rCount]:=0; UpdateResults; end; macro 'Store Break in Results [S]'; {Stores a row of zeros in the results table.} begin StoreZeros; end; macro 'Compute Means'; var n,i:integer; begin n:=rCount; StoreZeros; StoreZeros; for i:=1 to n do begin rArea[rCount]:=rArea[rCount]+rArea[i]; rMean[rCount]:=rMean[rCount]+rMean[i]; rStdDev[rCount]:=rStdDev[rCount]+rStdDev[i]; rX[rCount]:=rX[rCount]+rX[i]; rY[rCount]:=rY[rCount]+rY[i]; rLength[rCount]:=rLength[rCount]+rLength[i]; rMajor[rCount]:=rMajor[rCount]+rMajor[i]; rMinor[rCount]:=rMinor[rCount]+rMinor[i]; rAngle[rCount]:=rAngle[rCount]+rAngle[i]; rUser1[rCount]:=rUser1[rCount]+rUser1[i]; rUser2[rCount]:=rUser2[rCount]+rUser2[i]; end; rArea[rCount]:=rArea[rCount]/n; rMean[rCount]:=rMean[rCount]/n; rStdDev[rCount]:=rStdDev[rCount]/n; rX[rCount]:=rX[rCount]/n; rY[rCount]:=rY[rCount]/n; rLength[rCount]:=rLength[rCount]/n; rMajor[rCount]:=rMajor[rCount]/n; rMinor[rCount]:=rMinor[rCount]/n; rAngle[rCount]:=rAngle[rCount]/n; rUser1[rCount]:=rUser1[rCount]/n; rUser2[rCount]:=rUser2[rCount]/n; UpdateResults; end; macro 'Measure both Raw and Calibrated'; { This macro is a variation of the Measure command that displays the number of pixels in User1 and uncalibrated(raw) mean density in User2. It takes advantage of the fact that GetResults always returns uncalibrated values. } var nPixels,mean,mode,min,max:real; begin SetUser1Label('Pixels'); SetUser2Labe2('Raw Mean'); Measure; GetResults(nPixels,mean,mode,min,max); rUser1[rCount]:=nPixels; rUser2[rCount]:=mean; UpdateResults; end; macro 'Mark Centers'; {Replaces each object in the image with a single pixel.} var i:integer; begin Duplicate('Center'); SetScale(0,'pixels'); AutoThreshold; AnalyzeParticles; SelectAll; Clear; For i:=1 to rCount do PutPixel(rX[i],rY[i],255); end; macro 'Density Slice [D]'; var t1,t2:integer; begin GetThresholds(t1,t2); if (t1=0) and (t2=0) then SetDensitySlice(255,255) else SetDensitySlice(0,0); end; macro 'Set Scale and Aspect Ratio'; { Sets the spatial scale and aspect ratio to predefined values contained in an image names "scale". This image can be very small, say 20x10. The directory (folder) path in the open statement will probably have to be changed. } begin open('hd400:image:scale'); PropagateSpatial; Dispose; end; macro 'Write Results to Text Window'; {This is an example of how to save results in a text window.} var year,month,day,hour,minute,second,dow:integer; begin GetTime(year,month,day,hour,minute,second,dow); Measure; NewTextWindow('My Results'); writeln('Date=',year-1900:1,':',month:1,':',day:1); writeln('Time=',hour:1,':'minute:1,':',second:1); writeln('Area=',rArea[rCount]:1:3); writeln('Mean=',rMean[rCount]:1:3); end; macro 'Find Radial Distances'; {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; 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('Temp'); 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:=GetNumber('Number of Radial Lines:',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:=i-1; 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 'Copy Results to Clipboard with Headers'; begin SelectWindow('Results'); SetOption; Copy; end; Macro 'Export Results with Headers'; begin SetExport('Measurements'); SetOption; Export('HD80:Image:Results'); end; macro 'Feret Dimensions [F]'; var xloc,yloc,width,height:integer; begin SetUser1Label('X Feret'); SetUser2Label('Y Feret'); Measure; GetRoi(xloc,yloc,width,height); rUser1[rCount]:=width; rUser2[rCount]:=height; UpdateResults; end; macro 'Bounding Rectangle'; var xloc,yloc,width,height:integer; begin GetRoi(xloc,yloc,width,height); ShowMessage('xmin=', xloc, '\ymin=', yloc, '\xmax=', xloc+width-1, '\ymax=', yloc+height-1); end;