home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-04-20 | 71.9 KB | 2,154 lines | [ TEXT/PJMM]
unit Analysis; {Analysis routines used by the NIH Image} interface uses QuickDraw, Palettes, PrintTraps, globals, Utilities, LeastSquares, Graphics, file1, file2, Ellipse, Lut; procedure DoHistogram; procedure GetRectHistogram; procedure GetHistogram; procedure ShowContinuousHistogram; procedure ComputeResults; procedure FindThresholdingMode; procedure Measure; procedure UpdateRoiLineWidth; procedure DoProfilePlotOptions; procedure ShowResults; procedure PlotDensityProfile; procedure SetScale; procedure Calibrate; procedure ResetCounter; procedure DoMeasurementOptions; procedure DoPoints (event: EventRecord); procedure FindAngle (event: EventRecord); procedure SaveBlankField; procedure UndoLastMeasurement (DisplayResults: boolean); procedure MarkSelection (count: integer); procedure AutoOutline (start: point); procedure RedoMeasurement; procedure DeleteMeasurement; procedure AnalyzeParticles; procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType); function isBinaryImage: boolean; implementation const UnitsPopUpID = 6; var WandMode: (LUTMode, GrayMapMode, BinaryMode); GrayMapThreshold: integer; InfoForRedirect: InfoPtr; UnitsKind: UnitsType; {$PUSH} {$D-} procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt); {} {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); 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; 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 GetHistogram; var MaskLine, DataLine: LineType; width, i, vloc: integer; sum, sum2, count, OverFlows: LongInt; SaveInfo: InfoPtr; value: LongInt; trect: rect; begin if TooWide then exit(GetHistogram); ShowWatch; if RedirectSampling then 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; {$POP} procedure ComputeResults; var MaxCount, icount, isum, n: LongInt; i: integer; sum, sum2, ri, rcount, tSD, rmode, xc, yc: extended; Major, Minor, EllipseAngle, hcenter, vcenter, calValue: extended; MinCalibratedValue, MaxCalibratedValue, CalibratedMean: extended; IgnoreThresholding: boolean; ulength, clength: real; begin with info^, results do begin case ThresholdingMode of DensitySlice: begin MinIndex := SliceStart; MaxIndex := SliceEnd; end; GrayMapThresholding: begin MinIndex := GrayMapThreshold; MaxIndex := 255; end; BinaryImage: begin MinIndex := BlackIndex; MaxIndex := BlackIndex; end; NoThresholding: begin MinIndex := 0; MaxIndex := 255; end; end; IgnoreThresholding := RedirectSampling or (IncludeHoles and (AnalyzingParticles or (CurrentTool = Wand))); if IgnoreThresholding then begin MinIndex := 0; MaxIndex := 255; end; while (histogram[MinIndex] = 0) and (MinIndex < 255) do MinIndex := MinIndex + 1; while (histogram[MaxIndex] = 0) and (MaxIndex > 0) do MaxIndex := MaxIndex - 1; MaxCount := 0; sum := 0.0; isum := 0; sum2 := 0.0; n := 0; minCalibratedValue := 10e100; maxCalibratedValue := -10e100; rmode := 0.0; imode := 0; for i := MinIndex to MaxIndex do begin calValue := cvalue[i]; 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 minCalibratedValue := 0.0; maxCalibratedValue := 0.0; end; if n > 0 then begin CalibratedMean := sum / n; UncalibratedMean := isum / n end else begin CalibratedMean := 0.0; UncalibratedMean := 0.0 end; IncrementCounter; mean^[mCount] := CalibratedMean; mMin^[mCount] := minCalibratedValue; mMax^[mCount] := maxCalibratedValue; if mCount <= MaxStandards then umean[mCount] := UncalibratedMean; if (n > 0) and (CalibratedMean > 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; ulength := 0.0; clength := 0.0; with RoiRect do case RoiType of RectRoi: begin uLength := ((right - left) + (bottom - top)) * 2.0; cLength := uLength; if SpatiallyCalibrated then cLength := ((right - left) / 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 GetLengthOrPerimeter(ulength, clength); nLengths := nLengths + 1; end; PolygonRoi, FreehandRoi: if (LengthM in Measurements) or (nLengths > 0) or WandAdjustAreas then GetLengthOrPerimeter(ulength, clength); otherwise end; if SpatiallyCalibrated then plength^[mCount] := cLength else plength^[mcount] := uLength; if SpatiallyCalibrated then mArea^[mCount] := n / (xSpatialScale * ySpatialScale) else mArea^[mCount] := n; mode^[mCount] := rmode; if FitEllipse and ((RoiType = PolygonRoi) or (RoiType = FreehandRoi) 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; InfoMessage := ''; end; {$PUSH} {$D-} procedure FindThresholdingMode; begin with info^ do begin if DensitySlicing then ThresholdingMode := DensitySlice else if thresholding then begin ThresholdingMode := GrayMapThresholding; GrayMapThreshold := ColorStart; if GrayMapThreshold < 0 then GrayMapThreshold := 0; if GrayMapThreshold > 255 then GrayMapThreshold := 255; end else if BinaryPic then ThresholdingMode := BinaryImage else ThresholdingMode := NoThresholding; end; end; procedure Measure; var AutoSelectAll: boolean; SaveN: integer; begin if NotInBounds then exit(Measure); with info^ do begin FindThresholdingMode; if ThresholdingMode = BinaryImage then ThresholdingMode := NoThresholding; AutoSelectAll := not RoiShowing; if AutoSelectAll then SelectAll(false); if (RoiType = RectRoi) and (not RedirectSampling) then GetRectHistogram else GetHistogram; if MeasurementToRedo > 0 then begin SaveN := mCount; mCount := MeasurementToRedo - 1; ComputeResults; ShowInfo; mCount := SaveN; MeasurementToRedo := 0; UpdateList; end else begin ComputeResults; ShowInfo; AppendResults; if RoiType = LineRoi then if nLengths = 1 then if not (LengthM in Measurements) then UpdateList; end; RoiShowing := true; WhatToUndo := UndoMeasurement; if AutoSelectAll then KillRoi; UpdateScreen(OldRoiRect); end; end; procedure ShowHistogram; var htop: integer; tport: GrafPtr; hrect, prect, srect: rect; FirstTime: boolean; begin GetPort(tPort); FirstTime := HistoWindow = nil; if FirstTime then begin htop := ScreenHeight - hheight - 10; SetRect(HistoRect, hleft, htop, hleft + hwidth, htop + hheight); HistoWindow := NewWindow(nil, HistoRect, 'Histogram', true, NoGrowDocProc, nil, true, 0); WindowPeek(HistoWindow)^.WindowKind := HistoKind; end; if FirstTime or (VideoControl = nil) then SelectWindow(HistoWindow); SetPort(HistoWindow); InvalRect(HistoWindow^.PortRect); SetPort(tPort); end; procedure ShowContinuousHistogram; const skip = 10; var i, NumberOfLines: integer; offset: LongInt; p: ptr; begin for i := 0 to 255 do Histogram[i] := 0; p := ptr(ptr(fgSlotBase)); NumberOfLines := ((fgHeight) div skip) - 1; offset := fgRowBytes * skip; for i := 1 to NumberOfLines do begin DoHistogramOfLine(p, histogram, fgWidth); p := ptr(ord4(p) + offset); end; ThresholdingMode := NoThresholding; HistogramSliceStart := 0; HistogramSliceEnd := 255; ComputeResults; ShowHistogram; end; procedure DoHistogram; var AutoSelectAll: boolean; begin if NotInBounds then exit(DoHistogram); if digitizing then begin if ContinuousHistogram then ContinuousHistogram := false else begin ContinuousHistogram := true; if info <> NoInfo then with info^ do begin RoiType := NoRoi; RoiRect := SrcRect; end; end; exit(DoHistogram) end; AutoSelectAll := not info^.RoiShowing; if AutoSelectAll then SelectAll(false); if (info^.RoiType = RectRoi) and (not RedirectSampling) then GetRectHistogram else GetHistogram; ThresholdingMode := NoThresholding; ComputeResults; ShowCount := false; ShowInfo; ShowCount := true; FindThresholdingMode; case ThresholdingMode of DensitySlice: begin HistogramSliceStart := SliceStart; HistogramSliceEnd := SliceEnd; end; GrayMapThresholding: begin HistogramSliceStart := GrayMapThreshold; HistogramSliceEnd := 255; end; BinaryImage, NoThresholding: begin HistogramSliceStart := 0; HistogramSliceEnd := 255; end; end; ShowHistogram; UndoLastMeasurement(false); WhatToUndo := NothingToUndo; if AutoSelectAll then KillRoi; end; {$POP} procedure PlotDensityProfile; var hloc, vloc, value, width, height, i: integer; aLine: LineType; sum: array[0..MaxLine] of real; start, p1, p2: point; begin with info^ do if RoiShowing then case RoiType of LineRoi: begin PlotLineProfile; exit(PlotDensityProfile); end; FreeLineRoi, SegLineRoi, PolygonRoi, FreehandRoi: begin PlotArbitraryLine; exit(PlotDensityProfile); end; end; {case} if NoSelection or NotRectangular or NotInBounds then exit(PlotDensityProfile); ShowWatch; with info^.RoiRect do begin width := right - left; height := bottom - top; start.h := left; start.v := bottom; if (width >= height) or (OptionKeyWasDown) then begin {Column Average Plot} if width > MaxLine then width := MaxLine; for i := 0 to width - 1 do sum[i] := 0.0; for vloc := top to bottom - 1 do begin GetLine(left, vloc, width, aLine); for i := 0 to width - 1 do sum[i] := sum[i] + cvalue[aLine[i]]; end; for i := 0 to width - 1 do PlotData^[i] := sum[i] / height; PlotCount := width; PlotAvg := height; PlotStart.h := left; PlotStart.v := top + (bottom - top) div 2; PlotAngle := 0.0; ComputePlotMinAndMax; if ShowPlot then SetupPlot(start, false); end else begin {Row Average Plot} if height > MaxLine then height := MaxLine; for i := 0 to height - 1 do sum[i] := 0.0; for hloc := left to right - 1 do begin GetColumn(hloc, top, height, aLine); for i := 0 to height - 1 do sum[i] := sum[i] + cValue[aLine[i]]; end; for i := 0 to height - 1 do PlotData^[i] := sum[i] / width; PlotCount := height; PlotAvg := width; PlotStart.h := left + (right - left) div 2; PlotStart.v := top; PlotAngle := 270.0; ComputePlotMinAndMax; if ShowPlot then SetupPlot(start, true); end; end; {with} end; procedure SetScaleUProc (d: DialogPtr; item: integer); {User proc for Set Scale dialog box} var str: str255; VersInfo: str255; r: rect; begin SetPort(d); GetDItemRect(d, item, r); DrawDropBox(r); GetItem(UnitsMenuH, ord(UnitsKind) + 1, str); DrawPopUpText(str, r); end; procedure SetScale; const MeasuredDistanceID = 3; KnownDistanceID = 4; AspectRatioID = 5; ScaleID = 7; UnitsTextID = 8; var mylog: DialogPtr; item, i: integer; SaveUnitsKind, OldUnitsKind, MenuUnitsKind: UnitsType; KnownDistance, MeasuredDistance, SaveScale, TempScale, CalibratedDistance: double; UnitsPerCM, OldUnitsPerCM, SaveRawScale, SaveAspectRatio: double; ignore, MenuItem: integer; str: str255; SaveUnits: UnitType; isLineSelection: boolean; ulength, clength: real; r: rect; 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 GetLengthOrPerimeter(ulength, clength); MeasuredDistance := ulength; end else MeasuredDistance := 0.0; if not SpatiallyCalibrated then xUnit := 'pixel'; GetUnitsKind(UnitsKind, UnitsPerCM); SaveUnits := xUnit; SaveUnitsKind := UnitsKind; SaveScale := xSpatialScale; SaveAspectRatio := PixelAspectRatio; KnownDistance := 0.0; mylog := GetNewDialog(10, nil, pointer(-1)); SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2); SetDReal(MyLog, KnownDistanceID, KnownDistance, 2); SelIText(MyLog, KnownDistanceID, 0, 32767); SetDReal(MyLog, AspectRatioID, PixelAspectRatio, 4); SetUProc(myLog, UnitsPopupID, @SetScaleUProc); if UnitsKind = pixels then TempScale := 1.0 else TempScale := xSpatialScale; if trunc(TempScale) = TempScale then SetDReal(MyLog, ScaleID, TempScale, 0) else SetDReal(MyLog, ScaleID, TempScale, 5); SetDString(MyLog, UnitsTextID, xUnit); setport(myLog); repeat ModalDialog(nil, item); if item = MeasuredDistanceID then MeasuredDistance := GetDReal(MyLog, MeasuredDistanceID); if item = KnownDistanceID then KnownDistance := GetDReal(MyLog, KnownDistanceID); if item = ScaleID then begin MeasuredDistance := GetDReal(MyLog, ScaleID); KnownDistance := 1; SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2); SetDReal(MyLog, KnownDistanceID, KnownDistance, 2); end; if item = AspectRatioID then begin PixelAspectRatio := GetDReal(MyLog, AspectRatioID); if PixelAspectRatio <= 0.0 then begin beep; PixelAspectRatio := 1.0; end else ySpatialScale := xSpatialScale / PixelAspectRatio; end; if item = UnitsPopUpID then begin OldUnitsKind := UnitsKind; OldUnitsPerCM := UnitsPerCM; GetDItemRect(myLog, item, r); InvertRect(r); MenuItem := PopUpMenu(UnitsMenuH, r.left, r.top, ord(UnitsKind) + 1); InvertRect(r); GetItem(UnitsMenuH, MenuItem, str); DrawPopUpText(str, r); UnitsKind := UnitsType(MenuItem - 1); GetXUnits(UnitsKind); if (UnitsType(MenuItem - 1) = OtherUnits) and (OldUnitsKind <> OtherUnits) then xUnit := 'unit'; SetDString(MyLog, UnitsTextID, xUnit); GetUnitsKind(UnitsKind, UnitsPerCM); if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) and (OldUnitsPerCM <> 0.0) then begin xSpatialScale := xSpatialScale * (OldUnitsPerCM / UnitsPerCM); ySpatialScale := xSpatialScale / PixelAspectRatio; end; if UnitsKind = Pixels then KnownDistance := 0.0; end; if (item = KnownDistanceID) or (item = MeasuredDistanceID) or (item = ScaleID) then if (UnitsKind = Pixels) and (item <> cancel) then PutMessage('Please select a measurent unit (not pixels) before setting or changing the scale.') else begin if (MeasuredDistance > 0.0) and (KnownDistance > 0.0) then begin xSpatialScale := MeasuredDistance / KnownDistance; ySpatialScale := xSpatialScale / PixelAspectRatio; end; end; if UnitsKind = pixels then TempScale := 1.0 else TempScale := xSpatialScale; if item <> ScaleID then begin if (trunc(TempScale) = TempScale) or (TempScale >= 10000.0) then SetDReal(MyLog, ScaleID, TempScale, 0) else if TempScale < 0.01 then SetDReal(MyLog, ScaleID, TempScale, 6) else SetDReal(MyLog, ScaleID, TempScale, 3); end; if item = UnitsTextID then begin xUnit := GetDString(myLog, item); GetUnitsKind(UnitsKind, UnitsPerCM); GetDItemRect(myLog, UnitsPopUpID, r); InvalRect(r); end; until (item = ok) or (item = cancel); DisposDialog(mylog); if item = cancel then begin xUnit := SaveUnits; UnitsKind := SaveUnitsKind; xSpatialScale := SaveScale; PixelAspectRatio := SaveAspectRatio; end else Changes := true; SpatiallyCalibrated := (xSpatialScale <> 0.0) and (xUnit <> 'pixel'); if not SpatiallyCalibrated then begin UnitsKind := Pixels; UnitsPerCm := 0.0; end; UpdateTitleBar; end; {with info^} end; {$PUSH} {$D-} procedure SetupCalibrationPlot; const hrange = 1024; hmax = 1023; vrange = 600; vmax = 599; SymbolSize = 11; var fRect, tRect: rect; svalue, range, hscale, vscale, MinV, MaxV: extended; tPort: GrafPtr; i, hloc, vloc: integer; SaveClipRegion: RgnHandle; pt: point; begin PlotLeftMargin := 60; PlotTopMargin := 15; PlotBottomMargin := 30; PlotRightMargin := 100; MinV := 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); if PlotWindow = nil then exit(SetupCalibrationPlot); WindowPeek(PlotWindow)^.WindowKind := CalibrationPlotKind; SetRect(fRect, -SymbolSize, -SymbolSize, hmax + SymbolSize, vmax + SymbolSize); GetPort(tPort); SetPort(PlotWindow); SaveClipRegion := PlotWindow^.ClipRgn; RectRgn(PlotWindow^.ClipRgn, fRect); hscale := 256 / 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: RealLine; begin RefNum := 0; if not GetTextFile(fname, RefNum) then exit(GetStandardsFromFile); InitTextInput(fname, RefNum); GetLineFromText(rLine, nValues); if nValues = 1 then nColumns := 1 else nColumns := 2; if (nStandards = 0) and (nColumns = 2) then begin i := 0; repeat i := i + 1; if i > MaxStandards then i := MaxStandards; umean[i] := rLine[1]; SetDReal(MyLog, FirstLevelID + i - 1, umean[i], 2); StandardValues[i] := rLine[2]; SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 3); GetLineFromText(rLine, nValues); until nValues = 0; nStandards := i; mCount := nStandards; for i := 1 to mCount do begin ClearResults(i); mean^[i] := umean[i]; end; end else for i := 1 to nStandards do begin if nValues = nColumns then begin StandardValues[i] := rLine[nColumns]; SetDReal(MyLog, FirststandardID + i - 1, StandardValues[i], 3); end; GetLineFromText(rLine, nValues); end; InitCursor; end; procedure SaveStandardsToFile (nStandards: integer); var where: Point; reply: SFReply; i: integer; OptionKeyWasDown: boolean; begin OptionKeyWasDown := OptionKeyDown; where.v := 60; where.h := 100; SFPutFile(Where, 'Save Calibration as?', 'Standards', nil, reply); if reply.good then begin TextBufSize := 0; for i := 1 to nStandards do begin PutReal(umean[i], 1, 3); PutChar(tab); if StandardValues[i] >= 100.0 then PutReal(StandardValues[i], 1, 3) else PutReal(StandardValues[i], 1, 5); if i <> nStandards then PutChar(cr); end; with reply do SaveAsText(fname, vRefNum); end; InitCursor; end; procedure 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 := 'U. 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)); 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; ShowInfo; if ResultsWindow <> nil then begin with ListTE^^ do TESetSelect(0, teLength, ListTE); TEDelete(ListTE); UpdateResultsScrollBars; end; end; measuring := false; end; procedure ShowResults; const FontSize = 9; var wrect, crect, trect: rect; loc: point; begin mCount2 := mCount; if ResultsWindow <> nil then begin SelectWindow(ResultsWindow); exit(ShowResults); end; CopyResultsToBuffer(1, mCount, true); ShowMessage(''); ResultsWidth := 110 + round(nListColumns * FieldWidth * 6.5); if ResultsWidth < 250 then ResultsWidth := 250; if (ResultsWidth + 20) > ScreenWidth then ResultsWidth := ScreenWidth - 20; ResultsHeight := ((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); InitResultsTextEdit(Monaco, FontSize); DrawControls(ResultsWindow); WhatToUndo := NothingToUndo; end; procedure DoMeasurementOptions; const FirstID = 3; LastID = 15; RedirectID = 22; IncludeHolesID = 23; AutoID = 24; AdjustID = 25; HeadingsID = 26; MaxMeasurementsID = 21; WidthID = 19; PrecisionID = 17; var mylog: DialogPtr; item, i, SavePrecision, SaveMaxMeasurements, SaveWidth: integer; mtype: MeasurementTypes; SaveMeasurements: set of MeasurementTypes; SaveRedirect: boolean; SaveAuto, SaveAdjust, SaveHeadings: boolean; begin InitCursor; if nPoints > 0 then Measurements := Measurements + [XYLocM]; if nLengths > 0 then Measurements := Measurements + [LengthM]; if nAngles > 0 then Measurements := Measurements + [AngleM]; SaveMeasurements := measurements; SaveRedirect := RedirectSampling; SaveWidth := FieldWidth; SavePrecision := precision; SaveAuto := WandAutoMeasure; SaveAdjust := WandAdjustAreas; SaveMaxMeasurements := MaxMeasurements; SaveHeadings := ShowHeadings; mylog := GetNewDialog(4000, nil, pointer(-1)); mtype := AreaM; for i := FirstID to LastID do begin if mtype in measurements then SetDialogItem(mylog, i, 1); if i <> LastID then mtype := succ(mtype); end; SetDialogItem(mylog, RedirectID, ord(RedirectSampling)); SetDialogItem(mylog, IncludeHolesID, ord(IncludeHoles)); SetDialogItem(mylog, AutoID, ord(WandAutoMeasure)); SetDialogItem(mylog, AdjustID, ord(WandAdjustAreas)); SetDialogItem(mylog, HeadingsID, ord(ShowHeadings)); SetDNum(MyLog, MaxMeasurementsID, MaxMeasurements); SetDNum(MyLog, WidthID, FieldWidth); SetDNum(MyLog, PrecisionID, precision); repeat ModalDialog(nil, item); if (item >= FirstID) and (item <= LastID) then begin i := item - FirstID; case i of 0: mtype := AreaM; 1: mtype := MeanM; 2: mtype := StdDevM; 3: mtype := xyLocM; 4: mtype := ModeM; 5: mtype := LengthM; 6: mtype := MajorAxisM; 7: mtype := MinorAxisM; 8: mtype := AngleM; 9: mtype := IntDenM; 10: mtype := MinMaxM; 11: mtype := User1M; 12: mtype := User2M; end; if mtype in measurements then begin measurements := measurements - [mtype]; 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 = 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 = WidthID then FieldWidth := GetDNum(MyLog, WidthID); if item = PrecisionID then precision := GetDNum(MyLog, PrecisionID); if item = MaxMeasurementsID then MaxMeasurements := GetDNum(MyLog, MaxMeasurementsID); until (item = ok) or (item = cancel); DisposDialog(mylog); if (FieldWidth < 1) or (FieldWidth > 18) then begin FieldWidth := SaveWidth; beep; end; if (precision < 0) or (precision > 8) then begin precision := SavePrecision; beep; end; if (MaxMeasurements < 1) or (MaxMeasurements > MaxMaxRegions) then begin MaxMeasurements := SaveMaxMeasurements; beep; end; if item = cancel then begin measurements := SaveMeasurements; RedirectSampling := SaveRedirect; FieldWidth := SaveWidth; precision := SavePrecision; WandAutoMeasure := SaveAuto; WandAdjustAreas := SaveAdjust; MaxMeasurements := SaveMaxMeasurements; ShowHeadings := SaveHeadings; end; if not (XYLocM in Measurements) then nPoints := 0; if not (LengthM in Measurements) then nLengths := 0; if not (AngleM in Measurements) then nAngles := 0; UpdateFitEllipse; if MaxMeasurements <> SaveMaxMeasurements then 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 UpdateRoiLineWidth; begin with info^, info^.RoiRect do if RoiShowing and (RoiType = LineRoi) then begin LX1 := left + LX1; LY1 := top + LY1; LX2 := left + LX2; LY2 := top + LY2; MakeRegion; end; end; procedure DoProfilePlotOptions; const FixedScaleID = 7; MinID = 8; MaxID = 9; FixedSizeID = 10; WidthID = 11; HeightID = 12; LineWidthID = 13; LinePlotID = 14; ScatterPlotID = 15; InvertID = 16; LabelsID = 17; var mylog: DialogPtr; item, i: integer; SaveAutoscale, SaveLinePlot, SaveInvert, SaveDrawLabels, SaveFixedSize: boolean; SaveWidth, SaveHeight, SaveLineWidth, SaveLineIndex: integer; SaveMin, SaveMax: extended; begin InitCursor; SaveAutoscale := AutoscalePlots; SaveLinePlot := LinePlot; SaveInvert := InvertPlots; SaveMin := ProfilePlotMin; SaveMax := ProfilePlotMax; SaveLineWidth := LineWidth; SaveLineIndex := LineIndex; SaveWidth := ProfilePlotWidth; SaveHeight := ProfilePlotHeight; SaveDrawLabels := DrawPlotLabels; mylog := GetNewDialog(5000, nil, pointer(-1)); 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); 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 ProfilePlotWidth := SaveWidth; ProfilePlotHeight := SaveHeight; AutoscalePlots := SaveAutoscale; LinePlot := SaveLinePlot; InvertPlots := SaveInvert; ProfilePlotMin := SaveMin; ProfilePlotMax := SaveMax; DrawPlotLabels := SaveDrawLabels; LineWidth := SaveLineWidth; if LineIndex <> SaveLineIndex then begin LineIndex := SaveLineIndex; DrawTools; end; end; if LineWidth <> SaveLineWidth then UpdateRoiLineWidth; if ProfilePlotMax <= ProfilePlotMin then begin 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; Decrement: boolean; SaveGDevice: GDHandle; begin Decrement := false; SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(info^.osPort)); pmForeColor(ForegroundIndex); loc := event.where; ScreenToOffscreen(loc); with loc do begin hloc := h; vloc := v; end; with results, Info^ do begin nPoints := nPoints + 1; IncrementCounter; if InvertYCoordinates then y := info^.PicRect.bottom - vloc - 1 else y := vloc; ClearResults(mCount); PixelCount^[mCount] := 1; if SpatiallyCalibrated then mArea^[mCount] := 1 / 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); if ShiftKeyDown then begin Decrement := true; EraseOval(r); mcount := mcount - 2; if mcount <= 0 then begin mcount := 0; UnsavedResults := false; end; nPoints := nPoints - 2; if nPoints < 0 then nPoints := 0; end else PaintOval(r); UpdateScreen(r); if ControlKeyDown then with info^ do begin if SpatiallyCalibrated then begin RealToString(hloc / 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; SetGDevice(SaveGDevice); InfoMessage := ''; ShowInfo; if Decrement then begin DeleteLines(mcount + 1, mcount + 1); WhatToUndo := NothingToUndo; end else begin AppendResults; if (nPoints = 1) then if not (XYlocM in Measurements) then UpdateList; measuring := true; WhatToUndo := UndoPoint; end; end; procedure FindAngle (event: EventRecord); var start, finish, OldFinish, MidPoint, first: point; ticks: LongInt; x1, y1, x2, y2: integer; angle, angle1, angle2: real; StartRect: rect; FirstLineDone: boolean; begin DrawLabels('Angle:', '', ''); FlushEvents(EveryEvent, 0); start := event.where; Pt2Rect(start, start, StartRect); InsetRect(StartRect, -2, -2); finish := start; SetPort(info^.wptr); PenNormal; PenMode(PatXor); PenSize(1, 1); MoveTo(start.h, start.v); first := start; repeat repeat OldFinish := finish; GetMouse(finish); MoveTo(start.h, start.v); LineTo(OldFinish.h, OldFinish.v); MoveTo(start.h, start.v); LineTo(finish.h, finish.v); ticks := TickCount; while ticks = TickCount do ; x1 := finish.h - start.h; y1 := start.v - finish.v; GetAngle(x1, y1, angle1); Show1Value(angle1, NoValue); until GetNextEvent(mUpMask, event); FirstLineDone := not PtInRect(finish, StartRect); if not FirstLineDone then start := finish; until FirstLineDone; MidPoint := finish; x1 := start.h - MidPoint.h; y1 := MidPoint.v - start.v; GetAngle(x1, y1, angle1); start := finish; finish := start; repeat OldFinish := finish; GetMouse(finish); MoveTo(start.h, start.v); LineTo(OldFinish.h, OldFinish.v); MoveTo(start.h, start.v); LineTo(finish.h, finish.v); ticks := TickCount; while ticks = TickCount do right pixel, 3=Lower left pixel, 4=Lower right pixel} var count, hloc, vloc, hold, vold, index, SaveBackground: integer; Saveport: GrafPtr; direction, NewDirection: char; table: string[16]; UL, UR, LL, LR, SaveCoordinates: boolean; TempRgn: RgnHandle; begin TouchingEdge := false; table := 'XRDRUUuULlDRLLDX'; GetPort(SavePort); SetPort(GrafPtr(info^.osPort)); if SelectionMode <> NewSelection then TempRgn := NewRgn; with info^ do begin SaveBackground := BackgroundIndex; {We want MyGetPixel to always return 0} BackgroundIndex := WhiteIndex; {for coordinates beyond the edge of the image.} PenNormal; OpenRgn; direction := StartingDirection; hloc := hstart; vloc := vstart; UL := PixelInside(hloc - 1, vloc - 1); UR := PixelInside(hloc, vloc - 1); LL := PixelInside(hloc - 1, vloc); LR := PixelInside(hloc, vloc); hold := hstart; vold := vstart; MoveTo(hstart, vstart); count := 0; SaveCoordinates := ((CurrentTool = wand) or (LengthM in Measurements)) and (not MakingLOI); if SaveCoordinates then begin xCoordinates^[1] := hstart; yCoordinates^[1] := vstart; count := 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; LineTo(hloc, vloc); if SaveCoordinates then begin xCoordinates^[count] := hloc; yCoordinates^[count] := vloc; 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; BackgroundIndex := SaveBackground; nCoordinates := 0; 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 := FreehandRoi; if SelectionMode = SubSelection then UpdateScreen(RoiRect); RoiRect := roiRgn^^.rgnBBox; BackgroundIndex := SaveBackground; end; {with info} if SelectionMode <> NewSelection then DisposeRgn(TempRgn); SetPort(SavePort); if SaveCoordinates then begin nCoordinates := count - 1; if CurrentTool = wand then MakeCoordinatesRelative; end; TraceEdge := t end; if TraceEdge(start.h, start.v, direction, TouchingEdge) then begin WhatToUndo := NothingToUndo; if WandAutoMeasure and not MakingLOI then begin GetHistogram; ComputeResults; if WandAdjustAreas then begin GetLengthOrPerimeter(Perimeter, CalibratedPerimeter); with RoiRect do AspectRatio := (right - left) / (bottom - top); count := PixelCount^[mCount] + round(Perimeter / 2.0 + AspectRatio * 1.5); PixelCount^[mCount] := count; if SpatiallyCalibrated then mArea^[mCount] := count / (xSpatialScale * ySpatialScale) else mArea^[mCount] := count; end; ShowInfo; AppendResults; WhatToUndo := UndoMeasurement; if LabelParticles then MarkSelection(mCount); end; if not (WandAutoMeasure and LabelParticles) then RoiShowing := true; if not MakingLOI then UpdateScreen(RoiRect); if not WandAutoMeasure then measuring := false; end; {if} end; {with info} end; procedure RedoMeasurement; var SaveN, temp: integer; Canceled: boolean; begin if not isSelectionTool then begin CurrentTool := SelectionTool; isSelectionTool := true; DrawTools; end; temp := GetInt('Measurement to Redo:', mCount, Canceled); if canceled then exit(RedoMeasurement); MeasurementToRedo := temp; if (MeasurementToRedo >= 1) and (MeasurementToRedo <= mCount) then begin SaveN := mCount; mCount := MeasurementToRedo; ShowInfo; mCount := SaveN; end else begin beep; MeasurementToRedo := 0; end; end; procedure DeleteMeasurement; var nToDelete, i: integer; Canceled: boolean; begin nToDelete := GetInt('Measurement to delete:', mCount, Canceled); if (nToDelete >= 1) and (nToDelete <= mCount) and not Canceled then begin for i := nToDelete to mCount - 1 do begin mean^[i] := mean^[i + 1]; sd^[i] := sd^[i + 1]; PixelCount^[i] := PixelCount^[i + 1]; mArea^[i] := mArea^[i + 1]; mode^[i] := mode^[i + 1]; IntegratedDensity^[i] := IntegratedDensity^[i + 1]; idBackground^[i] := idBackground^[i + 1]; xcenter^[i] := xcenter^[i + 1]; ycenter^[i] := ycenter^[i + 1]; MajorAxis^[i] := MajorAxis^[i + 1]; MinorAxis^[i] := MinorAxis^[i + 1]; orientation^[i] := orientation^[i + 1]; mMin^[i] := mMin^[i + 1]; mMax^[i] := mMax^[i + 1]; plength^[i] := plength^[i + 1]; end; {for} mCount := mCount - 1; if mCount = 0 then begin UnsavedResults := false; beep; end; UpdateList; end else if not Canceled then beep; end; function DoAPDialog: boolean; const MinID = 6; MaxID = 7; LabelID = 8; OutlineID = 9; IgnoreID = 10; IncludeHolesID = 11; ResetID = 12; var mylog: DialogPtr; item: integer; begin InitCursor; mylog := GetNewDialog(220, nil, pointer(-1)); SetDNum(MyLog, MinID, MinParticleSize); SetDNum(MyLog, MaxID, MaxParticleSize); SetDialogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge)); SetDialogItem(mylog, LabelID, ord(LabelParticles)); SetDialogItem(mylog, OutlineID, ord(OutlineParticles)); SetDialogItem(mylog, IncludeHolesID, ord(IncludeHoles)); SetDialogItem(mylog, ResetID, ord(APReset)); repeat ModalDialog(nil, item); if item = MinID then MinParticleSize := GetDNum(MyLog, MinID); if item = MaxID then MaxParticleSize := GetDNum(MyLog, MaxID); if item = IgnoreID then begin IgnoreParticlesTouchingEdge := not IgnoreParticlesTouchingEdge; 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 Inclu 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 <= MaxMeasurements then begin ShowInfo; AppendResults; end else ShowMessage(long2str(nParticles)); if nParticles = MaxMeasurements 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; procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType); var i, ff: integer; SaveInfo: InfoPtr; pt, spt, start: point; SaveGDevice: GDHandle; begin SetupUndoInfoRec; SaveInfo := Info; Info := UndoInfo; SaveGDevice := GetGDevice; SetGDevice(osGDevice); with info^ do begin magnification := SaveInfo^.magnification; SrcRect := SaveInfo^.SrcRect; BinaryPic := true; SetPort(GrafPtr(osPort)); end; pmForeColor(BlackIndex); pmBackColor(WhiteIndex); PenNormal; PenSize(LineWidth, LineWidth); EraseRect(info^.PicRect); ff := LineWidth div 2; if ff < 0 then ff := 0; MakingLOI := true; ConvertCoordinates; spt.h := xCoordinates^[1]; spt.v := yCoordinates^[1]; MoveTo(spt.h - ff, spt.v - ff); for i := 2 to nCoordinates do begin pt.h := xCoordinates^[i]; pt.v := yCoordinates^[i]; LineTo(pt.h - ff, pt.v - ff); end; start := spt; start.h := start.h - 1; AutoOutline(start); MakingLOI := false; info^.RoiShowing := false; Info := SaveInfo; SetGDevice(SaveGDevice); with info^ do begin CopyRgn(UndoInfo^.roiRgn, roiRgn); RoiRect := UndoInfo^.RoiRect; SetEmptyRgn(UndoInfo^.roiRgn); RoiShowing := true; SetupUndo; roiType := RoiKind; with RoiRect do begin LX1 := spt.h - left; LY1 := spt.v - top; LX2 := pt.h - left; LY2 := pt.v - top; end; end; {with info^} MakeCoordinatesRelative; end; end. 
