unit Analysis;

{Analysis routines used by the Image program}

interface

	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, LeastSquares, Graphics, file1, file2, Ellipse, camera;



	procedure DoHistogram;
	procedure GetRectHistogram;
	function SetupMask: boolean;
	procedure GetNonRectHistogram;
	procedure ShowContinuousHistogram;
	procedure ComputeResults;
	procedure FindThresholdingMode;
	procedure Measure;
	procedure ComputeLength (nvertices: integer; var xa, ya: xyArray; FindingPerimeterLength: boolean);
	procedure ShowLineWidth;
	procedure DoProfilePlotOptions;
	procedure ShowMeasurements;
	procedure ColumnAveragePlot;
	procedure SetScale;
	procedure Calibrate;
	procedure ResetCounter;
	procedure DoMeasurementOptions;
	procedure DoPoints (event: EventRecord);
	procedure FindAngle (event: EventRecord);
	procedure SaveBlankField;
	procedure UndoLastMeasurement (DisplayResults: boolean);
	procedure MarkSelection (count: integer);
	procedure AutoOutline (start: point);
	procedure RedoMeasurement;
	procedure DeleteMeasurement;
	procedure AnalyzeParticles;


implementation

	var
		WandMode: (LUTMode, GrayMapMode, BinaryMode);
		GrayMapThreshold: integer;
		InfoForRedirect: InfoPtr;



	procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt);
{}
{TYPE}
{  lptr=^LineType;}
{VAR}
{  line:lptr;}
{  i,value:integer;}
{BEGIN}
{  line:=lptr(data);}
{  FOR i:=0 TO width-1 DO BEGIN}
{    value:=line^[i];}
{    histogram[value]:=histogram[value]+1;}
{  END;}
{}
    {a0=data}
    {a1=histogram}
    {d0=width}
    {d1=pixel value}
	inline
		$4E56, $0000, {  link a6,#0}
		$48E7, $C0C0, {  movem.l a0-a1/d0-d1,-(sp)}
		$206E, $000C, {  move.l 12(a6),a0}
		$226E, $0008, {  move.l 8(a6),a1}
		$202E, $0004, {  move.l 4(a6),d0}
		$5380,       {  subq.l #1,d0}
		$4281,       {L clr.l d1}
		$1218,       {  move.b (a0)+,d1}
		$E541,       {  asl.w #2,d1}
		$52B1, $1800, {  addq.l #1,0(a1,d1.l)}
		$51C8, $FFF4, {  dbra d0,L}
		$4CDF, $0303, {  movem.l (sp)+,a0-a1/d0-d1}
		$4E5E,       {  unlk a6}
		$DEFC, $000C; {  add.w #12,sp}
{END;}


	procedure GetRectHistogram;
		var
			width, i, NumberOfLines: integer;
			offset: LongInt;
			p: ptr;
	begin
		if TooWide then
			exit(GetRectHistogram);
		if RedirectSampling then
			PutMessage('Use a nonrectangular selection for redirected sampling.');
		ShowWatch;
		for i := 0 to 255 do
			Histogram[i] := 0;
		with info^.RoiRect, info^ do begin
				offset := LongInt(top) * BytesPerRow + left;
				p := ptr(ord4(PicBaseAddr) + offset);
				width := right - left;
				NumberOfLines := bottom - top;
			end;
		if width > 0 then
			for i := 1 to NumberOfLines do begin
					DoHistogramOfLine(p, histogram, width);
					p := ptr(ord4(p) + info^.BytesPerRow);
				end
	end;


	function SetupMask: boolean;
{Creates a mask in the undo buffer for operating}
{on non-rectangular selections .}
		var
			tPort: GrafPtr;
			SaveInfo: InfoPtr;
	begin
		if NoUndo then begin
				SetupMask := false;
				exit(SetupMask)
			end;
		SetupUndoInfoRec;
		SaveInfo := Info;
		Info := UndoInfo;
		GetPort(tPort);
		with Info^ do begin
				SetPort(GrafPtr(osPort));
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				PenNormal;
				EraseRect(RoiRect);
				PaintRgn(roiRgn);
			end;
		SetPort(tPort);
		Info := SaveInfo;
		SetupMask := true;
	end;


	procedure SetupRedirectedSampling;
		var
			info1, info2: InfoPtr;
	begin
		InfoForRedirect := nil;
		if nPics <> 2 then begin
				PutMessage('There must be exactly two image windows open to do redirected sampling.');
				AnalyzingParticles := false;
				exit(SetupRedirectedSampling);
			end;
		Info1 := pointer(WindowPeek(PicWindow[1])^.RefCon);
		Info2 := pointer(WindowPeek(PicWindow[2])^.RefCon);
		if not EqualRect(info1^.PicRect, info2^.PicRect) then begin
				PutMessage('The image windows must be exactly the same size to do redirected sampling.');
				AnalyzingParticles := false;
				exit(SetupRedirectedSampling);
			end;
		if info = info1 then
			InfoForRedirect := info2
		else
			InfoForRedirect := info1;
	end;


	procedure GetNonRectHistogram;
		var
			MaskLine, DataLine: LineType;
			width, i, vloc: integer;
			sum, sum2, count, OverFlows: LongInt;
			SaveInfo: InfoPtr;
			value: LongInt;
			trect: rect;
	begin
		if TooWide then
			exit(GetNonRectHistogram);
		ShowWatch;
		if RedirectSampling then
			SetupRedirectedSampling
		else
			InfoForRedirect := nil;
		if not SetupMask then
			beep;
		SaveInfo := Info;
		for i := 0 to 255 do
			Histogram[i] := 0;
		if FitEllipse then
			ResetSums;
		trect := info^.RoiRect;
		with trect do begin
				width := right - left;
				for vloc := top to bottom - 1 do begin
						if InfoForRedirect <> nil then
							Info := InfoForRedirect
						else
							Info := SaveInfo;
						GetLine(left, vloc, width, DataLine);
						Info := UndoInfo;
						GetLine(left, vloc, width, MaskLine);
						if FitEllipse then
							ComputeSums(vloc - top, width, MaskLine);
						for i := 0 to width - 1 do
							if MaskLine[i] = BlackIndex then begin
									value := DataLine[i];
									histogram[value] := histogram[value] + 1;
								end;
					end;
			end;
		Info := SaveInfo;
		if not AnalyzingParticles then begin
				SetupUndo; {Needed for drawing "marching ants".}
				WhatToUndo := NothingToUndo;
			end;
	end;


	procedure ComputeResults;
		var
			MaxCount, icount, isum, n: LongInt;
			i: integer;
			sum, sum2, ri, rcount, UncalibratedMean, tSD, rmode, xc, yc: extended;
			Major, Minor, EllipseAngle, hcenter, vcenter, calValue: extended;
			MinCalibratedValue, MaxCalibratedValue: extended;
	begin
		with info^, results do begin
				case ThresholdingMode of
					DensitySlice: 
						MinIndex := SliceStart;
					GrayMapThresholding: 
						MinIndex := GrayMapThreshold;
					BinaryImage: 
						MinIndex := BlackIndex;
					NoThresholding: 
						MinIndex := 0;
				end;
				if RedirectSampling or IncludeHoles then
					MinIndex := 0;
				while (histogram[MinIndex] = 0) and (MinIndex < 255) do
					MinIndex := MinIndex + 1;
				case ThresholdingMode of
					DensitySlice: 
						MaxIndex := SliceEnd;
					GrayMapThresholding: 
						MaxIndex := 255;
					BinaryImage: 
						MaxIndex := BlackIndex;
					NoThresholding: 
						MaxIndex := 255;
				end;
				if RedirectSampling or IncludeHoles then
					MaxIndex := 255;
				while (histogram[MaxIndex] = 0) and (MaxIndex > 0) do
					MaxIndex := MaxIndex - 1;
				MaxCount := 0;
				sum := 0.0;
				isum := 0;
				sum2 := 0.0;
				n := 0;
				minCalibratedValue := 10e100;
				maxCalibratedValue := -10e100;
				for i := MinIndex to MaxIndex do begin
						calValue := cvalue[i];
						icount := histogram[i];
						rcount := icount;
						sum := sum + rcount * calValue;
						isum := isum + icount * i;
						ri := i;
						sum2 := sum2 + sqr(calValue) * rcount;
						n := n + icount;
						if icount > MaxCount then begin
								MaxCount := icount;
								rmode := cvalue[i];
								imode := i
							end;
						if calValue < minCalibratedValue then
							minCalibratedValue := calValue;
						if calValue > maxCalibratedValue then
							maxCalibratedValue := calValue;
					end;
				if ContinuousHistoGram then
					exit(ComputeResults);
				if n > 0 then begin
						tmean := sum / n;
						UncalibratedMean := isum / n
					end
				else begin
						tmean := 0.0;
						UncalibratedMean := 0.0
					end;
				imean := round(UncalibratedMean);
				IncrementCounter;
				mean^[mCount] := tmean;
				mMin^[mCount] := minCalibratedValue;
				mMax^[mCount] := maxCalibratedValue;
				if mCount <= MaxStandards then
					umean[mCount] := UncalibratedMean;
				if (n > 0) and (tmean > 0.0) then begin
						rcount := n;
						tSD := (rcount * Sum2 - sqr(sum)) / rcount;
						if tSD > 0.0 then
							tSD := sqrt(tSD / (rcount - 1.0))
						else
							tSD := 0.0
					end
				else
					tSD := 0.0;
				sd^[mCount] := tSD;
				with info^.RoiRect do begin
						xc := left + (right - left) / 2;
						yc := top + (bottom - top) / 2;
						if InvertYCoordinates then
							yc := PicRect.bottom - yc;
						if SpatialScale <> 0.0 then begin
								xc := xc / SpatialScale;
								yc := yc / SpatialScale;
							end;
						xcenter^[mCount] := xc;
						ycenter^[mCount] := yc;
					end;
				PixelCount^[mCount] := n;
				if SpatialScale <> 0.0 then
					mArea^[mCount] := n / sqr(SpatialScale)
				else
					mArea^[mCount] := n;
				mode^[mCount] := rmode;
				if (LengthM in measurements) or (nLengths > 0) then begin
						if not (CurrentTool = FreehandTool) or (CurrentTool = PolygonTool) then
							with info^.RoiRect do
								case RoiType of
									RectRoi, RoundRectRoi: 
										PixelLength := ((right - left) + (bottom - top)) * 2.0;
									OvalRoi: 
										PixelLength := pi * ((right - left) + (bottom - top)) / 2.0;
									otherwise
								end; {case}
						if SpatialScale <> 0.0 then
							plength^[mCount] := PixelLength / SpatialScale
						else
							plength^[mcount] := PixelLength
					end
				else
					plength^[mCount] := 0.0;
				if FitEllipse and (RoiType <> RectRoi) then begin
						GetEllipseParam(Major, Minor, EllipseAngle, xc, yc);
						if InvertYCoordinates then
							yc := PicRect.bottom - yc;
						if SpatialScale <> 0.0 then begin
								Major := Major / SpatialScale;
								Minor := Minor / SpatialScale;
								xc := xc / SpatialScale;
								yc := yc / SpatialScale;
							end;
						MajorAxis^[mCount] := Major * 2.0;
						MinorAxis^[mCount] := Minor * 2.0;
						orientation^[mCount] := EllipseAngle;
						xcenter^[mCount] := xc;
						ycenter^[mCount] := yc;
					end
				else begin
						MajorAxis^[mCount] := 0.0;
						MinorAxis^[mCount] := 0.0;
						orientation^[mCount] := 0.0;
					end;
			end; {with}
		measuring := true;
		ResultsMessage := '';
	end;


	procedure FindThresholdingMode;
	begin
		with info^ do begin
				if DensitySlicing then
					ThresholdingMode := DensitySlice
				else if thresholding then begin
						ThresholdingMode := GrayMapThresholding;
						GrayMapThreshold := 255 - p1x;
					end
				else if BinaryPic then
					ThresholdingMode := BinaryImage
				else
					ThresholdingMode := NoThresholding;
			end;
	end;


	procedure Measure;
		var
			AutoSelectAll: boolean;
			SaveN: integer;
	begin
		if NotInBounds then
			exit(Measure);
		FindThresholdingMode;
		if ThresholdingMode = BinaryImage then
			ThresholdingMode := NoThresholding;
		StopDigitizing;
		AutoSelectAll := not info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(false);
		if info^.RoiType = RectRoi then
			GetRectHistogram
		else
			GetNonRectHistogram;
		if MeasurementToRedo > 0 then begin
				SaveN := mCount;
				mCount := MeasurementToRedo - 1;
				ComputeResults;
				ShowResults;
				mCount := SaveN;
				MeasurementToRedo := 0;
				UpdateList;
			end
		else begin
				ComputeResults;
				ShowResults;
				AppendResults;
			end;
		info^.RoiShowing := true;
		WhatToUndo := UndoMeasurement;
		if AutoSelectAll then
			KillRoi;
		UpdateScreen(OldRoiRect);
	end;


	procedure ShowHistogram;
		var
			htop: integer;
			tport: GrafPtr;
			hrect, prect, srect: rect;
	begin
		GetPort(tPort);
		if HistoWindow = nil then begin
				htop := ScreenHeight - hheight - 10;
				SetRect(HistoRect, hleft, htop, hleft + hwidth, htop + hheight);
				HistoWindow := NewWindow(nil, HistoRect, 'Histogram', true, NoGrowDocProc, nil, true, 0);
				WindowPeek(HistoWindow)^.WindowKind := HistoKind;
			end;
		SelectWindow(HistoWindow);
		SetPort(HistoWindow);
		InvalRect(HistoWindow^.PortRect);
		SetPort(tPort);
	end;


	procedure ShowContinuousHistogram;
		const
			skip = 10;
		var
			i, NumberOfLines: integer;
			offset: LongInt;
			p: ptr;
	begin
		for i := 0 to 255 do
			Histogram[i] := 0;
		p := ptr(ptr(DTSlotBase));
		NumberOfLines := ((qcHeight) div skip) - 1;
		offset := qcRowBytes * skip;
		for i := 1 to NumberOfLines do begin
				DoHistogramOfLine(p, histogram, qcWidth);
				p := ptr(ord4(p) + offset);
			end;
		ThresholdingMode := NoThresholding;
		HistogramSliceStart := 0;
		HistogramSliceEnd := 255;
		ComputeResults;
		ShowHistogram;
	end;


	procedure DoHistogram;
		var
			AutoSelectAll: boolean;
	begin
		if NotInBounds then
			exit(DoHistogram);
		if digitizing then begin
				if ContinuousHistogram then
					ContinuousHistogram := false
				else begin
						ContinuousHistogram := true;
						if info <> NoInfo then
							with info^ do begin
									RoiType := NoRoi;
									RoiRect := SrcRect;
								end;
					end;
				exit(DoHistogram)
			end;
		AutoSelectAll := not info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(false);
		if info^.RoiType = RectRoi then
			GetRectHistogram
		else
			GetNonRectHistogram;
		ThresholdingMode := NoThresholding;
		ComputeResults;
		ShowCount := false;
		ShowResults;
		ShowCount := true;
		FindThresholdingMode;
		case ThresholdingMode of
			DensitySlice: 
				begin
					HistogramSliceStart := SliceStart;
					HistogramSliceEnd := SliceEnd;
				end;
			GrayMapThresholding: 
				begin
					HistogramSliceStart := GrayMapThreshold;
					HistogramSliceEnd := 255;
				end;
			BinaryImage, NoThresholding: 
				begin
					HistogramSliceStart := 0;
					HistogramSliceEnd := 255;
				end;
		end;
		ShowHistogram;
		UndoLastMeasurement(false);
		WhatToUndo := NothingToUndo;
		if AutoSelectAll then
			KillRoi;
	end;


	procedure ColumnAveragePlot;
		var
			vloc, value, width, height, i: integer;
			sum: array[0..MaxPixelsPerLine] of LongInt;
			start: point;
			tPort: GrafPtr;
	begin
		if NoSelection or NotRectangular or NotInBounds then
			exit(ColumnAveragePlot);
		ShowWatch;
		with info^.RoiRect do begin
				width := right - left;
				height := bottom - top;
				for i := 0 to width - 1 do
					sum[i] := 0;
				for vloc := top to bottom - 1 do begin
						GetLine(left, vloc, width, PlotData);
						for i := 0 to width - 1 do
							sum[i] := sum[i] + PlotData[i];
					end;
				start.h := left;
				start.v := bottom;
				OffscreenToScreen(start);
			end;
		for i := 0 to width - 1 do
			PlotData[i] := sum[i] div height;
		PlotCount := width;
		PlotAvg := height;
		SetupPlot(PlotData, start);
	end;


	procedure SetScale;
		const
			FirstButtonID = 5;
			LastButtonID = 14;
			ActualDistanceID = 3;
			ScaleID = 16;
			UnitsTextID = 18;
			MagnificationID = 20;
			MeasuredDistanceID = 22;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveUnitsID: UnitsType;
			ActualDistance, MeasuredDistance, SaveScale, TempScale: extended;
			OldUnitsPerCM, OldScale, SaveUnitsPErCM, SaveRawScale, SaveMagnification: extended;
			ignore: integer;
			str: str255;
			SaveUnits: string[2];
	begin
		with info^ do begin
				if (RawSpatialScale = 0.0) and (nLengths = 0) then begin
						PutMessage('Before using Set Scale you must use the ruler tool to measure a known distance.');
						exit(SetScale)
					end;
				InitCursor;
				if (mCount = 0) or (nLengths = 0) then
					MeasuredDistance := 0.0
				else
					MeasuredDistance := plength^[mCount];
				SaveUnits := units;
				SaveUnitsID := UnitsID;
				SaveRawScale := RawSpatialScale;
				SaveScale := SpatialScale;
				SaveMagnification := ScaleMagnification;
				ActualDistance := 0.0;
				OldScale := 0.0;
				mylog := GetNewDialog(10, nil, pointer(-1));
				SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 1);
				SetDReal(MyLog, ActualDistanceID, ActualDistance, 1);
				SelIText(MyLog, ActualDistanceID, 0, 32767);
				SetDReal(MyLog, MagnificationID, ScaleMagnification, 1);
				if UnitsID = pixels then
					TempScale := 1.0
				else
					TempScale := SpatialScale;
				SetDReal(MyLog, ScaleID, TempScale, 2);
				SetDString(MyLog, UnitsTextID, FullUnits);
				OutlineButton(MyLog, ok, 16);
				SetDialogItem(mylog, FirstButtonID + ord(UnitsID), 1);
				repeat
					ModalDialog(nil, item);
					if item = MeasuredDistanceID then
						MeasuredDistance := GetDReal(MyLog, MeasuredDistanceID);
					if item = ActualDistanceID then
						ActualDistance := GetDReal(MyLog, ActualDistanceID);
					if item = MagnificationID then begin
							ScaleMagnification := GetDReal(MyLog, MagnificationID);
							if ScaleMagnification < 0.0 then begin
									beep;
									ScaleMagnification := 1.0;
								end
							else
								SpatialScale := RawSpatialScale * ScaleMagnification;
						end;
					if (item >= FirstButtonID) and (item <= LastButtonID) then begin
							for i := FirstButtonID to LastButtonID do
								SetDialogItem(mylog, i, 0);
							SetDialogItem(mylog, item, 1);
							if (item = LastButtonID) and (UnitsID <> Pixels) then begin
									OldScale := RawSpatialScale;
									SaveUnitsPerCM := UnitsPerCM
								end;
							OldUnitsPerCM := UnitsPerCM;
							GetUnits(item);
							if (UnitsID <> Pixels) and (RawSpatialScale = 0.0) and (OldScale <> 0.0) then begin
									RawSpatialScale := OldScale;
									SpatialScale := RawSpatialScale * ScaleMagnification;
									OldUnitsPerCM := SaveUnitsPerCM;
									OldScale := 0.0;
								end;
							if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) then begin
									RawSpatialScale := RawSpatialScale * (OldUnitsPerCM / UnitsPerCM);
									SpatialScale := RawSpatialScale * ScaleMagnification;
								end;
							if UnitsID = Pixels then
								ActualDistance := 0.0;
						end;
					if (item = ActualdistanceID) or (item = MeasuredDistanceID) then
						if (UnitsID = Pixels) and (item <> cancel) then
							PutMessage('You must select a measurent unit before setting or changing the scale.')
						else begin
								if (MeasuredDistance > 0.0) and (ActualDistance > 0.0) then begin
										RawSpatialScale := MeasuredDistance / ActualDistance;
										SpatialScale := RawSpatialScale * ScaleMagnification;
									end;
							end;
					if UnitsID = pixels then
						TempScale := 1.0
					else
						TempScale := SpatialScale;
					SetDReal(MyLog, ScaleID, TempScale, 2);
					SetDString(MyLog, UnitsTextID, FullUnits);
				until (item = ok) or (item = cancel);
				DisposDialog(mylog);
				if item = cancel then begin
						units := SaveUnits;
						UnitsID := SaveUnitsID;
						RawSpatialScale := SaveRawScale;
						SpatialScale := SaveScale;
						ScaleMagnification := SaveMagnification;
					end;
			end; {with info^}
	end;


	procedure SetupCalibrationPlot;
		const
			hrange = 1024;
			hmax = 1023;
			vrange = 600;
			vmax = 599;
			SymbolSize = 11;
		var
			fRect, tRect: rect;
			svalue, range, hscale, vscale, MinV, MaxV: extended;
			tPort: GrafPtr;
			i, hloc, vloc: integer;
			SaveClipRegion: RgnHandle;
			pt: point;
	begin
		PlotLeftMargin := 35;
		PlotTopMargin := 15;
		PlotBottomMargin := 30;
		PlotRightMargin := 100;
		MinV := MinValue;
		MaxV := MaxValue;
		for i := 1 to nStandards do begin
				svalue := StandardValues[i];
				if svalue < MinV then
					MinV := svalue;
				if svalue > MaxV then
					MaxV := svalue;
			end;
		range := MaxV - MinV;
		PlotWidth := hrange div 3 + PlotLeftMargin + PlotRightMargin;
		PlotHeight := vrange div 3 + PlotTopMargin + PlotBottomMargin;
		PlotLeft := 64;
		PlotTop := 64;
		PlotCount := 256;
		MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
		WindowPeek(PlotWindow)^.WindowKind := CalibrationPlotKind;
		SetRect(fRect, -SymbolSize, -SymbolSize, hmax + SymbolSize, vmax + SymbolSize);
		GetPort(tPort);
		SetPort(PlotWindow);
		SaveClipRegion := PlotWindow^.ClipRgn;
		RectRgn(PlotWindow^.ClipRgn, fRect);
		hscale := 256 / hrange;
		vscale := range / vrange;
		PlotPICT := OpenPicture(fRect);
		for i := 1 to nStandards do begin
				hloc := round(umean[i] / hscale);
				vloc := vmax - round((StandardValues[i] - MinValue) / vscale);
				SetRect(tRect, hloc - SymbolSize, vloc - SymbolSize, hloc + SymbolSize, vloc + SymbolSize);
				FrameOval(tRect);
			end;
		MoveTo(0, vmax - round((cvalue[0] - MinValue) / vscale));
		for i := 1 to 255 do begin
				hloc := round(i / hscale);
				vloc := vmax - round((cvalue[i] - MinValue) / vscale);
				LineTo(hloc, vloc);
			end;
		ClosePicture;
		PlotWindow^.ClipRgn := SaveClipRegion;
		InvalRect(PlotWindow^.PortRect);
		SetPort(tPort);
		SelectWindow(PlotWindow);
	end;


	procedure DoCurveFitting;
		var
			i: integer;
			XData, YData, YFit, Residuals: TNColumnVector;
			Solution: TNRowVector; {Coefficients}
			TypeFit: FitType;
			Variance: extended;
			SumResidualsSqr, SumStandards, mean, SumMeanDiffSqr, DegreesOfFreedom: extended;
			err: byte;
			fil: text;
			str1, str2: str255;
			tempdata: TNColumnVector;
	begin
		with info^ do begin
				ShowWatch;
				if fit = RodbardFit then { need to reverse x and y to fit Rodbard equation }
					for i := 1 to nStandards do begin
							XData[i] := StandardValues[i];
							YData[i] := umean[i];
						end
				else
					for i := 1 to nStandards do begin
							XData[i] := umean[i];
							YData[i] := StandardValues[i];
						end;
				case fit of
					StraightLine: 
						begin
							nCoefficients := 2;
							TypeFit := poly
						end;
					Poly2: 
						begin
							nCoefficients := 3;
							TypeFit := poly
						end;
					Poly3: 
						begin
							nCoefficients := 4;
							TypeFit := poly
						end;
					Poly4: 
						begin
							nCoefficients := 5;
							TypeFit := poly
						end;
					Poly5: 
						begin
							nCoefficients := 6;
							TypeFit := poly
						end;
					ExpoFit: 
						begin
							nCoefficients := 2;
							TypeFit := expo
						end;
					PowerFit: 
						begin
							nCoefficients := 2;
							TypeFit := power
						end;
					LogFit: 
						begin
							nCoefficients := 2;
							TypeFit := log
						end;
					RodbardFit: 
						begin
							nCoefficients := 4;
							TypeFit := rodbard
						end;
				end;
				DegreesOfFreedom := nStandards - nCoefficients;
				if DegreesOfFreedom < 0 then begin
						FitGoodness := 0.0;
						calibrated := false;
						NumToString(nCoefficients, str1);
						case fit of
							StraightLine: 
								str2 := 'straight line';
							Poly2: 
								str2 := '2nd degree polynomial';
							Poly3: 
								str2 := '3rd degree polynomial';
							Poly4: 
								str2 := '4th degree polynomial';
							Poly5: 
								str2 := '5th degree polynomial';
							ExpoFit: 
								str2 := 'exponential';
							PowerFit: 
								str2 := 'power';
							LogFit: 
								str2 := 'log';
							RodbardFit: 
								str2 := '4 parameter general';
						end;
						str2 := concat(' standards to do ', str2, ' fitting.');
						PutMessage(concat('You need at least ', str1, str2));
						exit(DoCurveFitting)
					end;
				LeastSquares(nStandards, XData, YData, nCoefficients, Solution, YFit, Residuals, FitSD, Variance, err, TypeFit);
				for i := 1 to nCoefficients do
					Coefficient[i] := solution[i];
				calibrated := true;
				GenerateValues;
				SumResidualsSqr := 0.0;
				SumStandards := 0.0;
				if fit = RodbardFit then
					for i := 1 to nStandards do begin
							tempdata[i] := StandardValues[i];
							StandardValues[i] := umean[i];
						end;
				for i := 1 to nStandards do begin
						SumResidualsSqr := SumResidualsSqr + sqr(residuals[i]);
						SumStandards := SumStandards + StandardValues[i];
					end;
				mean := SumStandards / nStandards;
				SumMeanDiffSqr := 0.0;
				for i := 1 to nStandards do
					SumMeanDiffSqr := SumMeanDiffSqr + sqr(StandardValues[i] - Mean);
				if SumMeanDiffSqr > 0.0 then
					FitGoodness := 1 - (SumResidualsSqr / DegreesOfFreedom) * ((nStandards - 1) / SumMeanDiffSqr)
				else
					FitGoodness := 1.0;
				if fit = RodbardFit then
					for i := 1 to nStandards do
						StandardValues[i] := tempdata[i];
			end;
		info^.changes := true;
	end;


	procedure GetStandardsFromFile (mylog: DialogPtr; FirstLevelID, FirstStandardID: integer);
		var
			fname, str: str255;
			RefNum, i, nColumns, nValues: integer;
			rLine: rLineType;
	begin
		if not OpenTextFile(fname, RefNum) then
			exit(GetStandardsFromFile);
		InitTextInput(fname, RefNum);
		GetLineFromText(rLine, nValues);
		if nValues = 1 then
			nColumns := 1
		else
			nColumns := 2;
		if (nStandards = 0) and (nColumns = 2) then begin
				i := 0;
				repeat
					i := i + 1;
					if i > MaxStandards then
						i := MaxStandards;
					umean[i] := rLine[1];
					SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2);
					StandardValues[i] := rLine[2];
					SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3);
					GetLineFromText(rLine, nValues);
				until nValues = 0;
				nStandards := i;
			end
		else
			for i := 1 to nStandards do begin
					if nValues = nColumns then begin
							StandardValues[i] := rLine[nColumns];
							SetDReal(MyLog, FirststandardID + i - 1, StandardValues[i], 3);
						end;
					GetLineFromText(rLine, nValues);
				end;
		InitCursor;
	end;


	procedure SaveStandardsToFile (nStandards: integer);
		var
			where: Point;
			reply: SFReply;
			i: integer;
			OptionKeyWasDown: boolean;
	begin
		OptionKeyWasDown := OptionKeyDown;
		where.v := 50;
		where.h := 50;
		SFPutFile(Where, 'Save Calibration as?', 'Standards', nil, reply);
		if reply.good then begin
				TextBufSize := 0;
				for i := 1 to nStandards do begin
						PutReal(umean[i], 1, 3);
						PutChar(tab);
						if StandardValues[i] >= 100.0 then
							PutReal(StandardValues[i], 1, 3)
						else
							PutReal(StandardValues[i], 1, 5);
						if i <> nStandards then
							PutChar(cr);
					end;
				with reply do
					SaveAsText(fname, vRefNum);
			end;
		InitCursor;
	end;


	procedure Calibrate;
		const
			FirstLevelID = 3;
			FirstStandardID = 23;
			FirstFitID = 63;
			LastFitID = 71;
			UnitOfMeasureID = 72;
			OpenID = 74;
			SaveID = 75;
			UndoID = 76;
		var
			mylog: DialogPtr;
			ignore, item, i, nBadReals: integer;
			str: str255;
			SaveStandards, temp: StandardsArray;
			OptionKeyWasDown: boolean;
	begin
		OptionKeyWasDown := OptionKeyDown;
		SaveStandards := StandardValues;
		with info^ do begin
				mylog := GetNewDialog(20, nil, pointer(-1));
				OutlineButton(MyLog, ok, 16);
				nStandards := mCount;
				if nStandards > MaxStandards then
					nStandards := MaxStandards;
				for i := 1 to nStandards do begin
						SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2);
						if StandardValues[i] <> BadReal then
							SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3);
					end;
				SelIText(MyLog, FirstStandardID, 0, 32767);
				SetDialogItem(mylog, FirstFitID + ord(fit), 1);
				if calibrated then
					SetDString(MyLog, UnitOfMeasureID, UnitOfMeasure);
				repeat
					ModalDialog(nil, item);
					if (item >= FirstStandardID) and (item < (FirstStandardID + MaxStandards)) then begin
							i := item - FirstStandardID + 1;
							if i <= nStandards then
								StandardValues[i] := GetDReal(MyLog, item)
							else begin
									PutMessage('Before entering known values you must use the Measure command to read a set of standards.');
									SetDString(MyLog, item, '');
								end;
						end;
					if (item >= FirstLevelID) and (item < (FirstLevelID + MaxStandards)) then begin
							i := item - FirstLevelID + 1;
							if OptionKeyWasDown and (i <= nStandards) then
								umean[item - FirstLevelID + 1] := GetDReal(MyLog, item)
							else begin
									PutMessage('Use the Measure command to record measured values.');
									if i <= nStandards then begin
											RealToString(umean[i], 1, 2, str);
											SetDString(MyLog, item, str)
										end
									else
										SetDString(MyLog, item, '');
								end;
						end;
					if (item >= FirstFitID) and (item <= LastFitID) then begin
							for i := FirstFitID to LastFitID do
								SetDialogItem(mylog, i, 0);
							SetDialogItem(mylog, item, 1);
							fit := CurveFitType(item - FirstFitID);
						end;
					if item = UnitOfMeasureID then
						UnitOfMeasure := GetDString(MyLog, item);
					if item = OpenID then
						GetStandardsFromFile(mylog, FirstLevelID, FirstStandardID);
					if (item = SaveID) and (nStandards > 1) then
						SaveStandardsToFile(nStandards);
				until (item = ok) or (item = cancel) or (item = UndoID);
				DisposDialog(mylog);
				if item = UndoID then begin
						calibrated := false;
						for i := 0 to 255 do
							cvalue[i] := i;
						exit(calibrate)
					end;
				if item = cancel then begin
						StandardValues := SaveStandards;
					end
				else begin
						nBadReals := 0;
						for i := 1 to nStandards do
							if StandardValues[i] = BadReal then
								nBadReals := nBadReals + 1;
						if (nStandards > 0) and (nBadReals = 0) then begin
								DoCurveFitting;
								if calibrated then
									SetupCalibrationPlot
							end
						else
							beep;
					end;
			end; {with info^}
	end;


	procedure ResetCounter;
		var
			AlertID: Integer;
	begin
		if UnsavedResults and (not macro) then begin
				InitCursor;
				AlertID := alert(500, nil);
			end
		else
			AlertID := ok;
		if AlertID <> CancelResetID then begin
				nPoints := 0;
				nLengths := 0;
				nAngles := 0;
				mCount := 0;
				mCount2 := 0;
				UnsavedResults := false;
				ShowResults;
				if MeasurementsWindow <> nil then begin
						with ListTE^^ do
							TESetSelect(0, teLength, ListTE);
						TEDelete(ListTE);
						UpdateScrollBars;
					end;
			end;
		measuring := false;
	end;


	procedure ShowMeasurements;
		const
			FontSize = 9;
		var
			wrect, crect, trect: rect;
			loc: point;
	begin
		mCount2 := mCount;
		if MeasurementsWindow <> nil then begin
				SelectWindow(MeasurementsWindow);
				exit(ShowMeasurements);
			end;
		CopyResultsToBuffer(1, mCount, true);
		ShowMessage('');
		MeasWidth := 110 + round(nListColumns * FieldWidth * 6.5);
		if MeasWidth < 250 then
			MeasWidth := 250;
		if (MeasWidth + 20) > ScreenWidth then
			MeasWidth := ScreenWidth - 20;
		MeasHeight := ((LongInt(TextBufLineCount) * 2) + 2) * FontSize;
		if MeasHeight < 200 then
			MeasHeight := 200;
		if (MeasHeight + MeasTop + 50) > ScreenHeight then
			MeasHeight := ScreenHeight - MeasTop - 50;
		SetRect(wrect, MeasLeft, MeasTop, MeasLeft + MeasWidth, MeasTop + MeasHeight);
		MeasurementsWindow := NewWindow(nil, wrect, 'Measurements', true, 0, pointer(-1), true, 0);
		WindowPeek(MeasurementsWindow)^.WindowKind := MeasurementsKind;
		SetRect(crect, MeasWidth - ScrollBarWidth, -1, MeasWidth + 1, MeasHeight - 14);
		vScrollBar := NewControl(MeasurementsWindow, crect, '', true, 0, 0, MeasHeight - 14, ScrollBarProc, 0);
		SetRect(crect, -1, MeasHeight - ScrollBarWidth, MeasWidth - 14, MeasHeight + 1);
		hScrollBar := NewControl(MeasurementsWindow, crect, '', true, 0, 0, MeasWidth - 14, ScrollBarProc, 0);
		InitTextEdit(Monaco, FontSize);
		DrawControls(MeasurementsWindow);
		WhatToUndo := NothingToUndo;
	end;


	procedure DoMeasurementOptions;
		const
			FirstID = 3;
			LastID = 13;
			RedirectID = 27;
			MinID = 16;
			MaxID = 18;
			IgnoreID = 19;
			LabelID = 20;
			PrecisionID = 22;
			OutlineID = 23;
			IncludeHolesID = 24;
			AutoID = 25;
			AdjustID = 26;
			MaxRegionsID = 29;
			WidthID = 31;
			HeadingsID = 32;
		var
			mylog: DialogPtr;
			item, i, SavePrecision, SaveMaxRegions, SaveWidth: integer;
			mtype: MeasurementTypes;
			SaveMeasurements: set of MeasurementTypes;
			SaveRedirect, SaveIgnore, SaveLabel, SaveOutline: boolean;
			SaveAuto, SaveAdjust, SaveHeadings: boolean;
			SaveMin, SaveMax: LongInt;
	begin
		InitCursor;
		if nPoints > 0 then
			Measurements := Measurements + [XYLocM];
		if nLengths > 0 then
			Measurements := Measurements + [LengthM];
		if nAngles > 0 then
			Measurements := Measurements + [AngleM];
		SaveMeasurements := measurements;
		SaveMin := MinParticleSize;
		SaveMax := MaxParticleSize;
		SaveRedirect := RedirectSampling;
		SaveIgnore := IgnoreParticlesTouchingEdge;
		SaveLabel := LabelParticles;
		SaveOutline := OutlineParticles;
		SaveWidth := FieldWidth;
		SavePrecision := precision;
		SaveAuto := WandAdjustAreas;
		SaveAdjust := WandAdjustAreas;
		SaveMaxRegions := MaxRegions;
		SaveHeadings := ShowHeadings;
		mylog := GetNewDialog(4000, nil, pointer(-1));
		mtype := AreaM;
		for i := FirstID to LastID do begin
				if mtype in measurements then
					SetDialogItem(mylog, i, 1);
				if i <> LastID then
					mtype := succ(mtype);
			end;
		SetDNum(MyLog, MinID, MinParticleSize);
		SetDNum(MyLog, MaxID, MaxParticleSize);
		ParamText('Pixels', 'Pixels', '', '');
		SetDialogItem(mylog, RedirectID, ord(RedirectSampling));
		SetDialogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
		SetDialogItem(mylog, LabelID, ord(LabelParticles));
		SetDialogItem(mylog, OutlineID, ord(OutlineParticles));
		SetDialogItem(mylog, IncludeHolesID, ord(IncludeHoles));
		SetDialogItem(mylog, AutoID, ord(WandAutoMeasure));
		SetDialogItem(mylog, AdjustID, ord(WandAdjustAreas));
		SetDialogItem(mylog, HeadingsID, ord(ShowHeadings));
		SetDNum(MyLog, MaxRegionsID, MaxRegions);
		SetDNum(MyLog, WidthID, FieldWidth);
		SetDNum(MyLog, PrecisionID, precision);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if (item >= FirstID) and (item <= LastID) then begin
					i := item - FirstID;
					case i of
						0: 
							mtype := AreaM;
						1: 
							mtype := MeanM;
						2: 
							mtype := StdDevM;
						3: 
							mtype := xyLocM;
						4: 
							mtype := ModeM;
						5: 
							mtype := LengthM;
						6: 
							mtype := MajorAxisM;
						7: 
							mtype := MinorAxisM;
						8: 
							mtype := AngleM;
						9: 
							mtype := IntDenM;
						10: 
							mtype := MinMaxM;
					end;
					if mtype in measurements then begin
							measurements := measurements - [mtype];
							SetDialogItem(mylog, item, 0)
						end
					else begin
							measurements := measurements + [mtype];
							SetDialogItem(mylog, item, 1)
						end;
				end;
			if item = RedirectID then begin
					RedirectSampling := not RedirectSampling;
					SetDialogItem(mylog, RedirectID, ord(RedirectSampling));
				end;
			if item = IgnoreID then begin
					IgnoreParticlesTouchingEdge := not IgnoreParticlesTouchingEdge;
					SetDialogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
				end;
			if item = LabelID then begin
					LabelParticles := not LabelParticles;
					SetDialogItem(mylog, LabelID, ord(LabelParticles));
				end;
			if item = OutlineID then begin
					OutlineParticles := not OutlineParticles;
					SetDialogItem(mylog, OutlineID, ord(OutlineParticles));
				end;
			if item = IncludeHolesID then begin
					IncludeHoles := not IncludeHoles;
					SetDialogItem(mylog, IncludeHolesID, ord(IncludeHoles));
				end;
			if item = AutoID then begin
					WandAutoMeasure := not WandAutoMeasure;
					SetDialogItem(mylog, AutoID, ord(WandAutoMeasure));
				end;
			if item = AdjustID then begin
					WandAdjustAreas := not WandAdjustAreas;
					SetDialogItem(mylog, AdjustID, ord(WandAdjustAreas));
				end;
			if item = HeadingsID then begin
					ShowHeadings := not ShowHeadings;
					SetDialogItem(mylog, HeadingsID, ord(ShowHeadings));
				end;
			if item = MinID then
				MinParticleSize := GetDNum(MyLog, MinID);
			if item = MaxID then
				MaxParticleSize := GetDNum(MyLog, MaxID);
			if item = WidthID then
				FieldWidth := GetDNum(MyLog, WidthID);
			if item = PrecisionID then
				precision := GetDNum(MyLog, PrecisionID);
			if item = MaxRegionsID then
				MaxRegions := GetDNum(MyLog, MaxRegionsID);
		until (item = ok) or (item = cancel);
		DisposDialog(mylog);
		if (MinParticleSize < 0) or (MinParticleSize >= MaxParticleSize) then begin
				MinParticleSize := SaveMin;
				beep;
			end;
		if MaxParticleSize <= MinParticleSize then begin
				MaxParticleSize := SaveMax;
				beep;
			end;
		if (FieldWidth < 1) or (FieldWidth > 18) then begin
				FieldWidth := SaveWidth;
				beep;
			end;
		if (precision < 0) or (precision > 8) then begin
				precision := SavePrecision;
				beep;
			end;
		if (MaxRegions < 1) or (MaxRegions > MaxMaxRegions) then begin
				MaxRegions := SaveMaxRegions;
				beep;
			end;
		if item = cancel then begin
				measurements := SaveMeasurements;
				MinParticleSize := SaveMin;
				MaxParticleSize := SaveMax;
				RedirectSampling := SaveRedirect;
				IgnoreParticlesTouchingEdge := SaveIgnore;
				LabelParticles := SaveLabel;
				OutlineParticles := SaveOutline;
				FieldWidth := SaveWidth;
				precision := SavePrecision;
				WandAutoMeasure := SaveAuto;
				WandAdjustAreas := SaveAdjust;
				MaxRegions := SaveMaxRegions;
				ShowHeadings := SaveHeadings;
			end;
		if not (XYLocM in Measurements) then
			nPoints := 0;
		if not (LengthM in Measurements) then
			nLengths := 0;
		if not (AngleM in Measurements) then
			nAngles := 0;
		UpdateFitEllipse;
		if MaxRegions <> SaveMaxRegions then
			PutMessage('You must "Record Preferences" and restart before the change to Maximum Particles will take effect.');
		if (Measurements <> SaveMeasurements) or (SaveWidth <> FieldWidth) or (SavePrecision <> Precision) then
			UpdateList;
	end;


	procedure ShowLineWidth;
	begin
		LineIndex := LineWidth;
		if LineWidth = 6 then
			LineIndex := 5;
		if LineWidth > 6 then
			LineIndex := 6;
		DrawTools;
	end;


	procedure DoProfilePlotOptions;
		const
			AutoScaleID = 3;
			FixedScaleID = 4;
			MinID = 6;
			MaxID = 8;
			LinePlotID = 9;
			ScatterPlotID = 10;
			InvertID = 11;
			LabelsID = 12;
			VariableSizeID = 13;
			FixedSizeID = 14;
			WidthID = 17;
			HeightID = 18;
			LineWidthID = 20;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveAutoscale, SaveLinePlot, SaveInvert, SaveDrawLabels, SaveFixedSize: boolean;
			SaveWidth, SaveHeight, SaveLineWidth, SaveLineIndex: integer;
			SaveMin, SaveMax: extended;
	begin
		InitCursor;
		SaveAutoscale := AutoscalePlots;
		SaveLinePlot := LinePlot;
		SaveInvert := InvertPlots;
		SaveMin := ProfilePlotMin;
		SaveMax := ProfilePlotMax;
		SaveLineWidth := LineWidth;
		SaveLineIndex := LineIndex;
		mylog := GetNewDialog(5000, nil, pointer(-1));
		if AutoScalePlots then
			SetDialogItem(mylog, AutoScaleID, 1)
		else
			SetDialogItem(mylog, FixedScaleID, 1);
		SetDReal(MyLog, MinID, ProfilePlotMin, 2);
		SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
		if FixedSizePlot then
			SetDialogItem(mylog, FixedSizeID, 1)
		else
			SetDialogItem(mylog, VariableSizeID, 1);
		SetDNum(MyLog, WidthID, ProfilePlotWidth);
		SetDNum(MyLog, HeightID, ProfilePlotHeight);
		if LinePlot then
			SetDialogItem(mylog, LinePlotID, 1)
		else
			SetDialogItem(mylog, ScatterPlotID, 1);
		if InvertPlots then
			SetDialogItem(mylog, InvertID, 1);
		if DrawPlotLabels then
			SetDialogItem(mylog, LabelsID, 1);
		SetDNum(MyLog, LineWidthID, LineWidth);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if (item = AutoScaleID) or (item = FixedScaleID) then begin
					SetDialogItem(mylog, AutoScaleID, 0);
					SetDialogItem(mylog, FixedScaleID, 0);
					SetDialogItem(mylog, item, 1);
					AutoscalePlots := item = AutoscaleID;
				end;
			if item = MinID then begin
					ProfilePlotMin := GetDReal(MyLog, MinID);
					if (ProfilePlotMin < 0) or (ProfilePlotMin > 255) then begin
							ProfilePlotMin := SaveMin;
							SetDReal(MyLog, MinID, ProfilePlotMin, 2);
						end;
				end;
			if item = MaxID then begin
					ProfilePlotMax := GetDReal(MyLog, MaxID);
					if (ProfilePlotMax < 0) or (ProfilePlotMax > 255) then begin
							ProfilePlotMax := SaveMax;
							SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
						end;
				end;
			if (item = FixedSizeID) or (item = VariableSizeID) then begin
					SetDialogItem(mylog, FixedSizeID, 0);
					SetDialogItem(mylog, VariableSizeID, 0);
					SetDialogItem(mylog, item, 1);
					FixedSizePlot := item = FixedSizeID;
				end;
			if item = WidthID then begin
					ProfilePlotWidth := GetDNum(MyLog, WidthID);
					if (ProfilePlotWidth < 0) or (ProfilePlotWidth > 1023) then begin
							ProfilePlotWidth := SaveWidth;
							SetDNum(MyLog, WidthID, ProfilePlotWidth);
						end;
				end;
			if item = HeightID then begin
					ProfilePlotHeight := GetDNum(MyLog, HeightID);
					if (ProfilePlotHeight < 0) or (ProfilePlotHeight > 1023) then begin
							ProfilePlotHeight := SaveHeight;
							SetDNum(MyLog, HeightID, ProfilePlotHeight);
						end;
				end;
			if (item = LinePlotID) or (item = ScatterPlotID) then begin
					SetDialogItem(mylog, LinePlotID, 0);
					SetDialogItem(mylog, ScatterPlotID, 0);
					SetDialogItem(mylog, item, 1);
					LinePlot := item = LinePlotID;
				end;
			if item = InvertID then begin
					InvertPlots := not InvertPlots;
					SetDialogItem(mylog, InvertID, ord(InvertPlots));
				end;
			if item = LabelsID then begin
					DrawPlotLabels := not DrawPlotLabels;
					if DrawPlotLabels then {Attempt to fix a "sticky" check box bug.}
						SetDialogItem(mylog, LabelsID, 1)
					else
						SetDialogItem(mylog, LabelsID, 0);
				end;
			if item = LineWidthID then begin
					LineWidth := GetDNum(MyLog, LineWidthID);
					if (LineWidth < 1) or (LineWidth > 500) then begin
							LineWidth := SaveLineWidth;
							SetDNum(MyLog, LineWidthID, LineWidth);
						end;
					ShowLineWidth;
				end;
		until (item = ok) or (item = cancel);
		DisposDialog(mylog);
		if item = cancel then begin
				AutoscalePlots := SaveAutoscale;
				LinePlot := SaveLinePlot;
				InvertPlots := SaveInvert;
				ProfilePlotMin := SaveMin;
				ProfilePlotMax := SaveMax;
				DrawPlotLabels := SaveDrawLabels;
				LineWidth := SaveLineWidth;
				if LineIndex <> SaveLineIndex then begin
						LineIndex := SaveLineIndex;
						DrawTools;
					end;
			end;
	end;


	procedure DoPoints (event: EventRecord);
		var
			loc, tloc: point;
			hloc, vloc, y, offset: integer;
			r: rect;
			str, str1, str2: str255;
	begin
		SetPort(GrafPtr(info^.osPort));
		loc := event.where;
		ScreenToOffscreen(loc);
		with loc do begin
				hloc := h;
				vloc := v;
			end;
		with results, Info^ do begin
				nPoints := nPoints + 1;
				IncrementCounter;
				if InvertYCoordinates then
					y := info^.PicRect.bottom - vloc - 1
				else
					y := vloc;
				ClearResults(mCount);
				PixelCount^[mCount] := 1;
				if SpatialScale <> 0.0 then
					mArea^[mCount] := 1 / sqr(SpatialScale)
				else
					mArea^[mCount] := 1;
				mean^[mCount] := cvalue[MyGetPixel(hloc, vloc)];
				with info^ do
					if SpatialScale <> 0.0 then begin
							xcenter^[mCount] := hloc / SpatialScale;
							ycenter^[mCount] := y / SpatialScale;
						end
					else begin
							xcenter^[mCount] := hloc;
							ycenter^[mCount] := y;
						end;
			end;
		PenNormal;
		if OptionKeyDown then begin
				NumToString(mCount, str);
				tloc := loc;
				tloc.v := tloc.v + CurrentSize div 3;
				DrawText(str, tloc, TeJustCenter);
			end
		else begin
				offset := LineWidth div 2;
				SetRect(r, hloc - offset, vloc - offset, hloc + offset + 1, vloc + offset + 1);
				PaintOval(r);
				UpdateScreen(r);
				if ControlKeyDown then
					with info^ do begin
							if SpatialScale <> 0.0 then begin
									RealToString(hloc / SpatialScale, 1, Precision, str1);
									RealToString(y / SpatialScale, 1, Precision, str2);
								end
							else begin
									NumToString(hloc, str1);
									NumToString(y, str2);
								end;
							tloc := loc;
							with tloc do begin
									h := h + offset + 5;
									v := v + CurrentSize div 3;
								end;
							str := concat('(', str1, ', ', str2, ')');
							DrawText(str, tloc, TeJustLeft);
						end; {Control Key Down}
			end;
		ResultsMessage := '';
		ShowResults;
		AppendResults;
		if (nPoints = 1) then
			if not (XYlocM in Measurements) then
				UpdateList;
		measuring := true;
		WhatToUndo := UndoPoint;
	end;


	procedure FindAngle (event: EventRecord);
		var
			start, finish, OldFinish, MidPoint: point;
			ticks: LongInt;
			ff, x1, y1, x2, y2, imag: integer;
			angle, angle1, angle2: extended;
			StartRect: rect;
			FirstLineDone: boolean;

		procedure GetAngle (x, y: integer; var angle: extended);
			var
				quadrant: (q1, q2orq3, q4);
		begin
			if x <> 0 then
				angle := arctan(y / x)
			else begin
					if y >= 0 then
						angle := pi / 2.0
					else
						angle := -pi / 2.0
				end;
			angle := (180.0 / pi) * angle;
			if (x >= 0) and (y >= 0) then
				quadrant := q1
			else if x < 0 then
				quadrant := q2orq3
			else
				quadrant := q4;
			case quadrant of
				q1: 
					;
				q2orq3: 
					angle := angle + 180.0;
				q4: 
					angle := angle + 360.0;
			end;
		end;

	begin
		DrawLabels('Angle:', '', '');
		FlushEvents(EveryEvent, 0);
		imag := trunc(info^.magnification + 0.5);
		ff := imag div 2;
		if ff < 1 then
			ff := 1;
		start := event.where;
		with start do begin
				h := h - ff;
				v := v - ff
			end;
		Pt2Rect(start, start, StartRect);
		InsetRect(StartRect, -2, -2);
		finish := start;
		SetPort(info^.wptr);
		PenNormal;
		PenMode(PatXor);
		PenSize(imag * LineWidth, imag * LineWidth);
		MoveTo(start.h, start.v);
		repeat
			repeat
				OldFinish := finish;
				GetMouse(finish);
				with finish do begin
						h := h - ff;
						v := v - ff
					end;
				MoveTo(start.h, start.v);
				LineTo(OldFinish.h, OldFinish.v);
				MoveTo(start.h, start.v);
				LineTo(finish.h, finish.v);
				ticks := TickCount;
				while ticks = TickCount do
					;
				x1 := finish.h - start.h;
				y1 := start.v - finish.v;
				GetAngle(x1, y1, angle1);
				Show1Value(angle1, NoValue);
			until GetNextEvent(mUpMask, event);
			FirstLineDone := not PtInRect(finish, StartRect);
			if not FirstLineDone then
				start := finish;
		until FirstLineDone;
		DrawObject(LineObj, start, finish);
		MidPoint := finish;
		x1 := start.h - MidPoint.h;
		y1 := MidPoint.v - start.v;
		GetAngle(x1, y1, angle1);
		start := finish;
		finish := start;
		repeat
			OldFinish := finish;
			GetMouse(finish);
			with finish do begin
					h := h - ff;
					v := v - ff
				end;
			MoveTo(start.h, start.v);
			LineTo(OldFinish.h, OldFinish.v);
			MoveTo(start.h, start.v);
			LineTo(finish.h, finish.v);
			ticks := TickCount;
			while ticks = TickCount do
				;
			x2 := finish.h - MidPoint.h;
			y2 := MidPoint.v - finish.v;
			GetAngle(x2, y2, angle2);
			with results do begin
					if angle1 >= angle2 then
						angle := angle1 - angle2
					else
						angle := angle2 - angle1;
					if angle > 180.0 then
						angle := 360.0 - angle;
					Show1Value(angle, NoValue);
				end;
		until GetNextEvent(mUpMask, event);
		DrawObject(LineObj, start, finish);
		nAngles := nAngles + 1;
		IncrementCounter;
		ClearResults(mCount);
		Orientation^[mCount] := angle;
		ResultsMessage := '';
		ShowResults;
		AppendResults;
		if nAngles = 1 then
			UpdateList;
		repeat
		until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
	end;

	procedure ComputeLength; {(nvertices: integer; var xa, ya: xyArray; FindingPerimeterLength: boolean)}
		var
			i: integer;
			xtemp, ytemp: LongInt;
	begin
		with results do begin
				PixelLength := 0.0;
				for i := 2 to nvertices do begin
						xtemp := xa[i] - xa[i - 1];
						ytemp := ya[i] - ya[i - 1];
						PixelLength := PixelLength + sqrt(xtemp * xtemp + ytemp * ytemp);
					end;
				if FindingPerimeterLength then begin
						xtemp := xa[1] - xa[nvertices];
						ytemp := ya[1] - ya[nvertices];
						PixelLength := PixelLength + sqrt(xtemp * xtemp + ytemp * ytemp);
					end;
				with info^ do begin
						PixelLength := PixelLength / magnification;
					end;
			end;
	end;


	procedure SaveBlankField;
		var
			SaveInfo, SaveBFInfo: InfoPtr;
			i, xLines, xPixelsPerLine: integer;
			src, dst: ptr;
			SaveFlag: boolean;
			name: str255;
	begin
		if (info^.PictureType = QuickCaptureType) or (info^.PictureType = ScionType) then begin
				GetWTitle(info^.wptr, name);
				if pos('(Corrected)', name) > 0 then begin
						PutMessage('To save a blank field the captured image must be uncorrected.');
						exit(SaveBlankField);
					end;
				SaveInfo := info;
				SaveBFInfo := BlankFieldInfo;
				BlankFieldInfo := nil; {Prevents StopDigitizing from doing shading correction.}
				StopDigitizing;
				BlankFieldInfo := SaveBFInfo;
				if BlankFieldInfo = nil then begin
						if not Duplicate('Blank Field', true) then
							exit(SaveBlankField);
					end;
				src := info^.PicBaseAddr;
				dst := BlankFieldInfo^.PicBaseAddr;
				with Info^.PicRect do begin
						xLines := bottom - top;
						xPixelsPerLine := right - left;
					end;
				for i := 1 to xLines do begin
						BlockMove(src, dst, xPixelsPerLine);
						src := ptr(ord4(src) + info^.BytesPerRow);
						dst := ptr(ord4(dst) + xPixelsPerLine);
					end;
				Info := BlankFieldInfo;
				InvertPic;
				SaveFlag := digitizing;
				digitizing := false;
				SelectAll(false);
				ShowCount := false;
				Measure;
				ShowCount := true;
				digitizing := SaveFlag;
				BlankFieldMean := results.imean;
				UndoLastMeasurement(false);
				KillRoi;
				UpdatePicWindow;
				info := SaveInfo;
				SelectWindow(Info^.wptr);
			end;
	end;


	procedure UndoLastMeasurement (DisplayResults: boolean);
	begin
		if mCount > 0 then begin
				if DisplayResults then
					DeleteLines(mCount, mCount);
				mCount := mCount - 1;
				if mCount = 0 then
					UnsavedResults := false;
			end
		else
			WhatToUndo := NothingToUndo;
		if DisplayResults then
			ShowResults;
	end;


	function PixelInside (hloc, vloc: integer): boolean;
		var
			value: integer;
	begin
		value := MyGetPixel(hloc, vloc);
		case ThresholdingMode of
			DensitySlice: 
				PixelInside := (value >= SliceStart) and (value <= SliceEnd);
			GrayMapThresholding: 
				PixelInside := value >= GrayMapThreshold;
			BinaryImage: 
				PixelInside := value = BlackIndex;
		end;
	end;


	function TraceEdge (hstart, vstart: integer; var circumference: extended; StartingDirection: char; var TouchingEdge: boolean): boolean;

   {Traces the points(not pixels) that define the edge of an object using the following}
   {16 entry lookup table and converts the resulting outline to a QuickDraw region.}

      {Index  1234*  Code    Result}

      {0          0000     X      Should never happen}
      {1          000X     R      Go Right}
      {2          00X0     D     Go Down}
      {3          00XX     R     Go Right}
      {4          0X00     U     Go Up}
      {5          0X0X     U     Go Up}
      {6          0XX0     u      Go up or down depending on current direction}
      {7         0XXX     U      Go up}
      {8          X000     L      Go left}
      {9          X00X     l       Go left or right depending on current direction}
      {10       X0X0     D      Go down}
      {11        X0XX    R      Go right}
      {12        XX00     L      Go left}
      {13        XX0X     L      Go left}
      {14        XXX0     D     Go down}
      {15        XXXX     X     Should never happen}

       {*   1=Upper left pixel,  2=Upper right pixel, 3=Lower left pixel, 4=Lower right pixel}

		const
			MaxCount = 10000;
		var
			count, hloc, vloc, hold, vold, index: integer;
			sqrt2: extended;
			Saveport: GrafPtr;
			FindPerimeter: boolean;
			direction, NewDirection: char;
			table: string[16];
			UL, UR, LL, LR, CuttingCorner: boolean;
	begin
		TouchingEdge := false;
		table := 'XRDRUUuULlDRLLDX';
		GetPort(SavePort);
		SetPort(GrafPtr(info^.osPort));
		circumference := 0.0;
		FindPerimeter := (LengthM in measurements) or (nLengths > 0) or WandAdjustAreas;
		if FindPerimeter then begin
				sqrt2 := sqrt(2.0);
				CuttingCorner := false;
			end;
		count := 0;
		PenNormal;
		OpenRgn;
		direction := StartingDirection;
		hloc := hstart;
		vloc := vstart;
		UL := PixelInside(hloc - 1, vloc - 1);
		UR := PixelInside(hloc, vloc - 1);
		LL := PixelInside(hloc - 1, vloc);
		LR := PixelInside(hloc, vloc);
		hold := hstart;
		vold := vstart;
		MoveTo(hstart, vstart);
		repeat
			if IgnoreParticlesTouchingEdge then
				with info^.PicRect do
					TouchingEdge := TouchingEdge or (hloc = left) or (hloc = right) or (vloc = top) or (vloc = bottom);
			count := count + 1;
			index := 0;
			if LR then
				index := bor(index, 1);
			if LL then
				index := bor(index, 2);
			if UR then
				index := bor(index, 4);
			if UL then
				index := bor(index, 8);
			NewDirection := table[index + 1];
			if NewDirection = 'u' then begin
					if direction = 'R' then
						NewDirection := 'U'
					else
						NewDirection := 'D'
				end;
			if NewDirection = 'l' then begin
					if direction = 'U' then
						NewDirection := 'L'
					else
						NewDirection := 'R'
				end;
			case NewDirection of
				'U': 
					begin
						vloc := vloc - 1;
						LL := UL;
						LR := UR;
						UL := PixelInside(hloc - 1, vloc - 1);
						UR := PixelInside(hloc, vloc - 1);
					end;
				'D': 
					begin
						vloc := vloc + 1;
						UL := LL;
						UR := LR;
						LL := PixelInside(hloc - 1, vloc);
						LR := PixelInside(hloc, vloc);
					end;
				'L': 
					begin
						hloc := hloc - 1;
						UR := UL;
						LR := LL;
						UL := PixelInside(hloc - 1, vloc - 1);
						LL := PixelInside(hloc - 1, vloc);
					end;
				'R': 
					begin
						hloc := hloc + 1;
						UL := UR;
						LL := LR;
						UR := PixelInside(hloc, vloc - 1);
						LR := PixelInside(hloc, vloc);
					end;
			end;
			if FindPerimeter then begin
					if CuttingCorner then
						CuttingCorner := false
					else begin
							if NewDirection = direction then
								circumference := circumference + 1
							else begin
									circumference := circumference + sqrt2;
									CuttingCorner := true;
								end;
						end;
				end;
			LineTo(hloc, vloc);
			hold := hloc;
			vold := vloc;
			direction := NewDirection;
		until ((hloc = hstart) and (vloc = vstart) and (direction = StartingDirection)) or (count > MaxCount);
		with info^ do begin
				CloseRgn(roiRgn);
				if count > MaxCount then begin
						SetEmptyRgn(roiRgn);
						SetPort(SavePort);
						TraceEdge := false;
						exit(TraceEdge);
					end;
				RoiShowing := true;
				roiType := RgnRoi;
				RoiRect := roiRgn^^.rgnBBox;
			end;
		SetPort(SavePort);
		TraceEdge := true;
	end;


	procedure MarkSelection (count: integer);
		var
			SavePort: GrafPtr;
			NumWidth, NumLeft, NumBottom, SaveForegroundIndex: integer;
			RoiWidth, inset, hcenter, vcenter: integer;
			str: str255;
			r: rect;
			OutlineWithEllipse: boolean;
			xc, yc: extended;
	begin
		OutlineWithEllipse := FitEllipse and OptionKeyWasDown;
		with info^ do begin
				KillRoi;
				SetupUndo;
				WhatToUndo := UndoOutline;
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				SaveForegroundIndex := ForegroundIndex;
				SetForegroundColor(WhiteIndex);
				PenNormal;
				TextFont(ApplFont);
				TextSize(9);
				NumToString(count, str);
				with RoiRect do begin
						NumWidth := StringWidth(str);
						if AnalyzingParticles or OutlineWithEllipse then begin
								xc := xcenter^[count];
								yc := ycenter^[count];
								if SpatialScale <> 0.0 then begin
										xc := xc * SpatialScale;
										yc := yc * SpatialScale;
									end;
								hcenter := round(xc);
								vcenter := round(yc);
								if InvertYCoordinates then
									vcenter := PicRect.bottom - vcenter - 1
							end
						else begin
								hcenter := left + (right - left) div 2;
								vcenter := top + (bottom - top) div 2;
							end;
						NumLeft := hcenter - NumWidth div 2;
						NumBottom := vcenter + 3;
						if not BinaryPic and not AnalyzingParticles then begin
								FrameRgn(roiRgn);
								if OutlineWithEllipse then
									DrawEllipse;
							end;
					end;
				PenNormal;
				SetRect(r, NumLeft - 1, NumBottom - 9, NumLeft + NumWidth + 1, NumBottom + 1);
				PaintRoundRect(r, 4, 4);
				MoveTo(NumLeft, NumBottom);
				TextMode(srcXor);
				DrawString(str);
				SetForegroundColor(SaveForegroundIndex);
				if not analyzingParticles then
					UpdateScreen(RoiRect);
				SetPort(SavePort);
				changes := true;
			end;
	end;

	function isBinaryImage: boolean;
		var
			AutoSelect: boolean;
	begin
		with info^ do begin
				AutoSelect := not RoiShowing;
				if AutoSelect then
					SelectAll(false);
				GetRectHistogram;
				BinaryPic := (histogram[0] + histogram[255]) = LongInt(PixelsPerLine) * nLines;
				isBinaryImage := BinaryPic;
				if AutoSelect then
					KillRoi;
			end;
	end;


	function SetupAutoOutline: boolean;
	begin
		SetupAutoOutline := false;
		FindThresholdingMode;
		if ThresholdingMode = NoThresholding then
			if isBinaryImage then
				ThresholdingMode := BinaryImage;
		if ThresholdingMode = NoThresholding then begin
				PutMessage('Sorry, but you must be thresholding, or working with a binary image, to use the wand tool or to do particle analysis.');
				exit(SetupAutoOutline);
			end;
		if (ThresholdingMode = GrayMapThresholding) and (GrayMapThreshold = 0) then begin
				PutMessage(' Threshold must be non-zero.');
				exit(SetupAutoOutline);
			end;
		ShowWatch;
		SetupAutoOutline := true;
	end;


	procedure AutoOutline (start: point);
		var
			hloc, vloc: integer;
			TouchingEdge: boolean;
			circumference: extended;
			direction: char;
	begin
		if not SetupAutoOutline then
			exit(AutoOutline);
		KillRoi;
		with info^ do begin
				ScreenToOffscreen(start);
				with start do
					if PixelInside(h, v) then begin
							repeat
								h := h + 1;
							until not PixelInside(h, v);
							if not PixelInside(h - 1, v - 1) then
								direction := 'R'
							else if PixelInside(h, v - 1) then
								direction := 'L'
							else
								direction := 'D';
						end
					else begin
							repeat
								h := h + 1;
							until PixelInside(h, v) or (h >= PicRect.right);
							if h >= PicRect.right then begin
									beep;
									exit(AutoOutline);
								end;
							direction := 'U';
						end;
				if TraceEdge(start.h, start.v, circumference, direction, TouchingEdge) then begin
						WhatToUndo := NothingToUndo;
						results.PixelLength := circumference;
						if WandAutoMeasure then begin
								GetNonRectHistogram;
								ComputeResults;
								if WandAdjustAreas then
									PixelCount^[mCount] := PixelCount^[mCount] + round(pLength^[mCount]);
								ShowResults;
								AppendResults;
								WhatToUndo := UndoMeasurement;
								if LabelParticles then
									MarkSelection(mCount);
							end;
						if not (WandAutoMeasure and LabelParticles) then
							RoiShowing := true;
						UpdateScreen(RoiRect);
					end; {if}
			end; {with info}
	end;

	procedure RedoMeasurement;
		var
			SaveN: integer;
	begin
		if not isSelectionTool then begin
				CurrentTool := SelectionTool;
				isSelectionTool := true;
				DrawTools;
			end;
		MeasurementToRedo := GetInt('Region measurent to redo:', mCount);
		if (MeasurementToRedo >= 0) and (MeasurementToRedo <= mCount) then begin
				SaveN := mCount;
				mCount := MeasurementToRedo;
				ShowResults;
				mCount := SaveN;
			end
		else begin
				beep;
				MeasurementToRedo := 0;
			end;
	end;


	procedure DeleteMeasurement;
		var
			nToDelete, i: integer;
	begin
		nToDelete := GetInt('Measurent to delete:', mCount);
		if (nToDelete >= 0) and (nToDelete <= mCount) then begin
				for i := nToDelete to mCount - 1 do begin
						mean^[i] := mean^[i + 1];
						sd^[i] := sd^[i + 1];
						PixelCount^[i] := PixelCount^[i + 1];
						mArea^[i] := mArea^[i + 1];
						mode^[i] := mode^[i + 1];
						IntegratedDensity^[i] := IntegratedDensity^[i + 1];
						idBackground^[i] := idBackground^[i + 1];
						xcenter^[i] := xcenter^[i + 1];
						ycenter^[i] := ycenter^[i + 1];
						MajorAxis^[i] := MajorAxis^[i + 1];
						MinorAxis^[i] := MinorAxis^[i + 1];
						orientation^[i] := orientation^[i + 1];
						mMin^[i] := mMin^[i + 1];
						mMax^[i] := mMax^[i + 1];
						plength^[i] := plength^[i + 1];
					end; {for}
				mCount := mCount - 1;
				if mCount = 0 then begin
						UnsavedResults := false;
						beep;
					end;
				UpdateList;
			end
		else
			beep;
	end;


	procedure AnalyzeParticles;
		var
			hloc, vloc, AlertID, index, MaxTriesPerLine, nParticles: integer;
			SaveSliceState, TouchingEdge, DrawOutlines, AutoSelectAll, finished: boolean;
			circumference: extended;
			SaveForegroundIndex, SaveBackgroundIndex, EraseIndex, OutlineIndex: integer;
			tPort: GrafPtr;
			sRect: rect;
			side: (TopSide, RightSide, BottomSide, LeftSide);

		function PixelInside: boolean;
			var
				value: integer;
				offset: LongInt;
				p: ptr;
		begin
			with info^ do begin {MyGetPixel inlined to speed things up.}
					offset := LongInt(vloc) * BytesPerRow + hloc;
					p := ptr(ord4(PicBaseAddr) + offset);
				end;
			value := BAND(p^, 255);
			case ThresholdingMode of
				DensitySlice: 
					PixelInside := (value >= SliceStart) and (value <= SliceEnd);
				GrayMapThresholding: 
					PixelInside := value >= GrayMapThreshold;
				BinaryImage: 
					PixelInside := value = BlackIndex;
			end;
		end;

		procedure LabelBlobs;
			var
				i: integer;
		begin
			if (nParticles <= MaxRegions) and (nParticles <= 200) then
				for i := 1 to mCount do
					MarkSelection(i);
		end;

	begin
		with info^ do begin
				if NotRectangular or NotInBounds or NoUndo then
					exit(AnalyzeParticles);
				if not SetupAutoOutline then
					exit(AnalyzeParticles);
				if RedirectSampling then begin
						SetupRedirectedSampling;
						if InfoForRedirect = nil then
							exit(AnalyzeParticles)
					end;
				if RoiShowing then
					if EqualRect(RoiRect, PicRect) then  {If Select All }
						KillRoi;
				if not RoiShowing then
					SelectAll(false)
				else
					with RoiRect do begin
							hloc := left;
							vloc := top;
							finished := false;
							side := TopSide;
							repeat
								if PixelInside then begin
										PutMessage('Particle analysis requires that the selection boundary not intersect any particles.');
										exit(AnalyzeParticles);
									end;
								case side of
									TopSide: 
										begin
											hloc := hloc + 1;
											if hloc = (right - 1) then
												side := RightSide;
										end;
									RightSide: 
										begin
											vloc := vloc + 1;
											if vloc = (bottom - 1) then
												side := BottomSide;
										end;
									BottomSide: 
										begin
											hloc := hloc - 1;
											if hloc = left then
												side := LeftSide;
										end;
									LeftSide: 
										begin
											vloc := vloc - 1;
											finished := vloc = top
										end;
								end;
							until finished;
						end;
				sRect := RoiRect;
				KillRoi;
				if UnsavedResults then begin
						ResetCounter;
						if UnsavedResults then
							exit(AnalyzeParticles);
						UpdatePicWindow;
					end;
				if (CurrentTool = ruler) or (CurrentTool = CrossHairTool) then begin
						CurrentTool := SelectionTool;
						isSelectionTool := true;
						DrawTools;
					end;
				SetupUndoFromClip;
				SaveSliceState := DensitySlicing;
				SaveForegroundIndex := ForegroundIndex;
				SaveBackgroundIndex := BackgroundIndex;
				SetForegroundColor(WhiteIndex);
				DensitySlicing := false;
				DrawOutlines := false;
				case ThresholdingMode of
					DensitySlice: 
						begin
							EraseIndex := SliceStart - 1;
							if EraseIndex < 0 then
								EraseIndex := WhiteIndex;
							DrawOutlines := OutlineParticles;
							OutLineIndex := BlackIndex;
						end;
					GrayMapThresholding: 
						begin
							EraseIndex := GrayMapThreshold - 1;
							if EraseIndex < 0 then
								EraseIndex := WhiteIndex;
						end;
					BinaryImage: 
						begin
							DrawOutlines := OutlineParticles;
							OutLineIndex := 254;
							EraseIndex := 128;
						end;
				end;
				AnalyzingParticles := true;
				nParticles := 0;
				GetPort(tPort);
				SetPort(GrafPtr(osPort));
				ShowWatch;
				with sRect do
					for vloc := top to bottom - 1 do
						for hloc := left to right - 1 do begin
								if PixelInside then begin
										if TraceEdge(hloc, vloc, circumference, 'U', TouchingEdge) then begin
												nParticles := nParticles + 1;
												RoiShowing := false;
												if mCount < MaxRegions then begin
														GetNonRectHistogram;
														results.PixelLength := circumference;
														ComputeResults;
													end;
												SetBackgroundColor(EraseIndex);
												EraseRgn(roiRgn);
												if (PixelCount^[mCount] < MinParticleSize) or (PixelCount^[mCount] > MaxParticleSize) or (TouchingEdge) then begin
														mCount := mCount - 1;
														nParticles := nParticles - 1;
														UpdateScreen(RoiRect);
													end
												else begin
														if DrawOutlines then begin
																SetForegroundColor(OutlineIndex);
																FrameRgn(roiRgn);
															end;
														UpdateScreen(RoiRect);
														if nParticles <= MaxRegions then begin
																ShowResults;
																AppendResults;
															end
														else
															ShowMessage(long2str(nParticles));
														if nParticles = MaxRegions then
															beep;
														if CommandPeriod or (AnalyzingParticles = false) then begin {quit}
																beep;
																SetPort(tPort);
																if LabelParticles then
																	LabelBlobs;
																DensitySlicing := SaveSliceState;
																SetForegroundColor(SaveForegroundIndex);
																SetBackgroundColor(SaveBackgroundIndex);
																KillRoi;
																UpdatePicWindow;
																WhatToUndo := UndoEdit;
																UndoFromClip := true;
																AnalyzingParticles := false;
																exit(AnalyzeParticles);
															end; {quit}
													end;
											end;  {if TraceEdge}
									end; {if PixelInside}
							end; {for}
			end; {with}
		SetPort(tPort);
		if LabelParticles then
			LabelBlobs;
		DensitySlicing := SaveSliceState;
		SetForegroundColor(SaveForegroundIndex);
		SetBackgroundColor(SaveBackgroundIndex);
		KillRoi;
		UpdatePicWindow;
		if ThresholdingMode = GrayMapThresholding then
			ResetGrayMap;
		WhatToUndo := UndoEdit;
		UndoFromClip := true;
		AnalyzingParticles := false;
	end;

end.