Otherware/Otherware_1_SB_Development.iso/mac/developm/source/image144.sit/Analysis.p

Text File | 1992-03-30 | 69.9 KB | 2,494 lines

unit Analysis;

{Analysis routines used by the Image program}

interface

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



    procedure DoHistogram;
    procedure GetRectHistogram;
    function SetupMask: boolean;
    procedure GetNonRectHistogram;
    procedure ShowContinuousHistogram;
    procedure ComputeResults;
    procedure FindThresholdingMode;
    procedure Measure;
    procedure ShowLineWidth;
    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;


implementation

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


{$PUSH}
{$D-}


    procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt);
{}
{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;}
{}
    {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('Redirected sampling requires a nonrectangular selection.');
        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
            SetupUndo; {Needed for drawing "marching ants".}
    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;
            IgnoreThresholding: boolean;
    begin
        with info^, results do begin
                case ThresholdingMode of
                    DensitySlice:
                        MinIndex := SliceStart;
                    GrayMapThresholding:
                        MinIndex := GrayMapThreshold;
                    BinaryImage:
                        MinIndex := BlackIndex;
                    NoThresholding:
                        MinIndex := 0;
                end;
                IgnoreThresholding := RedirectSampling or (IncludeHoles and (AnalyzingParticles or (CurrentTool = Wand)));
                if IgnoreThresholding 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 IgnoreThresholding 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 SpatiallyCalibrated then begin
                                xc := xc / xSpatialScale;
                                yc := yc / ySpatialScale;
                            end;
                        xcenter^[mCount] := xc;
                        ycenter^[mCount] := yc;
                    end;
                PixelCount^[mCount] := n;
                with RoiRect do
                    case RoiType of
                        RectRoi:  begin
                                uLength := ((right - left) + (bottom - top)) * 2.0;
                                cLength := uLength;
                                if SpatiallyCalibrated then
                                    cLength := ((right - left) / xSpatialScale + (bottom - top) / ySpatialScale) * 2.0;
                            end;
                        OvalRoi:  begin
                                uLength := pi * ((right - left) + (bottom - top)) / 2.0;
                                cLength := uLength;
                                if SpatiallyCalibrated then
                                    cLength := pi * ((right - left) / xSpatialScale + (bottom - top) / ySpatialScale) / 2.0;
                            end;
                        LineRoi, SegLineRoi, FreeLineRoi:  begin
                                if RoiType = LineRoi then
                                    GetLoiLength;
                                nLengths := nLengths + 1;
                            end;
                        otherwise
                    end;
                if SpatiallyCalibrated then
                    plength^[mCount] := cLength
                else
                    plength^[mcount] := uLength;
                if SpatiallyCalibrated then
                    mArea^[mCount] := n / (xSpatialScale * ySpatialScale)
                else
                    mArea^[mCount] := n;
                mode^[mCount] := rmode;
                if FitEllipse and ((RoiType = RgnRoi) or (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiType = SegLineRoi)) then begin
                        GetEllipseParam(Major, Minor, EllipseAngle, xc, yc);
                        if InvertYCoordinates then
                            yc := PicRect.bottom - yc;
                        if SpatiallyCalibrated then begin
                                Major := Major / xSpatialScale;
                                Minor := Minor / ySpatialScale;
                                xc := xc / xSpatialScale;
                                yc := yc / ySpatialScale;
                            end;
                        MajorAxis^[mCount] := Major * 2.0;
                        MinorAxis^[mCount] := Minor * 2.0;
                        orientation^[mCount] := EllipseAngle;
                        xcenter^[mCount] := xc;
                        ycenter^[mCount] := yc;
                    end
                else if RoiType = OvalRoi then
                    with RoiRect do begin
                            Major := right - left;
                            Minor := bottom - top;
                            if SpatiallyCalibrated then begin
                                    Major := Major / xSpatialScale;
                                    Minor := Minor / ySpatialScale;
                                end;
                            MajorAxis^[mCount] := Major;
                            MinorAxis^[mCount] := Minor;
                            orientation^[mCount] := 0.0;
                        end
                else begin
                        MajorAxis^[mCount] := 0.0;
                        MinorAxis^[mCount] := 0.0;
                        orientation^[mCount] := 0.0;
                    end;
            end; {with}
        measuring := true;
        ValuesMessage := '';
    end;


    procedure FindThresholdingMode;
    begin
        with info^ do begin
                if DensitySlicing then
                    ThresholdingMode := DensitySlice
                else if thresholding then begin
                        ThresholdingMode := GrayMapThresholding;
                        GrayMapThreshold := ColorStart;
                    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;
                StopDigitizing;
                AutoSelectAll := not RoiShowing;
                if AutoSelectAll then
                    SelectAll(false);
                if RoiType = RectRoi then
                    GetRectHistogram
                else
                    GetNonRectHistogram;
                if MeasurementToRedo > 0 then begin
                        SaveN := mCount;
                        mCount := MeasurementToRedo - 1;
                        ComputeResults;
                        ShowValues;
                        mCount := SaveN;
                        MeasurementToRedo := 0;
                        UpdateList;
                    end
                else begin
                        ComputeResults;
                        ShowValues;
                        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;
    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;
        ShowValues;
        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;
            sum: array[0..MaxLine] of LongInt;
            start, p1, p2: point;
    begin
        with info^ do
            if RoiShowing and (RoiType = LineRoi) then begin
                    with RoiRect do begin
                            p1.h := left + trunc(LX1);
                            p1.v := top + trunc(LY1);
                            p2.h := left + trunc(LX2);
                            p2.v := top + trunc(LY2);
                        end;
                    DoProfilePlot(p1, p2);
                    exit(PlotDensityProfile);
                end;
        with info^ do
            if RoiShowing and ((RoiType = FreeLineRoi) or (RoiType = SegLineRoi)) then begin
                    PutMessage('Profiling currently only works with straight lines.');
                    exit(PlotDensityProfile);
                end;
        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
                            width := MaxLine;
                        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;
                        for i := 0 to width - 1 do
                            PlotData^[i] := sum[i] div height;
                        PlotCount := width;
                        PlotAvg := height;
                        SetupPlot(PlotData^, start, false);
                    end
                else begin
           {Row Aversage Plot}
                        if height > MaxLine then
                            height := MaxLine;
                        for i := 0 to height - 1 do
                            sum[i] := 0;
                        for hloc := left to right - 1 do begin
                                GetColumn(hloc, top, height, PlotData^);
                                for i := 0 to height - 1 do
                                    sum[i] := sum[i] + PlotData^[i];
                            end;
                        for i := 0 to height - 1 do
                            PlotData^[i] := sum[i] div width;
                        PlotCount := height;
                        PlotAvg := width;
                        SetupPlot(PlotData^, start, true);
                    end;
            end; {with}
    end;


    procedure SetScale;
        const
            FirstButtonID = 5;
            LastButtonID = 14;
            KnownDistanceID = 3;
            ScaleID = 16;
            UnitsTextID = 18;
            MagnificationID = 20;
            MeasuredDistanceID = 22;
            AspectRatioID = 25;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveUnitsID: UnitsType;
            KnownDistance, MeasuredDistance, SaveScale, TempScale, CalibratedDistance: extended;
            OldUnitsPerCM, OldScale, SaveUnitsPErCM, SaveRawScale, SaveMagnification, SaveAspectRatio: extended;
            ignore: integer;
            str: str255;
            SaveUnits: string[2];
            isLineSelection: boolean;
    begin
        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
                        GetLoiLength;
                        MeasuredDistance := uLength;
                    end
                else
                    MeasuredDistance := 0.0;
                SaveUnits := units;
                SaveUnitsID := UnitsID;
                SaveRawScale := RawSpatialScale;
                SaveScale := xSpatialScale;
                SaveMagnification := ScaleMagnification;
                SaveAspectRatio := PixelAspectRatio;
                KnownDistance := 0.0;
                OldScale := 0.0;
                mylog := GetNewDialog(10, nil, pointer(-1));
                SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 1);
                SetDReal(MyLog, KnownDistanceID, KnownDistance, 1);
                SelIText(MyLog, KnownDistanceID, 0, 32767);
                SetDReal(MyLog, MagnificationID, ScaleMagnification, 1);
                SetDReal(MyLog, AspectRatioID, PixelAspectRatio, 4);
                if UnitsID = pixels then
                    TempScale := 1.0
                else
                    TempScale := xSpatialScale;
                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 = KnownDistanceID then
                        KnownDistance := GetDReal(MyLog, KnownDistanceID);
                    if item = ScaleID then begin
                            MeasuredDistance := GetDReal(MyLog, ScaleID);
                            KnownDistance := 1;
                            SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 1);
                            SetDReal(MyLog, KnownDistanceID, KnownDistance, 1);
                        end;
                    if item = MagnificationID then begin
                            ScaleMagnification := GetDReal(MyLog, MagnificationID);
                            if ScaleMagnification < 0.0 then begin
                                    beep;
                                    ScaleMagnification := 1.0;
                                end
                            else begin
                                    xSpatialScale := RawSpatialScale * ScaleMagnification;
                                    ySpatialScale := xSpatialScale / PixelAspectRatio;
                                end;
                        end;
                    if item = AspectRatioID then begin
                            PixelAspectRatio := GetDReal(MyLog, AspectRatioID);
                            if PixelAspectRatio <= 0.0 then begin
                                    beep;
                                    PixelAspectRatio := 1.0;
                                end
                            else begin
                                    xSpatialScale := RawSpatialScale * ScaleMagnification;
                                    ySpatialScale := xSpatialScale / PixelAspectRatio;
                                end;
                        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;
                                    xSpatialScale := RawSpatialScale * ScaleMagnification;
                                    ySpatialScale := xSpatialScale / PixelAspectRatio;
                                    OldUnitsPerCM := SaveUnitsPerCM;
                                    OldScale := 0.0;
                                end;
                            if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) then begin
                                    RawSpatialScale := RawSpatialScale * (OldUnitsPerCM / UnitsPerCM);
                                    xSpatialScale := RawSpatialScale * ScaleMagnification;
                                    ySpatialScale := xSpatialScale / PixelAspectRatio;
                                end;
                            if UnitsID = Pixels then
                                KnownDistance := 0.0;
                        end;
                    if (item = KnownDistanceID) or (item = MeasuredDistanceID) or (item = ScaleID) 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 (KnownDistance > 0.0) then begin
                                        RawSpatialScale := MeasuredDistance / KnownDistance;
                                        xSpatialScale := RawSpatialScale * ScaleMagnification;
                                        ySpatialScale := xSpatialScale / PixelAspectRatio;
                                    end;
                            end;
                    if UnitsID = pixels then
                        TempScale := 1.0
                    else
                        TempScale := xSpatialScale;
                    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;
                        xSpatialScale := SaveScale;
                        ScaleMagnification := SaveMagnification;
                        PixelAspectRatio := SaveAspectRatio;
                    end;
                SpatiallyCalibrated := xSpatialScale <> 0.0;
                UpdateTitleBar;
            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 := 60;
        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, 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;
                        DensityCalibrated := 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 := 'Rodbard';
                        end;
                        str2 := concat(' standards to do ', str2, ' fitting.');
                        PutMessage(concat('You need at least ', str1, str2));
                        exit(DoCurveFitting)
                    end;
                DoSimplexFit(nStandards, nCoefficients, XData, YData, Coefficient, residuals);
                DensityCalibrated := true;
                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: 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;
                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 := 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 CopyFunctionToLUT;
        var
            i: integer;
            value: LongInt;
            scale: extended;
    begin
        with info^ do begin
                DisableDensitySlice;
                scale := 65535.0 / (MaxValue - MinValue);
                for i := 0 to 255 do begin
                        value := 65535 - round(scale * (cvalue[i] - MinValue));
                        with cTable[i].rgb do begin
                                red := value;
                                green := value;
                                blue := value;
                            end;
                    end;
                LoadLUT(cTable);
                LutMode := CustomGrayScale;
                SetupPseudocolor;
                UpdateMap
            end;
    end;


    procedure SetupUncalibratedOD;
        var
            i: integer;
    begin
        with info^ do begin
                DensityCalibrated := true;
                ZeroClip := false;
                nCoefficients := 0;
                for i := 1 to 6 do
                    Coefficient[i] := 1.0;
                fit := UncalibratedOD;
                GenerateValues;
                UnitOfMeasure := 'Uncalibrated OD';
                nStandards := 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
                    PutMessage('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;


    procedure Calibrate;
        const
            FirstLevelID = 3;
            FirstStandardID = 23;
            FirstFitID = 63;
            LastFitID = 74;
            UnitOfMeasureID = 75;
            OpenID = 77;
            SaveID = 78;
            CopyID = 81;
            RemoveID = 82;
            InvertID = 83;
        var
            mylog: DialogPtr;
            ignore, item, i, nBadReals: integer;
            str: str255;
            SaveStandards, temp, NewValues: StandardsArray;
            OptionKeyWasDown, CopyFunction, RemoveCalibration: boolean;
    begin
        OptionKeyWasDown := OptionKeyDown;
        SaveStandards := StandardValues;
        CopyFunction := false;
        RemoveCalibration := false;
        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);
                if (fit = SpareFit1) or (fit = SpareFit2) then
                    fit := Poly3;
                SetDialogItem(mylog, FirstFitID + ord(fit), 1);
                if DensityCalibrated 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);
                    if item = CopyID then begin
                            CopyFunction := not CopyFunction;
                            if CopyFunction then
                                RemoveCalibration := false;
                            SetDialogItem(mylog, CopyID, ord(CopyFunction));
                            SetDialogItem(mylog, RemoveID, ord(RemoveCalibration));
                        end;
                    if item = RemoveID then begin
                            RemoveCalibration := not RemoveCalibration;
                            if RemoveCalibration then
                                CopyFunction := false;
                            SetDialogItem(mylog, RemoveID, ord(RemoveCalibration));
                            SetDialogItem(mylog, CopyID, ord(CopyFunction));
                        end;
                    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);
                DisposDialog(mylog);
                if item = cancel then begin
                        StandardValues := SaveStandards;
                        exit(calibrate)
                    end;
                if RemoveCalibration then begin
                        DensityCalibrated := false;
                        for i := 0 to 255 do
                            cvalue[i] := i;
                        UpdateTitleBar;
                        exit(calibrate)
                    end;
                nBadReals := 0;
                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 not DensityCalibrated then
                            beep;
                    end;
                if DensityCalibrated then begin
                        SetupCalibrationPlot;
                        if CopyFunction then
                            CopyFunctionToLUT;
                    end;
                UpdateTitleBar;
            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;
                ShowValues;
                if ResultsWindow <> nil then begin
                        with ListTE^^ do
                            TESetSelect(0, teLength, ListTE);
                        TEDelete(ListTE);
                        UpdateScrollBars;
                    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 := ((LongInt(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);
        InitTextEdit(Monaco, FontSize);
        DrawControls(ResultsWindow);
        WhatToUndo := NothingToUndo;
    end;


    procedure DoMeasurementOptions;
        const
            FirstID = 3;
            LastID = 15;
            RedirectID = 26;
            LabelID = 27;
            OutlineID = 28;
            IgnoreID = 29;
            IncludeHolesID = 30;
            AutoID = 31;
            AdjustID = 32;
            HeadingsID = 33;
            MinID = 17;
            MaxID = 19;
            MaxRegionsID = 25;
            WidthID = 23;
            PrecisionID = 21;
        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;
                        11:
                            mtype := User1M;
                        12:
                            mtype := User2M;
                    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 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 = 17;
            MinID = 4;
            MaxID = 6;
            LinePlotID = 7;
            ScatterPlotID = 8;
            InvertID = 9;
            LabelsID = 10;
            FixedSizeID = 18;
            WidthID = 13;
            HeightID = 14;
            LineWidthID = 16;
        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));
        SetDialogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
        SetDReal(MyLog, MinID, ProfilePlotMin, 2);
        SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
        SetDialogItem(mylog, FixedSizeID, ord(FixedSizePlot));
        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 = FixedScaleID then begin
                    AutoscalePlots := not AutoscalePlots;
                    SetDialogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
                end;
            if item = MinID then begin
                    ProfilePlotMin := GetDReal(MyLog, MinID);
                    AutoscalePlots := false;
                    SetDialogItem(mylog, FixedScaleID, 1);
                end;
            if item = MaxID then begin
                    ProfilePlotMax := GetDReal(MyLog, MaxID);
                    AutoscalePlots := false;
                    SetDialogItem(mylog, FixedScaleID, 1);
                end;
            if item = FixedSizeID then begin
                    FixedSizePlot := not FixedSizePlot;
                    SetDialogItem(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;
                    SetDialogItem(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;
                    SetDialogItem(mylog, FixedSizeID, 1);
                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;
        if LineWidth <> SaveLineWidth then
            UpdateRoiLineWidth;
        if ProfilePlotMax <= ProfilePlotMin then begin
                beep;
                ProfilePlotMin := SaveMin;
                ProfilePlotMax := SaveMax;
            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 SpatiallyCalibrated then
                    mArea^[mCount] := 1 / xSpatialScale * ySpatialScale
                else
                    mArea^[mCount] := 1;
                mean^[mCount] := cvalue[MyGetPixel(hloc, vloc)];
                with info^ do
                    if SpatiallyCalibrated then begin
                            xcenter^[mCount] := hloc / xSpatialScale;
                            ycenter^[mCount] := y / ySpatialScale;
                        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);
                PaintOval(r);
                UpdateScreen(r);
                if ControlKeyDown then
                    with info^ do begin
                            if SpatiallyCalibrated then begin
                                    RealToString(hloc / xSpatialScale, 1, Precision, str1);
                                    RealToString(y / ySpatialScale, 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;
        ValuesMessage := '';
        ShowValues;
        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;

    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;
        ValuesMessage := '';
        ShowValues;
        AppendResults;
        if nAngles = 1 then
            UpdateList;
        repeat
        until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
        WhatToUndo := UndoEdit;
    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
            ShowValues;
    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, hold, vold, index: integer;
            sqrt2, diagonal: extended;
            Saveport: GrafPtr;
            FindPerimeter, NonSquarePixels: boolean;
            direction, NewDirection: char;
            table: string[16];
            UL, UR, LL, LR, CuttingCorner: boolean;
            TempRgn: RgnHandle;
    begin
        TouchingEdge := false;
        table := 'XRDRUUuULlDRLLDX';
        GetPort(SavePort);
        SetPort(GrafPtr(info^.osPort));
        if SelectionMode <> NewSelection then
            TempRgn := NewRgn;
        with info^ do begin
                uLength := 0.0;
                cLength := 0.0;
                FindPerimeter := not MakingLOI and ((LengthM in measurements) or (nLengths > 0) or WandAdjustAreas);
                if FindPerimeter then begin
                        sqrt2 := sqrt(2.0);
                        CuttingCorner := false;
                    end;
                NonSquarePixels := SpatiallyCalibrated and (PixelAspectRatio <> 1.0);
                if NonSquarePixels then
                    diagonal := sqrt(sqr(1.0 / xSpatialScale) + sqr(1.0 / ySpatialScale));
                count := 1;
                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);
                if CurrentTool = wand then begin
                        xCoordinates^[1] := hstart;
                        yCoordinates^[1] := vstart;
                        nCoordinates := 1;
                    end;
                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
                                        uLength := uLength + 1
                                    else begin
                                            uLength := uLength + sqrt2;
                                            CuttingCorner := true;
                                        end;
                                    if NonSquarePixels then begin
                                            if NewDirection = direction then
                                                case NewDirection of
                                                    'L', 'R':
                                                        cLength := cLength + 1.0 / xSpatialScale;
                                                    'U', 'D':
                                                        cLength := cLength + 1.0 / ySpatialScale;
                                                end
                                            else
                                                cLength := cLength + diagonal;
                                        end; {NonSquarePixels}
                                end;
                        end;
                    LineTo(hloc, vloc);
                    if CurrentTool = wand then begin
                            xCoordinates^[count] := hloc;
                            yCoordinates^[count] := vloc;
                            nCoordinates := count;
                        end;
                    hold := hloc;
                    vold := vloc;
                    direction := NewDirection;
                until ((hloc = hstart) and (vloc = vstart) and (direction = StartingDirection)) or (count >= MaxCoordinates);
                if SelectionMode <> NewSelection then
                    CloseRgn(TempRgn)
                else
                    CloseRgn(roiRgn);
                if count >= MaxCoordinates then begin
                        SetEmptyRgn(roiRgn);
                        SetPort(SavePort);
                        TraceEdge := false;
                        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 := RgnRoi;
                if SelectionMode = SubSelection then
                    UpdateScreen(RoiRect);
                RoiRect := roiRgn^^.rgnBBox;
                if FindPerimeter and (not NonSquarePixels) then begin
                        cLength := uLength;
                        if SpatiallyCalibrated then
                            cLength := cLength / xSpatialScale;
                    end;
            end; {with info}
        if SelectionMode <> NewSelection then
            DisposeRgn(TempRgn);
        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 SpatiallyCalibrated then begin
                                        xc := xc * xSpatialScale;
                                        yc := yc * ySpatialScale;
                                    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
            SaveRoiRect: rect;
    begin
        with info^ do begin
                SaveRoiRect := RoiRect;
                RoiRect := PicRect;
                GetRectHistogram;
                BinaryPic := (histogram[0] + histogram[255]) = LongInt(PixelsPerLine) * nLines;
                isBinaryImage := BinaryPic;
                RoiRect := SaveRoiRect;
            end;
    end;


    function SetupAutoOutline (BinaryPixel: boolean): boolean;
    begin
        SetupAutoOutline := false;
        FindThresholdingMode;
        if ThresholdingMode = NoThresholding then
            if isBinaryImage or BinaryPixel 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;
        if not MakingLOI then
            ShowWatch;
        SetupAutoOutline := true;
    end;


    procedure AutoOutline (start: point);
        var
            hloc, vloc: integer;
            TouchingEdge, BinaryPixel: boolean;
            direction: char;
            count: LongInt;
    begin
        ScreenToOffscreen(start);
        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);
                            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, direction, TouchingEdge) then begin
                        WhatToUndo := NothingToUndo;
                        if WandAutoMeasure and not MakingLOI then begin
                                GetNonRectHistogram;
                                ComputeResults;
                                if WandAdjustAreas then begin
                                        count := PixelCount^[mCount] + round(pLength^[mCount]);
                                        PixelCount^[mCount] := count;
                                        if SpatiallyCalibrated then
                                            mArea^[mCount] := count / (xSpatialScale * ySpatialScale)
                                        else
                                            mArea^[mCount] := count;
                                    end;
                                ShowValues;
                                AppendResults;
                                WhatToUndo := UndoMeasurement;
                                if LabelParticles then
                                    MarkSelection(mCount);
                            end;
                        if not (WandAutoMeasure and LabelParticles) then
                            RoiShowing := true;
                        if not MakingLOI then
                            UpdateScreen(RoiRect);
                    end; {if}
            end; {with info}
    end;


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


    procedure DeleteMeasurement;
        var
            nToDelete, i: integer;
            Canceled: boolean;
    begin
        nToDelete := GetInt('Measurent 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;


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

        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 NotInBounds or NoUndo then
                    exit(AnalyzeParticles);
                if not SetupAutoOutline(false) then
                    exit(AnalyzeParticles);
                StopDigitizing;
                if RedirectSampling then begin
                        SetupRedirectedSampling;
                        if InfoForRedirect = nil then
                            exit(AnalyzeParticles)
                    end;
                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 UnsavedResults then begin
                        ResetCounter;
                        if UnsavedResults then
                            exit(AnalyzeParticles);
                        UpdatePicWindow;
                    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));
                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 < MaxRegions then begin
                                                        GetNonRectHistogram;
                                                        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);
                                                    end
                                                else begin
                                                        if DrawOutlines then begin
                                                                SetForegroundColor(OutlineIndex);
                                                                FrameRgn(roiRgn);
                                                            end;
                                                        UpdateScreen(RoiRect);
                                                        if nParticles <= MaxRegions then begin
                                                                ShowValues;
                                                                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;
                                                                DisposeRgn(dstRgn);
                                                                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;
        DisposeRgn(dstRgn);
    end;

end.