unit Analysis;

{Analysis routines used by the NIH Image}

interface

	uses
		Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
		Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
		Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
		globals, Utilities, LeastSquares, Graphics, file1, file2, Ellipse, Lut;



	procedure DoHistogram;
	procedure GetRectHistogram;
	procedure GetHistogram;
	procedure ShowContinuousHistogram;
	procedure ComputeResults;
	procedure FindThresholdingMode;
	procedure Measure;
	procedure UpdateRoiLineWidth;
	procedure DoProfilePlotOptions;
	procedure ShowResults;
	procedure PlotDensityProfile;
	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;
	procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType);
	function isBinaryImage: boolean;
	function DoAPDialog: boolean;


implementation

	const
		UnitsPopUpID = 6;

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



{$PUSH}
{$D-}


procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt);
{$IFC PowerPC}
VAR
  line:LinePtr;
  i,value:integer;
BEGIN
  line:=LinePtr(data);
  FOR i:=0 TO width-1 DO BEGIN
    value:=line^[i];
    histogram[value]:=histogram[value]+1;
  END;
END;
{$ELSEC}
    {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}
{$ENDC}


	procedure GetRectHistogram;
		var
			width, i, NumberOfLines: integer;
			offset: LongInt;
			p: ptr;
	begin
		if TooWide then
			exit(GetRectHistogram);
		ShowWatch;
		for i := 0 to 255 do
			Histogram[i] := 0;
		with info^.RoiRect, info^ do begin
				offset := 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;


	procedure SetupRedirectedSampling;
		var
			info1, info2, SaveInfo: InfoPtr;
			SameCalibration: boolean;
			i: integer;
	begin
		InfoForRedirect := nil;
		if nPics <> 2 then begin
				PutError('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
				PutError('The image windows must be exactly the same size to do redirected sampling.');
				AnalyzingParticles := false;
				exit(SetupRedirectedSampling);
			end;
		if (Info1^.fit <> uncalibrated) or (Info2^.fit <> uncalibrated) then begin
				SameCalibration := true;
				if Info1^.fit <> Info2^.fit then
					SameCalibration := false;
				if Info1^.nCoefficients <> Info2^.nCoefficients then
					SameCalibration := false;
				for i := 1 to info1^.nCoefficients do
					if Info1^.Coefficient[i] <> Info2^.Coefficient[i] then
						SameCalibration := false;
				if not SameCalibration then begin
						PutError('Both image must be calibrated the same way to do redirected sampling.');
						AnalyzingParticles := false;
						exit(SetupRedirectedSampling);
					end;
			end;
		if info = info1 then
			InfoForRedirect := info2
		else
			InfoForRedirect := info1;
	end;


	procedure GetHistogram;
		var
			MaskLine, DataLine: LineType;
			width, i, vloc: integer;
			sum, sum2, count, OverFlows: LongInt;
			SaveInfo: InfoPtr;
			value: LongInt;
			trect: rect;
	begin
		if TooWide then
			exit(GetHistogram);
		ShowWatch;
		if RedirectSampling then begin
				SetupRedirectedSampling;
				if InfoForRedirect = nil then
					exit(GetHistogram);
			end
		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 := band(DataLine[i],255);
									histogram[value] := histogram[value] + 1;
								end;
					end;
			end;
		Info := SaveInfo;
		if not AnalyzingParticles then
			SetupUndo; {Needed for drawing "marching ants".}
	end;


{$POP}

	procedure ComputeResults;
		var
			MaxCount, count, isum, n: LongInt;
			i: integer;
			sum, sum2, ri, tSD, rmode, xc, yc: extended;
			Major, Minor, EllipseAngle, hcenter, vcenter, calValue: extended;
			MinCalibratedValue, MaxCalibratedValue, CalibratedMean: extended;
			IgnoreThresholding: boolean;
			ulength, clength: extended;
	begin
		with info^, results do begin
				case ThresholdingMode of
					DensitySlice:  begin
							MinIndex := SliceStart;
							MaxIndex := SliceEnd;
						end;
					GrayMapThresholding:  begin
							MinIndex := GrayMapThreshold;
							MaxIndex := 255;
						end;
					BinaryImage:  begin
							MinIndex := BlackIndex;
							MaxIndex := BlackIndex;
						end;
					NoThresholding:  begin
							MinIndex := 0;
							MaxIndex := 255;
						end;
				end;
				IgnoreThresholding := RedirectSampling or (IncludeHoles and (AnalyzingParticles or (CurrentTool = Wand)));
				if IgnoreThresholding then begin
						MinIndex := 0;
						MaxIndex := 255;
					end;
				while (histogram[MinIndex] = 0) and (MinIndex < 255) do
					MinIndex := MinIndex + 1;
				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;
				rmode := 0.0;
				imode := 0;
				for i := MinIndex to MaxIndex do begin
						calValue := cvalue[i];
						count := histogram[i];
						sum := sum + count * calValue;
						isum := isum + count * i;
						ri := i;
						sum2 := sum2 + sqr(calValue) * count;
						n := n + count;
						if count > MaxCount then begin
								MaxCount := count;
								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
						minCalibratedValue := 0.0;
						maxCalibratedValue := 0.0;
					end;
				if n > 0 then begin
						CalibratedMean := sum / n;
						UncalibratedMean := isum / n
					end
				else begin
						CalibratedMean := 0.0;
						UncalibratedMean := 0.0
					end;
				IncrementCounter;
				mean^[mCount] := CalibratedMean;
				mMin^[mCount] := minCalibratedValue;
				mMax^[mCount] := maxCalibratedValue;
				if mCount <= MaxStandards then
					umean[mCount] := UncalibratedMean;
				if n > 0 then begin
						tSD := (n * Sum2 - sqr(sum)) / n;
						if tSD > 0.0 then
							tSD := sqrt(tSD / (n - 1.0))
						else
							tSD := 0.0
					end
				else
					tSD := 0.0;
				sd^[mCount] := tSD;
				PixelCount^[mCount] := n;
				ulength := 0.0;
				clength := 0.0;
				with RoiRect do
					case RoiType of
						RectRoi:  begin
								uLength := ((right - left) + (bottom - top)) * 2.0;
								cLength := uLength;
								if SpatiallyCalibrated then
									cLength := ((right - left) / xScale + (bottom - top) / yScale) * 2.0;
							end;
						OvalRoi:  begin
								uLength := pi * ((right - left) + (bottom - top)) / 2.0;
								cLength := uLength;
								if SpatiallyCalibrated then
									cLength := pi * ((right - left) / xScale + (bottom - top) / yScale) / 2.0;
							end;
						LineRoi, SegLineRoi, FreeLineRoi:  begin
								GetLengthOrPerimeter(ulength, clength);
								nLengths := nLengths + 1;
							end;
						PolygonRoi, FreehandRoi, TracedRoi: 
							if (LengthM in Measurements) or (nLengths > 0) or WandAdjustAreas then
								GetLengthOrPerimeter(ulength, clength);
						otherwise
					end;
				if SpatiallyCalibrated then
					plength^[mCount] := cLength
				else
					plength^[mcount] := uLength;
				if SpatiallyCalibrated then
					mArea^[mCount] := n / (xScale * yScale)
				else
					mArea^[mCount] := n;
				mode^[mCount] := rmode;
				if FitEllipse then begin
					GetEllipseParam(Major, Minor, EllipseAngle, xc, yc);
					if InvertYCoordinates then
						yc := PicRect.bottom - yc;
					if SpatiallyCalibrated then begin
							Major := Major / xScale;
							Minor := Minor / xScale;
							xc := xc / xScale;
							yc := yc / yScale;
						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;
					with RoiRect do begin
						xc := left + (right - left) / 2.0;
						yc := top + (bottom - top) / 2.0;
						if InvertYCoordinates then
							yc := PicRect.bottom - yc;
						if SpatiallyCalibrated then begin
								xc := xc / xScale;
								yc := yc / yScale;
							end;
						xcenter^[mCount] := xc;
						ycenter^[mCount] := yc;
					end;
				end;
			end; {with}
		measuring := true;
		InfoMessage := '';
	end;


{$PUSH}
{$D-}


	procedure FindThresholdingMode;
	begin
		with info^ do begin
				if DensitySlicing then
					ThresholdingMode := DensitySlice
				else if thresholding then begin
						ThresholdingMode := GrayMapThresholding;
						GrayMapThreshold := ColorStart;
						if GrayMapThreshold < 0 then
							GrayMapThreshold := 0;
						if GrayMapThreshold > 255 then
							GrayMapThreshold := 255;
					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);
		with info^ do begin
				FindThresholdingMode;
				if ThresholdingMode = BinaryImage then
					ThresholdingMode := NoThresholding;
				AutoSelectAll := not RoiShowing;
				if AutoSelectAll then
					SelectAll(false);
				if (RoiType = RectRoi) and (not RedirectSampling) then
					GetRectHistogram
				else
					GetHistogram;
				if MeasurementToRedo > 0 then begin
						SaveN := mCount;
						mCount := MeasurementToRedo - 1;
						ComputeResults;
						ShowInfo;
						mCount := SaveN;
						MeasurementToRedo := 0;
						UpdateList;
					end
				else begin
						ComputeResults;
						ShowInfo;
						AppendResults;
						if RoiType = LineRoi then
							if nLengths = 1 then
								if not (LengthM in Measurements) then
									UpdateList;
					end;
				RoiShowing := true;
				WhatToUndo := UndoMeasurement;
				if AutoSelectAll then
					KillRoi;
				UpdateScreen(OldRoiRect);
			end;
	end;


	procedure ShowHistogram;
		var
			htop: integer;
			tport: GrafPtr;
			hrect, prect, srect: rect;
			FirstTime: boolean;
	begin
		GetPort(tPort);
		FirstTime := HistoWindow = nil;
		if FirstTime 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;
		if FirstTime or (VideoControl = nil) then
			SelectWindow(HistoWindow);
		SetPort(HistoWindow);
		InvalRect(HistoWindow^.PortRect);
		SetPort(tPort);
	end;


	procedure ShowContinuousHistogram;
		const
			skip = 10;
		var
			i, NumberOfLines: integer;
			offset: LongInt;
			p: ptr;
	begin
		with info^ do
			if (FrameGrabber = QTvdig) and (PictureType = FrameGrabberType) then
				CopyOffscreen(fgPixMap, osPort^.portPixMap, PicRect, PicRect);
		for i := 0 to 255 do
			Histogram[i] := 0;
		p := ptr(ptr(fgSlotBase));
		NumberOfLines := ((fgHeight) div skip) - 1;
		offset := fgRowBytes * skip;
		for i := 1 to NumberOfLines do begin
				DoHistogramOfLine(p, histogram, fgWidth);
				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) and (not RedirectSampling) then
			GetRectHistogram
		else
			GetHistogram;
		ThresholdingMode := NoThresholding;
		ComputeResults;
		ShowCount := false;
		ShowInfo;
		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;


{$POP}

	procedure PlotDensityProfile;
		var
			hloc, vloc, value, width, height, i: integer;
			aLine: LineType;
			sum: array[0..MaxLine] of real;
			start, p1, p2: point;
	begin
		with info^ do
			if RoiShowing then
				case RoiType of
					LineRoi:  begin
							PlotLineProfile;
							exit(PlotDensityProfile);
						end;
					FreeLineRoi, SegLineRoi, PolygonRoi, FreehandRoi, TracedRoi:  begin
							PlotArbitraryLine;
							exit(PlotDensityProfile);
						end;
				end; {case}
		if NoSelection or NotRectangular or NotInBounds then
			exit(PlotDensityProfile);
		ShowWatch;
		with info^.RoiRect do begin
				width := right - left;
				height := bottom - top;
				start.h := left;
				start.v := bottom;
				if (width >= height) or (OptionKeyWasDown) then begin
            {Column Average Plot}
						if width > MaxLine then begin
							PlotTooLongMsg;
							exit(PlotDensityProfile);
						end;
						for i := 0 to width - 1 do
							sum[i] := 0.0;
						for vloc := top to bottom - 1 do begin
								GetLine(left, vloc, width, aLine);
								for i := 0 to width - 1 do
									sum[i] := sum[i] + cvalue[aLine[i]];
							end;
						for i := 0 to width - 1 do
							PlotData^[i] := sum[i] / height;
						PlotCount := width;
						PlotAvg := height;
						PlotStart.h := left;
						PlotStart.v := top + (bottom - top) div 2;
						PlotAngle := 0.0;
						ComputePlotMinAndMax;
						if ShowPlot then
							SetupPlot(start, false);
					end
				else begin
           {Row Average Plot}
						if height > MaxLine then begin
							PlotTooLongMsg;
							exit(PlotDensityProfile);
						end;
						for i := 0 to height - 1 do
							sum[i] := 0.0;
						for hloc := left to right - 1 do begin
								GetColumn(hloc, top, height, aLine);
								for i := 0 to height - 1 do
									sum[i] := sum[i] + cValue[aLine[i]];
							end;
						for i := 0 to height - 1 do
							PlotData^[i] := sum[i] / width;
						PlotCount := height;
						PlotAvg := width;
						PlotStart.h := left + (right - left) div 2;
						PlotStart.v := top;
						PlotAngle := 270.0;
						ComputePlotMinAndMax;
						if ShowPlot then
							SetupPlot(start, true);
					end;
			end; {with}
	end;


	procedure SetScaleUProc (d: DialogPtr; item: integer);
     {User proc for Set Scale dialog box}
		var
			str: str255;
			VersInfo: str255;
			r: rect;
	begin
		SetPort(d);
		GetDItemRect(d, item, r);
		DrawDropBox(r);
		GetMenuItemText(UnitsMenuH, ord(UnitsKind) + 1, str);
		DrawPopUpText(str, r);
	end;


	procedure SetScale;
		const
			MeasuredDistanceID = 3;
			KnownDistanceID = 4;
			AspectRatioID = 5;
			ScaleID = 7;
			UnitsTextID = 8;
		var
			mylog: DialogPtr;
			item, i: integer;
			SaveUnitsKind, OldUnitsKind, MenuUnitsKind: UnitsType;
			KnownDistance, MeasuredDistance, SaveScale, TempScale, CalibratedDistance: extended;
			UnitsPerCM, OldUnitsPerCM, SaveRawScale, SaveAspectRatio: extended;
			ignore, MenuItem: integer;
			str: str255;
			SaveUnits: UnitType;
			isLineSelection: boolean;
			ulength, clength: extended;
			r: rect;
	begin
		if SetScaleUserProc=nil
			then SetScaleUserProc:=NewRoutineDescriptor(@SetScaleUProc, uppUserItemProcInfo, GetCurrentISA);
		with info^ do begin
				if (not RoiShowing) and (CurrentTool = LineTool) and (NoInfo^.roiType = LineRoi) then
					RestoreRoi;
				isLineSelection := RoiShowing and (RoiType = LineRoi);
				InitCursor;
				if isLineSelection then begin
						GetLengthOrPerimeter(ulength, clength);
						MeasuredDistance := ulength;
					end
				else
					MeasuredDistance := 0.0;
				if not SpatiallyCalibrated then
					xUnit := 'pixel';
				GetUnitsKind(UnitsKind, UnitsPerCM);
				SaveUnits := xUnit;
				SaveUnitsKind := UnitsKind;
				SaveScale := xScale;
				SaveAspectRatio := PixelAspectRatio;
				KnownDistance := 0.0;
				mylog := GetNewDialog(10, nil, pointer(-1));
				SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2);
				SetDReal(MyLog, KnownDistanceID, KnownDistance, 2);
				SelectdialogItemText(MyLog, KnownDistanceID, 0, 32767);
				SetDReal(MyLog, AspectRatioID, PixelAspectRatio, 4);
				SetUProc(myLog, UnitsPopupID, handle(SetScaleUserProc));
				if UnitsKind = pixels then
					TempScale := 1.0
				else
					TempScale := xScale;
				if trunc(TempScale) = TempScale then
					SetDReal(MyLog, ScaleID, TempScale, 0)
				else
					SetDReal(MyLog, ScaleID, TempScale, 5);
				SetDString(MyLog, UnitsTextID, xUnit);
				setport(myLog);
				repeat
					ModalDialog(nil, item);
					if item = MeasuredDistanceID then
						MeasuredDistance := GetDReal(MyLog, MeasuredDistanceID);
					if item = KnownDistanceID then
						KnownDistance := GetDReal(MyLog, KnownDistanceID);
					if item = ScaleID then begin
							MeasuredDistance := GetDReal(MyLog, ScaleID);
							KnownDistance := 1;
							SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2);
							SetDReal(MyLog, KnownDistanceID, KnownDistance, 2);
						end;
					if item = AspectRatioID then begin
							PixelAspectRatio := GetDReal(MyLog, AspectRatioID);
							if PixelAspectRatio <= 0.0 then begin
									beep;
									PixelAspectRatio := 1.0;
								end;
						end;
					if item = UnitsPopUpID then begin
							OldUnitsKind := UnitsKind;
							OldUnitsPerCM := UnitsPerCM;
							GetDItemRect(myLog, item, r);
							InvertRect(r);
							MenuItem := PopUpMenu(UnitsMenuH, r.left, r.top, ord(UnitsKind) + 1);
							InvertRect(r);
							GetMenuItemText(UnitsMenuH, MenuItem, str);
							DrawPopUpText(str, r);
							UnitsKind := UnitsType(MenuItem - 1);
							GetXUnits(UnitsKind);
							if (UnitsType(MenuItem - 1) = OtherUnits) and (OldUnitsKind <> OtherUnits) then
								xUnit := 'unit';
							SetDString(MyLog, UnitsTextID, xUnit);
							GetUnitsKind(UnitsKind, UnitsPerCM);
							if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) and (OldUnitsPerCM <> 0.0) then
									xScale := xScale * (OldUnitsPerCM / UnitsPerCM);
							if UnitsKind = Pixels then
								KnownDistance := 0.0;
						end;
					if (item = KnownDistanceID) or (item = MeasuredDistanceID) or (item = ScaleID) then
						if (UnitsKind = Pixels) and (item <> cancel) then
							PutError('Please select a measurent unit (not pixels) before setting or changing the scale.')
						else begin
								if (MeasuredDistance > 0.0) and (KnownDistance > 0.0) then
										xScale := MeasuredDistance / KnownDistance;
							end;
					if UnitsKind = pixels then
						TempScale := 1.0
					else
						TempScale := xScale;
					if item <> ScaleID then begin
							if (trunc(TempScale) = TempScale) or (TempScale >= 10000.0) then
								SetDReal(MyLog, ScaleID, TempScale, 0)
							else if TempScale < 0.01 then
								SetDReal(MyLog, ScaleID, TempScale, 6)
							else
								SetDReal(MyLog, ScaleID, TempScale, 3);
						end;
					if item = UnitsTextID then begin
							str := GetDString(myLog, item);
							TruncateString(str, maxUnit);
							xUnit := str;
							GetUnitsKind(UnitsKind, UnitsPerCM);
							GetDItemRect(myLog, UnitsPopUpID, r);
							InvalRect(r);
						end;
				until (item = ok) or (item = cancel);
				DisposeDialog(mylog);
				if item = cancel then begin
						xUnit := SaveUnits;
						UnitsKind := SaveUnitsKind;
						xScale := SaveScale;
						PixelAspectRatio := SaveAspectRatio;
					end
				else
					Changes := true;
				SpatiallyCalibrated := (xScale <> 0.0) and (xUnit <> 'pixel');
				if SpatiallyCalibrated then
					yScale := xScale / PixelAspectRatio
				else begin
					UnitsKind := Pixels;
					UnitsPerCm := 0.0;
					PixelAspectRatio:=1.0;
				end;
				UpdateTitleBar;
				if item<>cancel then begin
					NoInfo^.SpatiallyCalibrated:=SpatiallyCalibrated;
					NoInfo^.xUnit := xUnit;
					NoInfo^.xScale := xScale;
					NoInfo^.PixelAspectRatio := PixelAspectRatio;
				end;
			end; {with info^}
	end;


{$PUSH}
{$D-}


	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 := 60;
		PlotTopMargin := 15;
		PlotBottomMargin := 30;
		PlotRightMargin := 100;
		MinV := minCValue;
		MaxV := maxCValue;
		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;
		for i := 0 to 255 do
			PlotData^[i] := cvalue[i];
		PlotAvg := 1;
		PlotCount := 256;
		MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
		if PlotWindow = nil then
			exit(SetupCalibrationPlot);
		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.0 / round(hrange);
		vscale := range / vrange;
		PlotPICT := OpenPicture(fRect);
		for i := 1 to nStandards do begin
				hloc := round(umean[i] / hscale);
				vloc := vmax - round((StandardValues[i] - minCValue) / vscale);
				SetRect(tRect, hloc - SymbolSize, vloc - SymbolSize, hloc + SymbolSize, vloc + SymbolSize);
				FrameOval(tRect);
			end;
		MoveTo(0, vmax - round((cvalue[0] - minCValue) / vscale));
		for i := 1 to 255 do begin
				hloc := round(i / hscale);
				vloc := vmax - round((cvalue[i] - minCValue) / 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, TempData: ColumnVector;
			Variance: extended;
			SumResidualsSqr, SumStandards, mean, SumMeanDiffSqr, DegreesOfFreedom: extended;
			str1, str2: str255;
	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: 
						nCoefficients := 2;
					Poly2: 
						nCoefficients := 3;
					Poly3: 
						nCoefficients := 4;
					Poly4: 
						nCoefficients := 5;
					Poly5: 
						nCoefficients := 6;
					ExpoFit: 
						nCoefficients := 2;
					PowerFit: 
						nCoefficients := 2;
					LogFit: 
						nCoefficients := 2;
					RodbardFit: 
						nCoefficients := 4;
				end;
				DegreesOfFreedom := nStandards - nCoefficients;
				if DegreesOfFreedom < 0 then begin
						FitGoodness := 0.0;
						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 := 'Rodbard';
						end;
						str2 := concat(' standards to do ', str2, ' fitting.');
						PutError(concat('You need at least ', str1, str2));
						AbortMacro;
						fit:=Uncalibrated;
						exit(DoCurveFitting)
					end;
				DoSimplexFit(nStandards, nCoefficients, XData, YData, Coefficient, residuals);
				ZeroClip := true;
				for i := 1 to nStandards do
					if ydata[i] < 0.0 then
						ZeroClip := false;
				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;
				FitSD := Sqrt(SumResidualsSqr / nStandards);
				mean := SumStandards / nStandards;
				SumMeanDiffSqr := 0.0;
				for i := 1 to nStandards do
					SumMeanDiffSqr := SumMeanDiffSqr + sqr(StandardValues[i] - Mean);
				if (SumMeanDiffSqr > 0.0) and (DegreesOfFreedom <> 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: RealLine;
	begin
		RefNum := 0;
		if not GetTextFile(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;
				mCount := nStandards;
				for i := 1 to mCount do begin
						ClearResults(i);
						mean^[i] := umean[i];
					end;
			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 := 60;
		where.h := 100;
		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 SetupUncalibratedOD;
		var
			i: integer;
	begin
		with info^ do begin
				ZeroClip := false;
				nCoefficients := 0;
				for i := 1 to 6 do
					Coefficient[i] := 1.0;
				fit := UncalibratedOD;
				GenerateValues;
				UnitOfMeasure := 'U. OD';
				nStandards := 0;
				nKnownValues := 0;
			end;
	end;


	function InvertOD (var temp: StandardsArray): boolean;
		var
			i: integer;
	begin
		for i := 1 to nStandards do
			if (StandardValues[i] < 0.000009) or (StandardValues[i] > 4.64) then begin
					PutError('Known OD Values must be in the range 0.00001 to 4.62.');
					InvertOD := false;
					exit(InvertOD);
				end;
		for i := 1 to nStandards do  {temp[i] := -log10(1.000 - exp10(-StandardValues[i]));}
			temp[i] := -0.434294481 * ln(1.000 - exp(-2.302585093 * StandardValues[i]));
		InvertOD := true;
	end;


	function DoCalibrateDialog:boolean;
	const
		FirstLevelID = 3;
		FirstStandardID = 23;
		FirstFitID = 63;
		LastFitID = 74; {Uncalibrated OD}
		UnitOfMeasureID = 75;
		OpenID = 77;
		SaveID = 78;
		InvertID = 81;
	var
		mylog: DialogPtr;
		ignore, item, i, nBadReals: integer;
		str: str255;
		NewValues: StandardsArray;
	begin
		with info^ do begin
			mylog := GetNewDialog(20, nil, pointer(-1));
			nStandards := mCount;
			if nStandards > MaxStandards then
				nStandards := MaxStandards;
			for i := 1 to nStandards do begin
					SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2);
					if (i <= nKnownValues) and (StandardValues[i] <> BadReal) then
						SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3);
				end;
			SelectdialogItemText(MyLog, FirstStandardID, 0, 32767);
			if fit = SpareFit1 then
				fit := Uncalibrated;
			SetDlogItem(mylog, FirstFitID + ord(fit), 1);
			if fit <> uncalibrated 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
								PutError('Before entering known values you must use the Measure command to read a set of standards.');
								SetDString(MyLog, item, '');
							end;
						if i > nKnownValues then
							nKnownValues := i;
					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
								PutError('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
							SetDlogItem(mylog, i, 0);
						SetDlogItem(mylog, item, 1);
						fit := CurveFitType(item - FirstFitID);
					end;
				if item = UnitOfMeasureID then begin
					str := GetDString(MyLog, item);
					TruncateString(str, maxUM);
					UnitOfMeasure := str;
				end;
				if item = OpenID then begin
						GetStandardsFromFile(mylog, FirstLevelID, FirstStandardID);
						nKnownValues := nStandards;
					end;
				if (item = SaveID) and (nStandards > 1) then
					SaveStandardsToFile(nStandards);
				if (item = InvertID) and (nStandards > 1) then
					if InvertOD(NewValues) then
						for i := 1 to nStandards do begin
								StandardValues[i] := NewValues[i];
								SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 5);
							end;
			until (item = ok) or (item = cancel);
			DisposeDialog(mylog);
			DoCalibrateDialog:=item <> cancel;
		end; {with info^}
	end; {DoCalibrateDialog}


	procedure Calibrate;
		var
			nBadReals, i: integer;
			SaveStandards, temp: StandardsArray;
	begin
		SaveStandards := StandardValues;
		if not macro then
			if not DoCalibrateDialog then begin
				StandardValues := SaveStandards;
				exit(Calibrate);
			end;
		with info^ do begin
				if fit = uncalibrated then begin
						RemoveDensityCalibration;
						exit(calibrate)
					end;
				nBadReals := 0;
				if nStandards > nKnownValues then
					nStandards := nKnownValues;
				if fit = UncalibratedOD then
					SetupUncalibratedOD
				else begin
						for i := 1 to nStandards do
							if StandardValues[i] = BadReal then
								nBadReals := nBadReals + 1;
						if (nStandards > 0) and (nBadReals = 0) then
							DoCurveFitting
						else if fit = uncalibrated then
							beep;
					end;
				if fit <> uncalibrated then begin
						if not macro then
							SetupCalibrationPlot;
					end;
				NoInfo^.fit := fit;
				NoInfo^.nCoefficients := nCoefficients;
				NoInfo^.Coefficient := Coefficient;
				NoInfo^.ZeroClip := ZeroClip;
				NoInfo^.UnitOfMeasure := UnitOfMeasure;
				if (fit<>StraightLine) or (Coefficient[2] <> -1.0) then
					InvertPixelValues:=false;
				UpdateTitleBar;
			end; {with info^}
	end; {Calibrate}


	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;
				ShowInfo;
				if ResultsWindow <> nil then begin
						with ListTE^^ do
							TESetSelect(0, teLength, ListTE);
						TEDelete(ListTE);
						UpdateResultsScrollBars;
					end;
			end;
		measuring := false;
	end;


	procedure ShowResults;
		const
			FontSize = 9;
		var
			wrect, crect, trect: rect;
			loc: point;
	begin
		mCount2 := mCount;
		if ResultsWindow <> nil then begin
				SelectWindow(ResultsWindow);
				exit(ShowResults);
			end;
		CopyResultsToBuffer(1, mCount, true);
		ShowMessage('');
		ResultsWidth := 110 + round(nListColumns * FieldWidth * 6.5);
		if ResultsWidth < 250 then
			ResultsWidth := 250;
		if (ResultsWidth + 20) > ScreenWidth then
			ResultsWidth := ScreenWidth - 20;
		ResultsHeight := ((TextBufLineCount * 2) + 2) * FontSize;
		if ResultsHeight < 200 then
			ResultsHeight := 200;
		if (ResultsHeight + ResultsTop + 50) > ScreenHeight then
			ResultsHeight := ScreenHeight - ResultsTop - 50;
		SetRect(wrect, ResultsLeft, ResultsTop, ResultsLeft + ResultsWidth, ResultsTop + ResultsHeight);
		ResultsWindow := NewWindow(nil, wrect, 'Results', true, 0, pointer(-1), true, 0);
		WindowPeek(ResultsWindow)^.WindowKind := ResultsKind;
		SetRect(crect, ResultsWidth - ScrollBarWidth, -1, ResultsWidth + 1, ResultsHeight - 14);
		vScrollBar := NewControl(ResultsWindow, crect, '', true, 0, 0, ResultsHeight - 14, ScrollBarProc, 0);
		SetRect(crect, -1, ResultsHeight - ScrollBarWidth, ResultsWidth - 14, ResultsHeight + 1);
		hScrollBar := NewControl(ResultsWindow, crect, '', true, 0, 0, ResultsWidth - 14, ScrollBarProc, 0);
		InitResultsTextEdit(Monaco, FontSize);
		DrawControls(ResultsWindow);
		WhatToUndo := NothingToUndo;
	end;


	procedure DoMeasurementOptions;
		const
			FirstID = 3;
			LastID = 15;
			RedirectID = 22;
			IncludeHolesID = 23;
			AutoID = 24;
			AdjustID = 25;
			HeadingsID = 26;
			MaxMeasurementsID = 21;
			WidthID = 19;
			PrecisionID = 17;
		var
			mylog: DialogPtr;
			item, i, SavePrecision, SaveMaxMeasurements, SaveWidth: integer;
			mtype: MeasurementTypes;
			SaveMeasurements: SetOfMeasurements;
			SaveRedirect: boolean;
			SaveAuto, SaveAdjust, SaveHeadings: boolean;
	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;
		SaveRedirect := RedirectSampling;
		SaveWidth := FieldWidth;
		SavePrecision := precision;
		SaveAuto := WandAutoMeasure;
		SaveAdjust := WandAdjustAreas;
		SaveMaxMeasurements := MaxMeasurements;
		SaveHeadings := ShowHeadings;
		mylog := GetNewDialog(4000, nil, pointer(-1));
		mtype := AreaM;
		for i := FirstID to LastID do begin
				if mtype in measurements then
					SetDlogItem(mylog, i, 1);
				if i <> LastID then
					mtype := succ(mtype);
			end;
		SetDlogItem(mylog, RedirectID, ord(RedirectSampling));
		SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
		SetDlogItem(mylog, AutoID, ord(WandAutoMeasure));
		SetDlogItem(mylog, AdjustID, ord(WandAdjustAreas));
		SetDlogItem(mylog, HeadingsID, ord(ShowHeadings));
		SetDNum(MyLog, MaxMeasurementsID, MaxMeasurements);
		SetDNum(MyLog, WidthID, FieldWidth);
		SetDNum(MyLog, PrecisionID, precision);
		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;
						11: 
							mtype := User1M;
						12: 
							mtype := User2M;
					end;
					if mtype in measurements then begin
							measurements := measurements - [mtype];
							SetDlogItem(mylog, item, 0)
						end
					else begin
							measurements := measurements + [mtype];
							SetDlogItem(mylog, item, 1)
						end;
				end;
			if item = RedirectID then begin
					RedirectSampling := not RedirectSampling;
					SetDlogItem(mylog, RedirectID, ord(RedirectSampling));
				end;
			if item = IncludeHolesID then begin
					IncludeHoles := not IncludeHoles;
					SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
				end;
			if item = AutoID then begin
					WandAutoMeasure := not WandAutoMeasure;
					SetDlogItem(mylog, AutoID, ord(WandAutoMeasure));
				end;
			if item = AdjustID then begin
					WandAdjustAreas := not WandAdjustAreas;
					SetDlogItem(mylog, AdjustID, ord(WandAdjustAreas));
				end;
			if item = HeadingsID then begin
					ShowHeadings := not ShowHeadings;
					SetDlogItem(mylog, HeadingsID, ord(ShowHeadings));
				end;
			if item = WidthID then
				FieldWidth := GetDNum(MyLog, WidthID);
			if item = PrecisionID then
				precision := GetDNum(MyLog, PrecisionID);
			if item = MaxMeasurementsID then
				MaxMeasurements := GetDNum(MyLog, MaxMeasurementsID);
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		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 (MaxMeasurements < 1) or (MaxMeasurements > MaxMaxRegions) then begin
				MaxMeasurements := SaveMaxMeasurements;
				beep;
			end;
		if item = cancel then begin
				measurements := SaveMeasurements;
				RedirectSampling := SaveRedirect;
				FieldWidth := SaveWidth;
				precision := SavePrecision;
				WandAutoMeasure := SaveAuto;
				WandAdjustAreas := SaveAdjust;
				MaxMeasurements := SaveMaxMeasurements;
				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 MaxMeasurements <> SaveMaxMeasurements then begin
				PutError('You must quit and restart NIH Image before the change to Max Measurements will take effect.');
				SaveSettings;
				MaxMeasurements:=SaveMaxMeasurements;
			end;
		if (Measurements <> SaveMeasurements) or (SaveWidth <> FieldWidth) or (SavePrecision <> Precision) then
			UpdateList;
	end;


	procedure UpdateRoiLineWidth;
	begin
		with info^, info^.RoiRect do
			if RoiShowing and (RoiType = LineRoi) then begin
					LX1 := left + LX1;
					LY1 := top + LY1;
					LX2 := left + LX2;
					LY2 := top + LY2;
					MakeRegion;
				end;
	end;


	procedure DoProfilePlotOptions;
		const
			FixedScaleID = 7;
			MinID = 8;
			MaxID = 9;
			FixedSizeID = 10;
			WidthID = 11;
			HeightID = 12;
			LineWidthID = 13;
			LinePlotID = 14;
			ScatterPlotID = 15;
			InvertID = 16;
			LabelsID = 17;
		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;
		SaveWidth := ProfilePlotWidth;
		SaveHeight := ProfilePlotHeight;
		SaveDrawLabels := DrawPlotLabels;
		mylog := GetNewDialog(5000, nil, pointer(-1));
		SetDlogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
		SetDReal(MyLog, MinID, ProfilePlotMin, 2);
		SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
		SetDlogItem(mylog, FixedSizeID, ord(FixedSizePlot));
		SetDNum(MyLog, WidthID, ProfilePlotWidth);
		SetDNum(MyLog, HeightID, ProfilePlotHeight);
		if LinePlot then
			SetDlogItem(mylog, LinePlotID, 1)
		else
			SetDlogItem(mylog, ScatterPlotID, 1);
		if InvertPlots then
			SetDlogItem(mylog, InvertID, 1);
		if DrawPlotLabels then
			SetDlogItem(mylog, LabelsID, 1);
		SetDNum(MyLog, LineWidthID, LineWidth);
		repeat
			ModalDialog(nil, item);
			if item = FixedScaleID then begin
					AutoscalePlots := not AutoscalePlots;
					SetDlogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
				end;
			if item = MinID then begin
					ProfilePlotMin := GetDReal(MyLog, MinID);
					AutoscalePlots := false;
					SetDlogItem(mylog, FixedScaleID, 1);
				end;
			if item = MaxID then begin
					ProfilePlotMax := GetDReal(MyLog, MaxID);
					AutoscalePlots := false;
					SetDlogItem(mylog, FixedScaleID, 1);
				end;
			if item = FixedSizeID then begin
					FixedSizePlot := not FixedSizePlot;
					SetDlogItem(mylog, FixedSizeID, ord(FixedSizePlot));
				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;
					FixedSizePlot := true;
					SetDlogItem(mylog, FixedSizeID, 1);
				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;
					FixedSizePlot := true;
					SetDlogItem(mylog, FixedSizeID, 1);
				end;
			if (item = LinePlotID) or (item = ScatterPlotID) then begin
					SetDlogItem(mylog, LinePlotID, 0);
					SetDlogItem(mylog, ScatterPlotID, 0);
					SetDlogItem(mylog, item, 1);
					LinePlot := item = LinePlotID;
				end;
			if item = InvertID then begin
					InvertPlots := not InvertPlots;
					SetDlogItem(mylog, InvertID, ord(InvertPlots));
				end;
			if item = LabelsID then begin
					DrawPlotLabels := not DrawPlotLabels;
					if DrawPlotLabels then {Attempt to fix a "sticky" check box bug.}
						SetDlogItem(mylog, LabelsID, 1)
					else
						SetDlogItem(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);
		DisposeDialog(mylog);
		if item = cancel then begin
				ProfilePlotWidth := SaveWidth;
				ProfilePlotHeight := SaveHeight;
				AutoscalePlots := SaveAutoscale;
				LinePlot := SaveLinePlot;
				InvertPlots := SaveInvert;
				ProfilePlotMin := SaveMin;
				ProfilePlotMax := SaveMax;
				DrawPlotLabels := SaveDrawLabels;
				LineWidth := SaveLineWidth;
				if LineIndex <> SaveLineIndex then begin
						LineIndex := SaveLineIndex;
						DrawTools;
					end;
			end;
		if LineWidth <> SaveLineWidth then
			UpdateRoiLineWidth;
		if ProfilePlotMax <= ProfilePlotMin then begin
				ProfilePlotMin := SaveMin;
				ProfilePlotMax := SaveMax;
			end;
	end;


	procedure DoPoints (event: EventRecord);
		var
			loc, tloc: point;
			hloc, vloc, y, offset: LongInt;
			r: rect;
			str, str1, str2: str255;
			Decrement: boolean;
			SaveGDevice: GDHandle;
	begin
		Decrement := false;
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		SetPort(GrafPtr(info^.osPort));
		pmForeColor(ForegroundIndex);
		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 SpatiallyCalibrated then
					mArea^[mCount] := 1.0 / xScale * yScale
				else
					mArea^[mCount] := 1;
				mean^[mCount] := cvalue[MyGetPixel(hloc, vloc)];
				with info^ do
					if SpatiallyCalibrated then begin
							xcenter^[mCount] := hloc / xScale;
							ycenter^[mCount] := y / yScale;
						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;
				DrawTextString(str, tloc, TeJustCenter);
			end
		else begin
				offset := LineWidth div 2;
				SetRect(r, hloc - offset, vloc - offset, hloc + offset + 1, vloc + offset + 1);
				if ShiftKeyDown then begin
						Decrement := true;
						EraseOval(r);
						mcount := mcount - 2;
						if mcount <= 0 then begin
								mcount := 0;
								UnsavedResults := false;
							end;
						nPoints := nPoints - 2;
						if nPoints < 0 then
							nPoints := 0;
					end
				else
					PaintOval(r);
				UpdateScreen(r);
				if ControlKeyDown then
					with info^ do begin
							if SpatiallyCalibrated then begin
									RealToString(hloc / xScale, 1, Precision, str1);
									RealToString(y / yScale, 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, ')');
							DrawTextString(str, tloc, TeJustLeft);
						end; {Control Key Down}
			end;
		SetGDevice(SaveGDevice);
		InfoMessage := '';
		ShowInfo;
		if Decrement then begin
				DeleteLines(mcount + 1, mcount + 1);
				WhatToUndo := NothingToUndo;
			end
		else begin
				AppendResults;
				if (nPoints = 1) then
					if not (XYlocM in Measurements) then
						UpdateList;
				measuring := true;
				WhatToUndo := UndoPoint;
			end;
	end;


	procedure FindAngle (event: EventRecord);
		var
			start, finish, OldFinish, MidPoint, first: point;
			ticks: LongInt;
			x1, y1, x2, y2: integer;
			angle, angle1, angle2: extended;
			StartRect: rect;
			FirstLineDone: boolean;
	begin
		if NoUndo then
			exit(FindAngle);
		DrawLabels('Angle:', '', '');
		FlushEvents(EveryEvent, 0);
		start := event.where;
		Pt2Rect(start, start, StartRect);
		InsetRect(StartRect, -2, -2);
		finish := start;
		SetPort(info^.wptr);
		PenNormal;
		PenMode(PatXor);
		PenSize(1, 1);
		MoveTo(start.h, start.v);
		first := start;
		repeat
			repeat
				OldFinish := finish;
				GetMouse(finish);
				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;
				angle1 := GetAngle(x1, info^.PixelAspectRatio * y1);
				Show1Value(angle1, NoValue);
			until GetNextEvent(mUpMask, event);
			FirstLineDone := not PtInRect(finish, StartRect);
			if not FirstLineDone then
				start := finish;
		until FirstLineDone;
		MidPoint := finish;
		x1 := start.h - MidPoint.h;
		y1 := MidPoint.v - start.v;
		angle1 := GetAngle(x1, info^.PixelAspectRatio * y1);
		start := finish;
		finish := start;
		repeat
			OldFinish := finish;
			GetMouse(finish);
			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;
			angle2 := GetAngle(x2, info^.PixelAspectRatio * y2);
			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);
		nAngles := nAngles + 1;
		IncrementCounter;
		ClearResults(mCount);
		Orientation^[mCount] := angle;
		InfoMessage := '';
		ShowInfo;
		AppendResults;
		if nAngles = 1 then
			UpdateList;
		repeat
		until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
		xCoordinates^[1] := first.h;
		yCoordinates^[1] := first.v;
		xCoordinates^[2] := midpoint.h;
		yCoordinates^[2] := midpoint.v;
		xCoordinates^[3] := finish.h;
		yCoordinates^[3] := finish.v;
		nCoordinates := 3;
		MakeNonStraightLineRoi(SegLineRoi);
	end;


	procedure SaveBlankField;
		var
			SaveInfo: InfoPtr;
			i, xLines, xPixelsPerLine: integer;
			src, dst: ptr;
			SaveFlag: boolean;
			name: str255;
	begin
		if info^.PictureType = FrameGrabberType then begin
				GetWTitle(info^.wptr, name);
				if pos('(Corrected)', name) > 0 then begin
						PutError('To save a blank field the captured image must be uncorrected.');
						exit(SaveBlankField);
					end;
				SaveInfo := info;
				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 := round(results.UncalibratedMean);
				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
			ShowInfo;
	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; 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}

		var
			count, hloc, vloc, index, SaveBackground: integer;
			Saveport: GrafPtr;
			direction, NewDirection: char;
			table: string[16];
			UL, UR, LL, LR, SaveCoordinates: boolean;
			TempRgn: RgnHandle;
	begin
		TouchingEdge := false;
		table := 'XRDRUUuULlDRLLDX';
		GetPort(SavePort);
		SetPort(GrafPtr(info^.osPort));
		if SelectionMode <> NewSelection then
			TempRgn := NewRgn;
		with info^ do begin
				SaveBackground := BackgroundIndex; {We want MyGetPixel to always return 0}
				BackgroundIndex := WhiteIndex;     {for coordinates beyond the edge of the image.}
				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);
				MoveTo(hstart, vstart);
				SaveCoordinates := not MakingLOI;
				if SaveCoordinates then begin
						xCoordinates^[1] := hstart;
						yCoordinates^[1] := vstart;
					end;
				count := 1;
				repeat
					if IgnoreParticlesTouchingEdge then
						with info^.PicRect do
							TouchingEdge := TouchingEdge or (hloc = left) or (hloc = right) or (vloc = top) or (vloc = bottom);
					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;
					if NewDirection <> direction then begin
						LineTo(hloc, vloc);
						if SaveCoordinates then begin
								xCoordinates^[count] := hloc;
								yCoordinates^[count] := vloc;
								count := count + 1;
							end;
					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;
					direction := NewDirection;
				until ((hloc = hstart) and (vloc = vstart) and (direction = StartingDirection)) or (count >= MaxCoordinates);
				LineTo(hstart, vstart);
				if SelectionMode <> NewSelection then
					CloseRgn(TempRgn)
				else
					CloseRgn(roiRgn);
				{ShowMessage(StringOf(count, '  ', GetHandleSize(handle(roiRgn)))); beep;}
				with roiRgn^^.rgnBBox do
					if (count >= MaxCoordinates) or (((right - left) = 0) and ((bottom - top) = 0))  then begin
						SetEmptyRgn(roiRgn);
						SetPort(SavePort);
						TraceEdge := false;
						BackgroundIndex := SaveBackground;
						nCoordinates := 0;
						AbortMacro;
						PutError(StringOf('Perimeter too long.', cr, '(', count:1, ' coordinates)'));
						exit(TraceEdge);
					end;
				if (SelectionMode = AddSelection) then begin
						if RgnNotTooBig(roiRgn, TempRgn) then
							UnionRgn(roiRgn, TempRgn, roiRgn);
					end
				else if (SelectionMode = SubSelection) then begin
						if RgnNotTooBig(roiRgn, TempRgn) then
							DiffRgn(roiRgn, TempRgn, roiRgn);
					end;
				RoiShowing := true;
				roiType := TracedRoi;
				if SelectionMode = SubSelection then
					UpdateScreen(RoiRect);
				RoiRect := roiRgn^^.rgnBBox;
				BackgroundIndex := SaveBackground;
			end; {with info}
		if SelectionMode <> NewSelection then
			DisposeRgn(TempRgn);
		SetPort(SavePort);
		if SaveCoordinates then begin
				nCoordinates := count - 1;
				MakeCoordinatesRelative;
			end;
		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;
			SaveGDevice: GDHandle;
	begin
		OutlineWithEllipse := FitEllipse and OptionKeyWasDown;
		with info^ do begin
				KillRoi;
				SetupUndo;
				WhatToUndo := UndoOutline;
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				SaveForegroundIndex := ForegroundIndex;
				SetForegroundColor(WhiteIndex);
				PenNormal;
				TextFont(Geneva);
				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 SpatiallyCalibrated then begin
										xc := xc * xScale;
										yc := yc * yScale;
									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);
				SetGDevice(SaveGDevice);
				changes := true;
			end;
	end;


	function isBinaryImage: boolean;
		var
			SaveRoiRect: rect;
			SaveRedirectFlag: boolean;
	begin
		with info^ do begin
				SaveRoiRect := RoiRect;
				RoiRect := PicRect;
				if RedirectSampling then
					GetHistogram
				else
					GetRectHistogram;
				BinaryPic := (histogram[0] + histogram[255]) = PixelsPerLine * nLines;
				isBinaryImage := BinaryPic;
				RoiRect := SaveRoiRect;
			end;
	end;


	function SetupAutoOutline (BinaryPixel: boolean): boolean;
	begin
		SetupAutoOutline := false;
		FindThresholdingMode;
		if (ThresholdingMode = NoThresholding) or MakingLOI then
			if isBinaryImage or BinaryPixel then
				ThresholdingMode := BinaryImage;
		if ThresholdingMode = NoThresholding then begin
				if not macro or AnalyzingParticles then
					PutError('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
				PutError(' Threshold must be non-zero.');
				exit(SetupAutoOutline);
			end;
		if not MakingLOI then
			ShowWatch;
		SetupAutoOutline := true;
	end;


	procedure AutoOutline (start: point);
		var
			hloc, vloc: integer;
			TouchingEdge, BinaryPixel: boolean;
			direction: char;
			count: LongInt;
			Perimeter, CalibratedPerimeter, AspectRatio: extended;
	begin
		with start do
			BinaryPixel := (MyGetPixel(h, v) = WhiteIndex) or (MyGetPixel(h, v) = BlackIndex);
		if not SetupAutoOutline(BinaryPixel) then
			exit(AutoOutline);
		if SelectionMode = NewSelection then
			KillRoi;
		with info^ do begin
				with start do
					if PixelInside(h, v) then begin
							repeat
								h := h + 1;
							until not PixelInside(h, v) or (h >= PicRect.right);
							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);
							direction := 'U';
							if h >= PicRect.right then begin
									beep;
									exit(AutoOutline);
								end;
						end;
				if TraceEdge(start.h, start.v, direction, TouchingEdge) then begin
					if GetHandleSize(handle(roiRgn)) = 10 then
						roiType := RectRoi;
					WhatToUndo := NothingToUndo;
					if WandAutoMeasure and not MakingLOI then begin
							GetHistogram;
							ComputeResults;
							if WandAdjustAreas then begin
									GetLengthOrPerimeter(Perimeter, CalibratedPerimeter);
									with RoiRect do
										AspectRatio := (right - left) / (bottom - top);
									count := PixelCount^[mCount] + round(Perimeter / 2.0 + AspectRatio * 1.5);
									PixelCount^[mCount] := count;
									if SpatiallyCalibrated then
										mArea^[mCount] := count / (xScale * yScale)
									else
										mArea^[mCount] := count;
								end;
							ShowInfo;
							AppendResults;
							WhatToUndo := UndoMeasurement;
							if LabelParticles then
								MarkSelection(mCount);
						end;
					if not (WandAutoMeasure and LabelParticles) then
						RoiShowing := true;
					if not MakingLOI then
						UpdateScreen(RoiRect);
					if not WandAutoMeasure then
						measuring := false;
				end; {if}
			end; {with info}
	end;


	procedure RedoMeasurement;
		var
			SaveN, temp: integer;
			Canceled: boolean;
	begin
		if not isSelectionTool then begin
				CurrentTool := SelectionTool;
				isSelectionTool := true;
				DrawTools;
			end;
		temp := GetInt('Measurement to Redo:', mCount, Canceled);
		if canceled then
			exit(RedoMeasurement);
		MeasurementToRedo := temp;
		if (MeasurementToRedo >= 1) and (MeasurementToRedo <= mCount) then begin
				SaveN := mCount;
				mCount := MeasurementToRedo;
				ShowInfo;
				mCount := SaveN;
			end
		else begin
				beep;
				MeasurementToRedo := 0;
			end;
	end;


	procedure DeleteMeasurement;
		var
			nToDelete, i: integer;
			Canceled: boolean;
	begin
		nToDelete := GetInt('Measurement to delete:', mCount, Canceled);
		if (nToDelete >= 1) and (nToDelete <= mCount) and not Canceled 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 if not Canceled then
			beep;
	end;


	function DoAPDialog: boolean;
		const
			MinID = 6;
			MaxID = 7;
			LabelID = 8;
			OutlineID = 9;
			IgnoreID = 10;
			IncludeHolesID = 11;
			ResetID = 12;
		var
			mylog: DialogPtr;
			item: integer;
	begin
		InitCursor;
		mylog := GetNewDialog(220, nil, pointer(-1));
		SetDNum(MyLog, MinID, MinParticleSize);
		SetDNum(MyLog, MaxID, MaxParticleSize);
		SetDlogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
		SetDlogItem(mylog, LabelID, ord(LabelParticles));
		SetDlogItem(mylog, OutlineID, ord(OutlineParticles));
		SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
		SetDlogItem(mylog, ResetID, ord(APReset));
		repeat
			ModalDialog(nil, item);
			if item = MinID then
				MinParticleSize := GetDNum(MyLog, MinID);
			if item = MaxID then
				MaxParticleSize := GetDNum(MyLog, MaxID);
			if item = IgnoreID then begin
					IgnoreParticlesTouchingEdge := not IgnoreParticlesTouchingEdge;
					SetDlogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
				end;
			if item = LabelID then begin
					LabelParticles := not LabelParticles;
					SetDlogItem(mylog, LabelID, ord(LabelParticles));
				end;
			if item = OutlineID then begin
					OutlineParticles := not OutlineParticles;
					SetDlogItem(mylog, OutlineID, ord(OutlineParticles));
				end;
			if item = IncludeHolesID then begin
					IncludeHoles := not IncludeHoles;
					SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
				end;
			if item = ResetID then begin
					APReset := not APReset;
					SetDlogItem(mylog, ResetID, ord(APReset));
				end;
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		if MinParticleSize < 1 then
			MinParticleSize := 1;
		if MaxParticleSize > 9999999 then
			MaxParticleSize := 9999999;
		if MaxParticleSize <= MinParticleSize then begin
				MinParticleSize := 1;
				MaxParticleSize := 999999;
			end;
		DoAPDialog := item <> cancel;
	end;


	procedure AnalyzeParticles;
	{
	Here's how it works:      (thanks to Stein Roervik)
		for each line do
  			for each pixel in this line do
    			if the pixel value is "inside" the threshold range then
      			trace the edge to mark the object
      			do the measurement
      			fill the object with a colour that is outside the threshold range
   			 else
      			continue the scan
	}
		var
			hloc, vloc, AlertID, index, MaxTriesPerLine, nParticles: integer;
			SaveSliceState, TouchingEdge, DrawOutlines, AutoSelectAll, finished, OutsideSelection: boolean;
			SaveForegroundIndex, SaveBackgroundIndex, EraseIndex, OutlineIndex: integer;
			savePort: GrafPtr;
			ScanRect: rect;
			side: (TopSide, RightSide, BottomSide, LeftSide);
			dstRgn: rgnHandle;
			StartCount: integer;
			SaveGDevice: GDHandle;

		function PixelInside: boolean;
			var
				value: integer;
				offset: LongInt;
				p: ptr;
		begin
			with info^ do begin {MyGetPixel inlined to speed things up.}
					offset := 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,j: integer;
		begin
			j := 0;
			if (StartCount - 1 + nParticles) <= MaxMeasurements then
				for i := StartCount to mCount do begin
						MarkSelection(i);
						j := j + 1;
						if j mod 50 = 0 then
							UpdatePicWindow;
						if CommandPeriod then begin
								beep;
								leave;
							end;
					end;
		end;
		

		procedure abort;
		begin
			SetGDevice(SaveGDevice);
			SetPort(SavePort);
			if LabelParticles then
				LabelBlobs;
			DensitySlicing := SaveSliceState;
			SetForegroundColor(SaveForegroundIndex);
			SetBackgroundColor(SaveBackgroundIndex);
			KillRoi;
			UpdatePicWindow;
			WhatToUndo := UndoEdit;
			UndoFromClip := true;
			AnalyzingParticles := false;
			DisposeRgn(dstRgn);
		end;


	begin
		with info^ do begin
				if NotInBounds or NoUndo then
					exit(AnalyzeParticles);
				if not SetupAutoOutline(false) then
					exit(AnalyzeParticles);
				if not macro and not OptionKeyWasDown then
					if not DoAPDialog then
						exit(AnalyzeParticles);
				AutoSelectAll := not RoiShowing;
				if AutoSelectAll then
					SelectAll(false);
				ScanRect := RoiRect;
				if not AutoSelectAll then
					with ScanRect do begin
							left := picrect.left;
							right := PicRect.right;
						end;
				KillRoi;
				if APReset then begin
						ResetCounter;
						if mCount > 0 then
							exit(AnalyzeParticles);
					end;
				StartCount := mCount + 1;
				UpdatePicWindow;
				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;
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				GetPort(SavePort);
				SetPort(GrafPtr(osPort));
				dstRgn := NewRgn;
				SelectionMode := NewSelection;
				ShowWatch;
				with ScanRect do
					for vloc := top to bottom - 1 do
						for hloc := left to right - 1 do begin
								if PixelInside then begin
										if TraceEdge(hloc, vloc, 'U', TouchingEdge) then begin
												nParticles := nParticles + 1;
												RoiShowing := false;
												if mCount < MaxMeasurements then begin
														GetHistogram;
														ComputeResults;
													end;
												SetBackgroundColor(EraseIndex);
												EraseRgn(roiRgn);
												if AutoSelectAll then
													OutSideSelection := false
												else begin
														SectRgn(roiRgn, NoInfo^.RoiRgn, dstRgn);
														OutSideSelection := EmptyRgn(dstRgn);
													end;
												if (PixelCount^[mCount] < MinParticleSize) or (PixelCount^[mCount] > MaxParticleSize) or TouchingEdge or OutsideSelection then begin
														mCount := mCount - 1;
														nParticles := nParticles - 1;
														UpdateScreen(RoiRect);
														if AnalyzingParticles = false then begin
																abort;
																exit(AnalyzeParticles);
															end;
													end
												else begin
														if DrawOutlines then begin
																SetForegroundColor(OutlineIndex);
																FrameRgn(roiRgn);
															end;
														UpdateScreen(RoiRect);
														if nParticles <= MaxMeasurements then
															AppendResults;
														if (nParticles mod 10) = 0 then ShowMessage(long2str(nParticles));
														if nParticles = MaxMeasurements then
															beep;
														if CommandPeriod or (AnalyzingParticles = false) then begin {quit}
																beep;
																abort;
																exit(AnalyzeParticles);
															end; {quit}
													end;
											end   {if TraceEdge}
											else begin
												abort; {perimeter too large}
												exit(AnalyzeParticles);
											end;
									end; {if PixelInside}
							end; {for}
			end; {with}
		ShowMessage(StringOf('Count=',nParticles:1));
		SetGDevice(SaveGDevice);
		SetPort(SavePort);
		if LabelParticles then
			LabelBlobs;
		DensitySlicing := SaveSliceState;
		SetForegroundColor(SaveForegroundIndex);
		SetBackgroundColor(SaveBackgroundIndex);
		KillRoi;
		UpdatePicWindow;
		if ThresholdingMode = GrayMapThresholding then
			ResetGrayMap;
		WhatToUndo := UndoEdit;
		UndoFromClip := true;
		AnalyzingParticles := false;
		DisposeRgn(dstRgn);
	end;


	procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType);
		var
			i, ff: integer;
			SaveInfo: InfoPtr;
			pt, spt, start: point;
			SaveGDevice: GDHandle;
	begin
		SetupUndoInfoRec;
		SaveInfo := Info;
		Info := UndoInfo;
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		with info^ do begin
				magnification := SaveInfo^.magnification;
				SrcRect := SaveInfo^.SrcRect;
				BinaryPic := true;
				SetPort(GrafPtr(osPort));
			end;
		pmForeColor(BlackIndex);
		pmBackColor(WhiteIndex);
		PenNormal;
		PenSize(LineWidth, LineWidth);
		EraseRect(info^.PicRect);
		ff := LineWidth div 2;
		if ff < 0 then
			ff := 0;
		MakingLOI := true;
		ConvertCoordinates;
		spt.h := xCoordinates^[1];
		spt.v := yCoordinates^[1];
		MoveTo(spt.h - ff, spt.v - ff);
		for i := 2 to nCoordinates do begin
				pt.h := xCoordinates^[i];
				pt.v := yCoordinates^[i];
				LineTo(pt.h - ff, pt.v - ff);
			end;
		start := spt;
		start.h := start.h - 1;
		AutoOutline(start);
		MakingLOI := false;
		info^.RoiShowing := false;
		Info := SaveInfo;
		SetGDevice(SaveGDevice);
		with info^ do begin
				CopyRgn(UndoInfo^.roiRgn, roiRgn);
				RoiRect := UndoInfo^.RoiRect;
				SetEmptyRgn(UndoInfo^.roiRgn);
				RoiShowing := true;
				SetupUndo;
				roiType := RoiKind;
				with RoiRect do begin
						LX1 := spt.h - left;
						LY1 := spt.v - top;
						LX2 := pt.h - left;
						LY2 := pt.v - top;
					end;
			end; {with info^}
		MakeCoordinatesRelative;
	end;


end.