home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Applications / NIH Image 1.59 / 1.59 Source / Graphics.p < prev    next >
Encoding:
Text File  |  1995-10-10  |  58.8 KB  |  2,269 lines  |  [TEXT/PJMM]
  1. unit Graphics;
  2.  
  3. {Graphics routines used by NIH Image}
  4.  
  5. interface
  6.  
  7.     uses
  8.         Memory, QuickDraw, Packages, Menus, Events, Fonts, Controls, Scrap, ToolUtils, Palettes, Printing, TextEdit, globals, Utilities;
  9.  
  10.     procedure ShowLineWidth;
  11.     function GetInterpolatedPixel (x, y: extended): extended;
  12.     procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
  13.     procedure GetLengthOrPerimeter (var ulength, clength: extended);
  14.     procedure PlotLineProfile;
  15.     procedure PlotArbitraryLine;
  16.     procedure DrawPlot;
  17.     procedure UpdatePlotWindow;
  18.     procedure ShowInfo;
  19.     procedure ComputePlotMinAndMax;
  20.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  21.     procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
  22.     procedure DrawObject (obj: ObjectType; p1, p2: point);
  23.     procedure DrawTools;
  24.     function InvertingCalibrationFunction: boolean;
  25.     procedure DrawHistogram;
  26.     procedure DrawLabels (xL, yL, zL: str255);
  27.     procedure ShowNextImage;
  28.     procedure CascadeImages;
  29.     procedure TileImages;
  30.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  31.     procedure InvertPic;
  32.     procedure ShowMessage (str: str255);
  33.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  34.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  35.     procedure ConvertHistoToText;
  36.     procedure ConvertPlotToText;
  37.     procedure ConvertCalibrationCurveToText;
  38.     procedure SetupUndoInfoRec;
  39.     procedure ActivateWindow;
  40.     procedure UpdateResultsWindow;
  41.     procedure ScrollResultsText;
  42.     procedure UpdateResultsScrollBars;
  43.     procedure InitResultsTextEdit (font, size: integer);
  44.     procedure DoMouseDownInResults (loc: point);
  45.     procedure AppendResults;
  46.     procedure DeleteLines (first, last: integer);
  47.     procedure UpdateList;
  48.     procedure ShowMeter;
  49.     procedure UpdateMeter (percentdone: integer; str: str255);
  50.     function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean;
  51.     procedure MakeCoordinatesRelative;
  52.     procedure MakeOutline (RoiKind: RoiTypeType);
  53.     procedure ConvertCoordinates;
  54.     function CoordinatesAvailable: boolean;
  55.     function CoordinatesAvailableMsg: boolean;
  56.     procedure DrawDropBox (r: rect);
  57.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  58.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  59.     procedure DrawPopUpText (str: str255; r: rect);
  60.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  61.     procedure RemoveDensityCalibration;
  62.     function isInvertingFunction:boolean;
  63.     function CheckCalibration: boolean;
  64.     procedure PlotTooLongMsg;
  65.  
  66.  
  67.  
  68. implementation
  69.  
  70.  
  71. {$PUSH}
  72. {$D-}
  73.  
  74.     procedure DrawJustifiedReal (x, y: integer; r: extended);
  75.   {Draws a right justified real number.}
  76.         var
  77.             str: str255;
  78.             digits: integer;
  79.     begin
  80.         if abs(r) >= 1000.0 then
  81.             digits := 0
  82.         else
  83.             digits := 2;
  84.         RealToString(r, 1, digits, str);
  85.         MoveTo(x - StringWidth(str), y);
  86.         DrawString(str);
  87.     end;
  88.  
  89.  
  90.     procedure DrawVerticalString (x, y: integer; str: str255);
  91.         var
  92.             i: integer;
  93.     begin
  94.         MoveTo(x, y);
  95.         for i := 1 to length(str) do begin
  96.                 MoveTo(x, y);
  97.                 DrawChar(str[i]);
  98.                 y := y + 9;
  99.             end;
  100.     end;
  101.  
  102.  
  103.     procedure LabelProfilePlot;
  104.         var
  105.             str: str255;
  106.             min, max: extended;
  107.             x, y: integer;
  108.     begin
  109.         min := PlotMin;
  110.         max := PlotMax;
  111.         DrawJustifiedReal(PlotLeftMargin - 2, PlotHeight - PlotBottomMargin, min);
  112.         DrawJustifiedReal(PlotLeftMargin - 2, PlotTopMargin + 8, max);
  113.         y := PlotTopMargin + (PlotHeight - (PlotTopMargin + PlotBottomMargin)) div 2 - length(PlotYUnits) * 9 div 2 + 6;
  114.         DrawVerticalString(PlotLeftMargin - 15, y, PlotYUnits);
  115.         MoveTo(PlotLeftMargin, PlotHeight - PlotBottomMargin + 11);
  116.         DrawLong(0);
  117.         if PlotScale <> 0.0 then
  118.             RealToString((PlotCount - 1) * PlotScale, 1, Precision, str)
  119.         else
  120.             NumToString(PlotCount - 1, str);
  121.         MoveTo(PlotWidth - PlotRightMargin - StringWidth(str) + 4, PlotHeight - PlotBottomMargin + 11);
  122.         DrawString(str);
  123.         x := PlotRightMargin + (PlotWidth - (PlotRightMargin + PlotLeftMargin)) div 2 - StringWidth(str) div 2;
  124.         MoveTo(x, PlotHeight - PlotBottomMargin + 13);
  125.         DrawString(PlotXUnits);
  126.     end;
  127.  
  128.  
  129.     procedure LabelCalibrationPlot;
  130.         var
  131.             pbottom, hloc, vloc, i: integer;
  132.             letter: packed array[1..6] of char;
  133.             c:char;
  134.     begin
  135.         pbottom := PlotHeight - PLotBottomMargin;
  136.         DrawJReal(PlotLeftMargin, PlotTopMargin + 4, maxCValue, 2);
  137.         DrawJReal(PlotLeftMargin, pbottom, minCValue, 2);
  138.         MoveTo(PlotLeftMargin - 3, pbottom + 10);
  139.         DrawString('0');
  140.         MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10);
  141.         DrawString('255');
  142.         MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15);
  143.         TextSize(12);
  144.         case info^.fit of
  145.             StraightLine: 
  146.                 DrawString('y=a+bx');
  147.             Poly2: 
  148.                 DrawString('y=a+bx+cx^2');
  149.             Poly3: 
  150.                 DrawString('y=a+bx+cx^2+dx^3');
  151.             Poly4: 
  152.                 DrawString('y=a+bx+cx^2+dx^3+ex^4');
  153.             Poly5: 
  154.                 DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5');
  155.             ExpoFit: 
  156.                 DrawString('y=aexp(bx)');
  157.             PowerFit: 
  158.                 DrawString('y=ax^b');
  159.             LogFit: 
  160.                 DrawString('y=aln(bx)');
  161.             RodbardFit: 
  162.                 DrawString('y=c*((a-x)/(x-d))^(1/b)');
  163.             UncalibratedOD: 
  164.                 DrawString('y=log10(255/(255-x))');
  165.             otherwise
  166.         end;
  167.         hloc := PlotWidth - PlotRightMargin + 5;
  168.         vloc := PlotTopMargin + 25;
  169.         letter := 'abcdef';
  170.         MoveTo(hloc, vloc);
  171.         with info^ do
  172.             for i := 1 to nCoefficients do begin
  173.                     MoveTo(hloc, vloc);
  174.                     TextSize(12);
  175.                     c:=letter[i];
  176.                     DrawString(c);
  177.                     DrawString('=');
  178.                     TextSize(9);
  179.                     DrawReal(Coefficient[i], 1, 8);
  180.                     vloc := vloc + 15;
  181.                 end;
  182.         if info^.fit <> UncalibratedOD then begin
  183.                 vloc := vloc + 25;
  184.                 MoveTo(hloc, vloc);
  185.                 DrawString('S.D.=');
  186.                 DrawReal(FitSD, 1, 4);
  187.                 vloc := vloc + 15;
  188.                 MoveTo(hloc, vloc);
  189.                 DrawString('R^2=');
  190.                 DrawReal(FitGoodness, 1, 4);
  191.             end;
  192.     end;
  193.  
  194.  
  195.     procedure DrawPlot;
  196.         var
  197.             fRect: rect;
  198.     begin
  199.         SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin);
  200.         PenNormal;
  201.         FrameRect(fRect);
  202.         DrawPicture(PlotPICT, fRect);
  203.         TextFont(Geneva);
  204.         TextSize(9);
  205.         if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin
  206.                 if DrawPlotLabels then
  207.                     LabelProfilePlot
  208.             end
  209.         else
  210.             LabelCalibrationPlot;
  211.     end;
  212.  
  213.  
  214.     procedure UpdatePlotWindow;
  215.     begin
  216.         SetPort(PlotWindow);
  217.         EraseRect(PlotWindow^.portRect);
  218.         DrawPlot;
  219.         DrawMyGrowIcon(PlotWindow);
  220.     end;
  221.  
  222.  
  223.     procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)}
  224.         var
  225.             PLotRect, pwrect, dwrect, srect: rect;
  226.             overlapping: boolean;
  227.     begin
  228.         if PlotWindow = nil then begin
  229.                 SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight);
  230.                 PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0);
  231.             end
  232.         else begin
  233.                 GetWindowRect(PlotWindow, pwrect);
  234.                 GetWindowRect(info^.wptr, dwrect);
  235.                 overlapping := SectRect(pwrect, dwrect, srect);
  236.                 if overlapping then
  237.                     MoveWindow(PlotWindow, PlotLeft, PlotTop, false);
  238.                 SizeWindow(PlotWindow, PlotWidth, PlotHeight, false);
  239.             end;
  240.     end;
  241.  
  242.  
  243.     procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean);
  244.         var
  245.             sum: LongInt;
  246.             p: ptr;
  247.             deltax, deltay, xinc, yinc, accumulator, i: LongInt;
  248.             xloc, yloc, j: LongInt;
  249.             average: boolean;
  250.             buf, fline: LineType;
  251.     begin
  252.         average := LineWidth > 1;
  253.         if OptionKey and average then
  254.             for i := 0 to MaxLine do
  255.                 fline[i] := ForegroundIndex;
  256.         count := 0;
  257.         xloc := start.h;
  258.         yloc := start.v;
  259.         deltax := finish.h - xloc;
  260.         deltay := finish.v - yloc;
  261.         if (deltax = 0) and (deltay = 0) then begin
  262.                 data[count] := MyGetPixel(xloc, yloc);
  263.                 if OptionKey then
  264.                     PutPixel(xloc, yloc, ForegroundIndex);
  265.                 count := 1;
  266.                 exit(GetDiagLine);
  267.             end;
  268.         if deltax < 0 then begin
  269.                 xinc := -1;
  270.                 deltax := -deltax
  271.             end
  272.         else
  273.             xinc := 1;
  274.         if deltay < 0 then begin
  275.                 yinc := -1;
  276.                 deltay := -deltay
  277.             end
  278.         else
  279.             yinc := 1;
  280.         if DeltaX > DeltaY then begin {More horizontal}
  281.                 if average and (CurrentTool <> LineTool) then
  282.                     deltax := deltax + LineWidth;
  283.                 accumulator := deltax div 2;
  284.                 i := deltax;
  285.                 repeat
  286.                     if count < MaxLine then
  287.                         count := count + 1;
  288.                     accumulator := accumulator + deltay;
  289.                     if accumulator >= deltax then begin
  290.                             accumulator := accumulator - deltax;
  291.                             yloc := yloc + yinc
  292.                         end;
  293.                     xloc := xloc + xinc;
  294.                     if average then begin
  295.                             GetColumn(xloc, yloc, LineWidth, buf);
  296.                             if OptionKey then
  297.                                 PutColumn(xloc, yloc, LineWidth, fline);
  298.                             sum := 0;
  299.                             for j := 0 to LineWidth - 1 do
  300.                                 sum := sum + buf[j];
  301.                             data[count - 1] := round(sum / LineWidth);
  302.                         end
  303.                     else begin
  304.                             data[count - 1] := MyGetPixel(xloc, yloc);
  305.                             if OptionKey then
  306.                                 PutPixel(xloc, yloc, ForegroundIndex);
  307.                         end;
  308.                     i := i - 1;
  309.                 until i = 0
  310.             end
  311.         else begin          {More vertical}
  312.                 if average and (CurrentTool <> LineTool) then
  313.                     deltay := deltay + LineWidth;
  314.                 accumulator := deltay div 2;
  315.                 i := deltay;
  316.                 repeat
  317.                     if count < MaxLine then
  318.                         count := count + 1;
  319.                     accumulator := accumulator + deltax;
  320.                     if accumulator >= deltay then begin
  321.                             accumulator := accumulator - deltay;
  322.                             xloc := xloc + xinc
  323.                         end;
  324.                     yloc := yloc + yinc;
  325.                     if average then begin
  326.                             GetLine(xloc, yloc, LineWidth, buf);
  327.                             if OptionKey then
  328.                                 PutLine(xloc, yloc, LineWidth, fline);
  329.                             sum := 0;
  330.                             for j := 0 to LineWidth - 1 do
  331.                                 sum := sum + buf[j];
  332.                             data[count - 1] := round(sum / LineWidth);
  333.                         end
  334.                     else begin
  335.                             data[count - 1] := MyGetPixel(xloc, yloc);
  336.                             if OptionKey then
  337.                                 PutPixel(xloc, yloc, ForegroundIndex);
  338.                         end;
  339.                     i := i - 1;
  340.                 until i = 0
  341.             end;
  342.     end;
  343.  
  344.  
  345.     function GetInterpolatedPixel (x, y: extended): extended;
  346.   {Uses bilinear interpolation to computes the raw pixel value at real coordinates (x,y).}
  347.         var
  348.             i: integer;
  349.             xbase, ybase, offset: LongInt;
  350.             LowerLeft, LowerRight, UpperLeft, UpperRight: integer;
  351.             xfraction, yfraction, UpperAverage, LowerAverage: extended;
  352.     begin
  353.         xbase := trunc(x);
  354.         ybase := trunc(y);
  355.         xFraction := x - xbase;
  356.         yFraction := y - ybase;
  357.         with info^ do
  358.             if (xbase < 0) or (ybase < 0) or (xbase >= (PixelsPerLine - 1)) or (ybase >= (nlines - 1)) then begin
  359.                     LowerLeft := 0;
  360.                     LowerRight := 0;
  361.                     UpperLeft := 0;
  362.                     UpperRight := 0;
  363.                 end
  364.             else begin
  365.                     offset := ybase * BytesPerRow + xbase;
  366.                     LowerLeft := ImageP(PicBaseAddr)^[offset];
  367.                     LowerRight := ImageP(PicBaseAddr)^[offset + 1];
  368.                     UpperLeft := ImageP(PicBaseAddr)^[offset + BytesPerRow];
  369.                     UpperRight := ImageP(PicBaseAddr)^[offset + BytesPerRow + 1];
  370.                 end;
  371.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  372.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  373.         GetInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  374.     end;
  375.  
  376.  
  377.     function GetCInterpolatedPixel (x, y: extended): extended;
  378.   {Uses bilinear interpolation to computes the calibrated pixel value at real coordinates (x,y).}
  379.         var
  380.             i, xbase, ybase: LongInt;
  381.             LowerLeft, LowerRight, UpperLeft, UpperRight: extended;
  382.             xfraction, yfraction, UpperAverage, LowerAverage: extended;
  383.     begin
  384.         xbase := trunc(x);
  385.         ybase := trunc(y);
  386.         xFraction := x - xbase;
  387.         yFraction := y - ybase;
  388.         LowerLeft := cvalue[MyGetPixel(xbase, ybase)];
  389.         LowerRight := cvalue[MyGetPixel(xbase + 1, ybase)];
  390.         UpperRight := cvalue[MyGetPixel(xbase + 1, ybase + 1)];
  391.         UpperLeft := cvalue[MyGetPixel(xbase, ybase + 1)];
  392.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  393.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  394.         GetCInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  395.     end;
  396.  
  397.  
  398.     procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
  399.         var
  400.             i: integer;
  401.             x, y, xinc, yinc: extended;
  402.             IntegerStart: boolean;
  403.             tLine:LineType;
  404.     begin
  405.         IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
  406.         if IntegerStart and (angle = 0.0) then begin
  407.                 GetLine(trunc(xstart), trunc(ystart), count, tLine);
  408.                 for i := 0 to count - 1 do
  409.                     line[i] := cvalue[tLine[i]];
  410.                 exit(GetObliqueLine);
  411.             end;
  412.         if IntegerStart and (angle = 270.0) then begin
  413.                 GetColumn(trunc(xstart), trunc(ystart), count, tLine);
  414.                 for i := 0 to count - 1 do
  415.                     line[i] := cvalue[tLine[i]];
  416.                 exit(GetObliqueLine);
  417.             end;
  418.         angle := (angle / 180.0) * pi;
  419.         xinc := cos(angle);
  420.         yinc := -sin(angle);
  421.         x := xstart + start * xinc;
  422.         y := ystart + start * yinc;
  423.         if info^.fit <> uncalibrated then
  424.             for i := 0 to count - 1 do begin
  425.                     line[i] := GetCInterpolatedPixel(x, y);
  426.                     x := x + xinc;
  427.                     y := y + yinc;
  428.                 end
  429.         else
  430.             for i := 0 to count - 1 do begin
  431.                     line[i] := GetInterpolatedPixel(x, y);
  432.                     x := x + xinc;
  433.                     y := y + yinc;
  434.                 end;
  435.     end;
  436.  
  437.  
  438.     procedure DrawTools;
  439.         var
  440.             tPort: GrafPtr;
  441.             tool: ToolType;
  442.             tpRect, sRect, dRect: rect;
  443.             hloc, vloc: integer;
  444.  
  445.         procedure CopyToolBits (src, dst: rect; CopyMode: integer);
  446.         begin
  447.             CopyBits(toolBits, BitMapHandle(CGrafPtr(ToolWindow)^.PortPixMap)^^, src, dst, CopyMode, nil);
  448.         end;
  449.  
  450.     begin
  451.         GetPort(tPort);
  452.         SetPort(ToolWindow);
  453.         tpRect := CGrafPtr(ToolWindow)^.portRect;
  454.         SetFColor(BlackIndex);
  455.         SetBColor(WhiteIndex);
  456.         CopyToolBits(tpRect, tpRect, srcCopy);
  457.         case LOIType of
  458.             Straight: 
  459.                 ;
  460.             Freehand:  begin
  461.                     SetRect(sRect, 46, 92, 62, 106);
  462.                     hloc := 27;
  463.                     vloc := 92;
  464.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  465.                     CopyToolBits(sRect, dRect, SrcCopy);
  466.                 end;
  467.             Segmented:  begin
  468.                     SetRect(sRect, 46, 108, 62, 122);
  469.                     hloc := 27;
  470.                     vloc := 92;
  471.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  472.                     CopyToolBits(sRect, dRect, SrcCopy);
  473.                 end;
  474.         end;
  475.         InvertRect(ToolRect[CurrentTool]);
  476.         SetRect(sRect, 46, 226, 55, 233);
  477.         hloc := 2;
  478.         vloc := Lines[LineIndex].top - 4;
  479.         SetRect(dRect, hloc, vloc, hloc + 9, vloc + 7);
  480.         CopyToolBits(sRect, dRect, SrcCopy); {Check mark}
  481.         SetFColor(ForegroundIndex);
  482.         SetRect(sRect, 46, 81, 57, 87);
  483.         hloc := 4;
  484.         vloc := 101;
  485.         SetRect(dRect, hloc, vloc, hloc + 11, vloc + 6);
  486.         CopyToolBits(sRect, dRect, SrcOr); {Brush color}
  487.         SetFColor(BackgroundIndex);
  488.         SetRect(sRect, 46, 65, 61, 76);
  489.         hloc := 3;
  490.         vloc := 73;
  491.         SetRect(dRect, hloc, vloc, hloc + 15, vloc + 11);
  492.         CopyToolBits(sRect, dRect, SrcOr); {Eraser color}
  493.         SetPort(tPort);
  494.     end;
  495.  
  496.  
  497.     procedure ShowLineWidth;
  498.     begin
  499.         LineIndex := LineWidth;
  500.         if LineWidth = 6 then
  501.             LineIndex := 5;
  502.         if LineWidth > 6 then
  503.             LineIndex := 6;
  504.         DrawTools;
  505.     end;
  506.  
  507.  
  508.     procedure GetFatLine (xstart, ystart, angle: extended; count: integer; var line: rLineType);
  509.         var
  510.             i, j, xbase, ybase: integer;
  511.             x, y, xinc, yinc, pAngle, xinc2, yinc2: extended;
  512.             sum, value: extended;
  513.             add: boolean;
  514.     begin
  515.         add := (angle > 90.0) and (angle <= 270.0);
  516.         angle := (angle / 180.0) * pi;
  517.         xinc := cos(angle);
  518.         yinc := -sin(angle);
  519.         if add then
  520.             pAngle := angle + pi / 2.0
  521.         else
  522.             pAngle := angle - pi / 2.0;
  523.         xinc2 := cos(pAngle);
  524.         yinc2 := -sin(pAngle);
  525.         for i := 0 to count - 1 do begin
  526.                 x := xstart;
  527.                 y := ystart;
  528.                 sum := 0.0;
  529.                 for j := 1 to LineWidth do begin
  530.                         if info^.fit <> uncalibrated then
  531.                             value := GetCInterpolatedPixel(x, y)
  532.                         else
  533.                             value := GetInterpolatedPixel(x, y);
  534.                         sum := sum + value;
  535.                         x := x + xinc2;
  536.                         y := y + yinc2;
  537.                     end;
  538.                 line[i] := sum / LineWidth;
  539.                 xstart := xstart + xinc;
  540.                 ystart := ystart + yinc;
  541.             end;
  542.     end;
  543.  
  544.  
  545.     procedure ComputePlotMinAndMax;
  546.         var
  547.             i: integer;
  548.             temp: extended;
  549.     begin
  550.         if InvertPlots then
  551.             for i := 0 to PlotCount - 1 do
  552.                 PlotData^[i] := maxCValue - (PlotData^[i] - minCValue);
  553.         ActualPlotMin := 10e12;
  554.         ActualPlotMax := -10e12;
  555.         for i := 0 to PlotCount - 1 do begin
  556.                 temp := PlotData^[i];
  557.                 if temp < ActualPlotMin then
  558.                     ActualPlotMin := temp;
  559.                 if temp > ActualPlotMax then
  560.                     ActualPlotMax := temp;
  561.             end;
  562.     end;
  563.  
  564.  
  565.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  566.         const
  567.             MinWidth = 150;
  568.         var
  569.             fRect, trect: rect;
  570.             i, y, WindowWidth, fmax: integer;
  571.             SaveClipRegion: RgnHandle;
  572.             pt: point;
  573.             scale, vscale: extended;
  574.             AutoScale: boolean;
  575.             index: Byte;
  576.     begin
  577.         with info^ do begin
  578.                 PlotLeftMargin := 38;
  579.                 PlotTopMargin := 10;
  580.                 PlotBottomMargin := 20;
  581.                 PlotRightMargin := 20;
  582.                 if FixedSizePlot then begin
  583.                         PlotWidth := ProfilePlotWidth;
  584.                         PlotHeight := ProfilePlotHeight
  585.                     end
  586.                 else begin
  587.                         PlotWidth := PlotCount * trunc(magnification + 0.5);
  588.                         if PlotWidth < MinWidth then
  589.                             PlotWidth := MinWidth;
  590.                         if PlotWidth + PlotRightMargin + PicLeftBase > ScreenWidth then
  591.                             PlotWidth := ScreenWidth - PlotRightMargin - PicLeftBase - 10;
  592.                         if PlotWidth > PicRect.right then
  593.                             PlotWidth := PicRect.right;
  594.                         PlotHeight := PlotWidth div 2;
  595.                         if PlotWidth > 300 then
  596.                             PlotHeight := PlotWidth div 3;
  597.                         if PlotWidth > 400 then
  598.                             PlotHeight := PlotWidth div 4;
  599.                     end;
  600.                 PlotWidth := PlotWidth + PlotLeftMargin + PlotRightMargin;
  601.                 PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
  602.                 OffscreenToScreen(start);
  603.                 pt.h := start.h;
  604.                 pt.v := start.v + 40;
  605.                 SetPort(wptr);
  606.                 LocalToGlobal(pt);
  607.                 if VerticalPlot then
  608.                     PlotLeft := PicLeftBase
  609.                 else
  610.                     PlotLeft := pt.h - PlotLeftMargin;
  611.                 PlotTop := pt.v;
  612.                 if PlotLeft > (ScreenWidth - PlotWidth) then
  613.                     PlotLeft := ScreenWidth - PlotWidth - 10;
  614.                 if PlotTop < 60 then
  615.                     PlotTop := 60;
  616.                 if PlotTop > (ScreenHeight - PlotHeight) then
  617.                     PlotTop := ScreenHeight - PlotHeight - 10;
  618.                 if PlotTop < 60 then
  619.                     PlotTop := 60;
  620.                 MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
  621.                 if PlotWindow = nil then
  622.                     exit(SetupPlot);
  623.                 WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
  624.                 if SpatiallyCalibrated then begin
  625.                         PlotScale := 1 / xScale;
  626.                         if xUnit = 'inch' then
  627.                             PlotXUnits := 'Inches'
  628.                         else if xUnit = 'meter' then
  629.                             PlotXUnits := 'meters'
  630.                         else if xUnit = 'mile' then
  631.                             PlotXUnits := 'miles'
  632.                         else
  633.                             PlotXUnits := xUnit;
  634.                     end
  635.                 else begin
  636.                         PlotScale := 0.0;
  637.                         PlotXUnits := 'Pixels'
  638.                     end;
  639.                 if fit <> uncalibrated then
  640.                     PlotYUnits := UnitOfMeasure
  641.                 else
  642.                     PlotYUnits := '';
  643.                 if AutoScalePlots then begin
  644.                         PlotMin := ActualPlotMin;
  645.                         PlotMax := ActualPlotMax;
  646.                     end
  647.                 else begin
  648.                         PlotMin := ProfilePlotMin;
  649.                         PlotMax := ProfilePlotMax;
  650.                     end;
  651.                 fmax := PlotCount - 1;
  652.                 if (PlotMax - PlotMin) <> 0 then
  653.                     vscale := fmax / (PlotMax - PlotMin)
  654.                 else
  655.                     vscale := 1.0;
  656.                 scale := 2048.0 / PlotCount;  {This scaling needed to get around a 32-bit QD problem}
  657.                 if scale < 1.0 then
  658.                     scale := 1.0;
  659.                 fmax := round(fmax * scale);
  660.                 vscale := vscale * scale;
  661.                 SetRect(fRect, 0, 0, fmax, fmax);
  662.                 SetPort(PlotWindow);
  663.                 SaveClipRegion := PlotWindow^.ClipRgn;
  664.                 RectRgn(PlotWindow^.ClipRgn, fRect);
  665.                 PlotPICT := OpenPicture(fRect);
  666.                 PenNormal;
  667.                 if LinePlot then begin
  668.                         MoveTo(0, round(vscale * (PlotMax - PlotData^[0])));
  669.                         for i := 1 to PlotCount - 1 do
  670.                             LineTo(round(i * scale), round(vscale * (PlotMax - PlotData^[i])))
  671.                     end
  672.                 else
  673.                     for i := 1 to PlotCount - 1 do begin
  674.                             y := round(vscale * (PlotMax - PlotData^[i]));
  675.                             MoveTo(round(i * scale), y);
  676.                             LineTo(round(i * scale), y)
  677.                         end;
  678.                 ClosePicture;
  679.                 PlotWindow^.ClipRgn := SaveClipRegion;
  680.                 InvalRect(PlotWindow^.PortRect);
  681.                 SelectWindow(PlotWindow);
  682.             end;  {with}
  683.     end;
  684.  
  685.  
  686.     procedure PlotLineProfile;
  687.         var
  688.             x1, y1, x2, y2, ulength, clength: extended;
  689.             start: point;
  690.             i, count:integer;
  691.     begin
  692.         GetLengthOrPerimeter(ulength, clength);
  693.         count := round(ulength);
  694.         if count = 0 then begin
  695.                 PutError('Line length is zero.');
  696.                 AbortMacro;
  697.                 exit(PlotLineProfile);
  698.             end;
  699.         if count > MaxLine then begin
  700.             PlotTooLongMsg;
  701.             exit(PlotLineProfile);
  702.         end;
  703.         PlotCount := count;
  704.         GetLoi(x1, y1, x2, y2);
  705.         PlotAngle := info^.LAngle;
  706.         if LineWidth > 1 then
  707.             GetFatLine(x1, y1, PlotAngle, PlotCount, PlotData^)
  708.         else
  709.             GetObliqueLine(x1, y1, 0.0, PlotAngle, PlotCount, PlotData^);
  710.         PlotAvg := LineWidth;
  711.         PlotStart.h := round(x1);
  712.         PlotStart.v := round(y1);
  713.         ComputePlotMinAndMax;
  714.         if ShowPlot then
  715.             SetupPlot(PlotStart, false);
  716.     end;
  717.  
  718.  
  719.     function CoordinatesAvailable: boolean;
  720.         var
  721.             available: boolean;
  722.     begin
  723.         with info^.RoiRect do
  724.             available := (nCoordinates > 0) and ((right - left) = CoordinatesWidth) and ((bottom - top) = CoordinatesHeight) and (info^.RoiType = CoordinatesRoiType);
  725.         if AnalyzingParticles and (nCoordinates > 0) then
  726.             available := true;
  727.         CoordinatesAvailable := available;
  728.     end;
  729.  
  730.  
  731.     function CoordinatesAvailableMsg: boolean;
  732.         var
  733.             available: boolean;
  734.     begin
  735.         available := CoordinatesAvailable;
  736.         if not available then
  737.             PutError('XY coordinates are not available.');
  738.         CoordinatesAvailableMsg := available;
  739.     end;
  740.  
  741.  
  742.     function GetArbitraryLine (var count: integer; var pdata: rLineType): boolean;
  743.         var
  744.             angle, length, leftover: extended;
  745.             i, j, ilength, xbase, ybase: integer;
  746.             x1, y1, x2, y2: LongInt;
  747.             data: rLineType;
  748.     begin
  749.         if not CoordinatesAvailableMsg or (nCoordinates < 2) then begin
  750.                 GetArbitraryLine := false;
  751.                 exit(GetArbitraryLine);
  752.             end;
  753.         count := 0;
  754.         length := 0.0;
  755.         leftover := 0.0;
  756.         with info^.RoiRect do begin
  757.                 xbase := left;
  758.                 ybase := top;
  759.             end;
  760.         for i := 2 to nCoordinates do begin
  761.                 x1 := xCoordinates^[i - 1] + xbase;
  762.                 y1 := yCoordinates^[i - 1] + ybase;
  763.                 x2 := xCoordinates^[i] + xbase;
  764.                 y2 := yCoordinates^[i] + ybase;
  765.                 length := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
  766.                 if length > 0.0 then begin
  767.                         length := length - LeftOver;
  768.                         ilength := round(length);
  769.                         if ilength > 0 then begin
  770.                                 angle:=GetAngle(x2 - x1, y1 - y2);
  771.                                 GetObliqueLine(x1, y1, leftover, angle, ilength, data);
  772.                                 for j := 1 to ilength do begin
  773.                                         pdata[count] := data[j - 1];
  774.                                         if count < MaxLine then
  775.                                             count := count + 1;
  776.                                     end;
  777.                             end;
  778.                         leftover := length - ilength;
  779.                     end;
  780.             end;
  781.         GetArbitraryLine := true;
  782.     end;
  783.  
  784.  
  785.     procedure PlotArbitraryLine;
  786.         var
  787.             angle, length, leftover: extended;
  788.             x1, y1, x2, y2, i, j, count: integer;
  789.             data: LineType;
  790.     begin
  791.         if not GetArbitraryLine(PlotCount, PlotData^) then
  792.             exit(PlotArbitraryLine);
  793.         PlotAvg := 1;
  794.         with info^.RoiRect do begin
  795.                 PlotStart.h := left;
  796.                 PlotStart.v := top;
  797.             end;
  798.         ComputePlotMinAndMax;
  799.         if ShowPlot then
  800.             SetupPlot(PlotStart, false);
  801.     end;
  802.  
  803.  
  804.     procedure FindIntegratedDensity (var IntDen, Background: extended);
  805.         var
  806.             i, MinLevel, MaxLevel, iback: integer;
  807.             MaxCount: LongInt;
  808.             h, h2: HistogramType;
  809.             sum, wsum: extended;
  810.  
  811.         procedure SmoothHistogram;
  812.             var
  813.                 i: integer;
  814.         begin
  815.             h2 := h;
  816.             h[0] := (3 * h2[0] + h2[1]) div 5;
  817.             for i := 1 to 254 do
  818.                 h[i] := (h2[i - 1] + 2 * h2[i] + h2[i + 1]) div 4;
  819.         end;
  820.  
  821.     begin
  822.         with results do begin
  823.                 MinLevel := MinIndex;
  824.                 MaxLevel := round(UncalibratedMean);
  825.                 if MaxLevel > 254 then
  826.                     MaxLevel := 254;
  827.                 h := histogram;
  828.                 for i := 0 to 255 do
  829.                     h[i] := h[i] * 10;
  830.                 for i := 1 to 15 do
  831.                     SmoothHistogram;
  832.                 if OptionKeyDown then
  833.                     histogram := h;
  834.                 Background := 0.0;
  835.                 MaxCount := 0;
  836.                 for i := MinLevel to MaxLevel do
  837.                     if h[i] > MaxCount then begin
  838.                             MaxCount := h[i];
  839.                             Background := cvalue[i]
  840.                         end;
  841.                 IntDen := mArea^[mCount] * (mean^[mCount] - Background);
  842.             end;
  843.     end;
  844.  
  845.     procedure ShowInfo;
  846.         var
  847.             vloc, hloc: integer;
  848.             tPort: GrafPtr;
  849.             trect: rect;
  850.             clength, cx, cy, IntDen, BackgroundLevel: extended;
  851.             tUnit: UnitType;
  852.             TextStyle:style;
  853.  
  854.         procedure NewLine;
  855.         begin
  856.             vloc := vloc + 12;
  857.             MoveTo(hloc, vloc);
  858.         end;
  859.  
  860.     begin
  861.         GetPort(tPort);
  862.         vloc := 35;
  863.         hloc := 4;
  864.         SetPort(InfoWindow);
  865.         TextFont(Geneva);
  866.         TextSize(9);
  867.         Setrect(trect, 0, vloc, rwidth, rheight);
  868.         EraseRect(trect);
  869.         if InfoMessage <> '' then begin
  870.                 Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  871.                 TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft)
  872.             end
  873.         else
  874.             with results do begin
  875.                     NewLine;
  876.                     with info^ do begin
  877.                             if ShowCount then begin
  878.                                     DrawBString('Count: ');
  879.                                     DrawLong(mCount);
  880.                                     NewLine;
  881.                                 end;
  882.                             if SpatiallyCalibrated then begin
  883.                                     DrawBString('Pixels: ');
  884.                                     DrawLong(PixelCount^[mCount]);
  885.                                     NewLine;
  886.                                     DrawBString('Area: ');
  887.                                     DrawReal(mArea^[mCount], 1, precision);
  888.                                     DrawString(' square ');
  889.                                     tUnit := xUnit;
  890.                                     if tUnit = 'inch' then
  891.                                         tUnit := 'Inches'
  892.                                     else if tUnit = 'meter' then
  893.                                         tUnit := 'meters'
  894.                                     else if tUnit = 'mile' then
  895.                                         tUnit := 'miles';
  896.                                     DrawString(tUnit);
  897.                                 end
  898.                             else begin
  899.                                     DrawBString('Area: ');
  900.                                     DrawLong(PixelCount^[mCount]);
  901.                                     DrawString(' square pixels');
  902.                                 end;
  903.                             NewLine;
  904.                             DrawBString('Mean: ');
  905.                             DrawReal(mean^[mCount], 1, precision);
  906.                             if fit <> uncalibrated then begin
  907.                                     DrawString(' ');
  908.                                     DrawBString(UnitOfMeasure);
  909.                                     DrawString('   (');
  910.                                     DrawLong(round(results.UncalibratedMean));
  911.                                     DrawString(')');
  912.                                 end;
  913.                             if PixelCount^[mCount] > 1 then begin
  914.                                     NewLine;
  915.                                     DrawBString('Std Dev: ');
  916.                                     DrawReal(sd^[mCount], 1, precision);
  917.                                     NewLine;
  918.                                     DrawBString('Min: ');
  919.                                     DrawReal(mMin^[mCount], 1, precision);
  920.                                     NewLine;
  921.                                     DrawBString('Max: ');
  922.                                     DrawReal(mMax^[mCount], 1, precision);
  923.                                 end;
  924.                             if (xyLocM in measurements) or (nPoints > 0) then begin
  925.                                     NewLine;
  926.                                     DrawBString('X: ');
  927.                                     DrawReal(xcenter^[mCount], 6, precision);
  928.                                     NewLine;
  929.                                     DrawBString('Y: ');
  930.                                     DrawReal(ycenter^[mCount], 6, precision);
  931.                                 end;
  932.                             if ModeM in Measurements then begin
  933.                                     NewLine;
  934.                                     DrawBString('Mode: ');
  935.                                     DrawReal(mode^[mCount], 1, precision);
  936.                                 end;
  937.                             if (LengthM in measurements) or (nLengths > 0) then begin
  938.                                     NewLine;
  939.                                     DrawBString('Length: ');
  940.                                     DrawReal(plength^[mCount], 1, precision);
  941.                                 end;
  942.                             if MajorAxisM in Measurements then begin
  943.                                     NewLine;
  944.                                     DrawBString(Concat(MajorLabel, ': '));
  945.                                     DrawReal(MajorAxis^[mCount], 1, precision);
  946.                                 end;
  947.                             if MinorAxisM in Measurements then begin
  948.                                     NewLine;
  949.                                     DrawBString(Concat(MinorLabel, ': '));
  950.                                     DrawReal(MinorAxis^[mCount], 1, precision);
  951.                                 end;
  952.                             if (AngleM in measurements) or (nAngles > 0) then begin
  953.                                     NewLine;
  954.                                     DrawBString('Angle: ');
  955.                                     DrawReal(orientation^[mCount], 1, precision);
  956.                                 end;
  957.                             if IntDenM in measurements then begin
  958.                                     NewLine;
  959.                                     FindIntegratedDensity(IntDen, BackgroundLevel);
  960.                                     DrawBString('Integrated Density: ');
  961.                                     DrawReal(IntDen, 1, precision);
  962.                                     NewLine;
  963.                                     DrawBString('Background Level: ');
  964.                                     DrawReal(BackGroundLevel, 1, precision);
  965.                                 end
  966.                             else begin
  967.                                     IntDen := 0.0;
  968.                                     BackGroundLevel := 0.0;
  969.                                 end;
  970.                             IntegratedDensity^[mCount] := IntDen;
  971.                             idBackground^[mCount] := BackGroundLevel;
  972.                             if User1M in Measurements then begin
  973.                                     NewLine;
  974.                                     DrawBString(Concat(User1Label, ': '));
  975.                                     DrawReal(User1^[mCount], 1, precision);
  976.                                 end;
  977.                             if User2M in Measurements then begin
  978.                                     NewLine;
  979.                                     DrawBString(Concat(User2Label, ': '));
  980.                                     DrawReal(User2^[mCount], 1, precision);
  981.                                 end;
  982.                         end;
  983.                 end; {with}
  984.         SetPort(tPort);
  985.         mCount2 := mCount;
  986.     end;
  987.  
  988.  
  989.     procedure PaintCircle (hloc, vloc: integer);
  990.         var
  991.             r: rect;
  992.     begin
  993.         SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth);
  994.         PaintOval(r);
  995.     end;
  996.  
  997.  
  998.     procedure DrawBrush (start, finish: point);
  999.   {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.}
  1000.         var
  1001.             deltax, deltay, xinc, yinc, accumulator, i: integer;
  1002.             xloc, yloc, offset, j: integer;
  1003.     begin
  1004.         xloc := start.h;
  1005.         yloc := start.v;
  1006.         deltax := finish.h - xloc;
  1007.         deltay := finish.v - yloc;
  1008.         if (deltax = 0) and (deltay = 0) then begin
  1009.                 PaintCircle(xloc, yloc);
  1010.                 exit(DrawBrush)
  1011.             end;
  1012.         if deltax < 0 then begin
  1013.                 xinc := -1;
  1014.                 deltax := -deltax
  1015.             end
  1016.         else
  1017.             xinc := 1;
  1018.         if deltay < 0 then begin
  1019.                 yinc := -1;
  1020.                 deltay := -deltay
  1021.             end
  1022.         else
  1023.             yinc := 1;
  1024.         if DeltaX > DeltaY then begin {More horizontal}
  1025.                 accumulator := deltax div 2;
  1026.                 i := deltax;
  1027.                 repeat
  1028.                     accumulator := accumulator + deltay;
  1029.                     if accumulator >= deltax then begin
  1030.                             accumulator := accumulator - deltax;
  1031.                             yloc := yloc + yinc
  1032.                         end;
  1033.                     xloc := xloc + xinc;
  1034.                     PaintCircle(xloc, yloc);
  1035.                     i := i - 1;
  1036.                 until i = 0
  1037.             end
  1038.         else begin          {More vertical}
  1039.                 accumulator := deltay div 2;
  1040.                 i := deltay;
  1041.                 repeat
  1042.                     accumulator := accumulator + deltax;
  1043.                     if accumulator >= deltay then begin
  1044.                             accumulator := accumulator - deltay;
  1045.                             xloc := xloc + xinc
  1046.                         end;
  1047.                     yloc := yloc + yinc;
  1048.                     PaintCircle(xloc, yloc);
  1049.                     i := i - 1;
  1050.                 until i = 0
  1051.             end;
  1052.     end;
  1053.  
  1054.  
  1055.     procedure DrawObject;{ (obj: ObjectType; p1, p2: point)}
  1056.         var
  1057.             MaskRect, r, dstRect, osMaskRect: rect;
  1058.             tPort: GrafPtr;
  1059.             tmp: integer;
  1060.             SaveGDevice: GDHandle;
  1061.     begin
  1062.         SaveGDevice := GetGDevice;
  1063.         GetPort(tPort);
  1064.         Pt2Rect(p1, p2, MaskRect);
  1065.         with Info^ do begin
  1066.                 changes := true;
  1067.                 tmp := trunc(magnification + 0.5) * LineWidth;
  1068.                 with MaskRect do begin
  1069.                         if tmp < 32 then
  1070.                             tmp := 32;
  1071.                         right := right + tmp;
  1072.                         bottom := bottom + tmp;
  1073.                         if magnification > 1.0 then begin
  1074.                                 left := left - tmp;
  1075.                                 top := top - tmp;
  1076.                             end;
  1077.                     end;
  1078.                 ScreenToOffscreen(p1);
  1079.                 ScreenToOffscreen(p2);
  1080.                 SetGDevice(osGDevice);
  1081.                 SetPort(GrafPtr(osPort));
  1082.                 pmForeColor(ForegroundIndex);
  1083.                 PenNormal;
  1084.                 PenSize(LineWidth, LineWidth);
  1085.                 case obj of
  1086.                     lineObj:  begin
  1087.                             MoveTo(p1.h, p1.v);
  1088.                             LineTo(p2.h, p2.v);
  1089.                         end;
  1090.                     Rectangle:  begin
  1091.                             Pt2Rect(p1, p2, r);
  1092.                             FrameRect(r);
  1093.                         end;
  1094.                     oval:  begin
  1095.                             Pt2Rect(p1, p2, r);
  1096.                             FrameOval(r);
  1097.                         end;
  1098.                     BrushObj: 
  1099.                         DrawBrush(p1, p2);
  1100.                 end;
  1101.                 SetGDevice(SaveGDevice);
  1102.                 SetPort(wptr);
  1103.                 SetFColor(BlackIndex);
  1104.                 SetBColor(WhiteIndex);
  1105.                 RectRgn(MaskRgn, MaskRect);
  1106.                 CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
  1107.                 SetPort(tPort);
  1108.             end; {with}
  1109.     end;
  1110.  
  1111.  
  1112.     function InvertingCalibrationFunction: boolean;
  1113.     begin
  1114.         with info^ do begin
  1115.                 InvertingCalibrationFunction := (fit = StraightLine) and (Coefficient[2] < 0.0)
  1116.             end;
  1117.     end;
  1118.  
  1119.  
  1120.     procedure DrawHistogram;
  1121.         var
  1122.             tPort: GrafPtr;
  1123.             i, h: integer;
  1124.             MaxCount, count, NextMaxCount: LongInt;
  1125.             str: str255;
  1126.             hscale: extended;
  1127.             ShowSlice: boolean;
  1128.     begin
  1129.         ShowSlice := (HistogramSliceStart > 0) or (HistogramSliceEnd < 255);
  1130.         if not printing then begin
  1131.                 if HistoWindow = nil then
  1132.                     exit(DrawHistogram);
  1133.                 GetPort(tPort);
  1134.                 SetPort(HistoWindow);
  1135.                 EraseRect(HistoWindow^.portRect);
  1136.             end;
  1137.         with Results do begin
  1138.                 MaxCount := histogram[imode];
  1139.                 if MaxCount > (hheight - 2) then begin
  1140.                         if MaxCount / PixelCount^[mCount] > 0.08 then begin
  1141.                                 NextMaxCount := 0;
  1142.                                 for i := 0 to 255 do begin
  1143.                                         count := histogram[i];
  1144.                                         if (i <> imode) and (count > NextMaxCount) then
  1145.                                             NextMaxCount := count;
  1146.                                     end;
  1147.                                 NextMaxCount := NextMaxCount + NextMaxCount div 2;
  1148.                                 if (NextMaxCount > MaxCount) or (NextMaxCount = 0) then
  1149.                                     NextMaxCount := MaxCount;
  1150.                                 hscale := NextMaxCount / (hheight - 2);
  1151.                             end
  1152.                         else
  1153.                             hscale := MaxCount / (hheight - 2);
  1154.                     end
  1155.                 else
  1156.                     hscale := 1.0;
  1157.                 if ShowSlice then
  1158.                     PenPat(qd.gray);
  1159.                 if InvertingCalibrationFunction then
  1160.                     for h := 0 to 255 do begin
  1161.                             if h = HistogramSliceStart then
  1162.                                 PenPat(qd.black);
  1163.                             MoveTo(255 - h, hheight);
  1164.                             LineTo(255 - h, hheight - round(histogram[h] / hscale));
  1165.                             if h = HistogramSliceEnd then
  1166.                                 PenPat(qd.gray)
  1167.                         end
  1168.                 else
  1169.                     for h := 0 to 255 do begin
  1170.                             if h = HistogramSliceStart then
  1171.                                 PenPat(qd.black);
  1172.                             MoveTo(h, hheight);
  1173.                             LineTo(h, hheight - round(histogram[h] / hscale));
  1174.                             if h = HistogramSliceEnd then
  1175.                                 PenPat(qd.gray)
  1176.                         end;
  1177.             end;
  1178.         if ShowSlice then
  1179.             PenNormal;
  1180.         if not Printing then
  1181.             SetPort(tPort);
  1182.     end;
  1183.  
  1184.  
  1185.     procedure DrawLabels (xL, yL, zL: str255);
  1186.    {Draws the labels(e.g.,  X:, Y:, Value:) used for the dynamically}
  1187.    {changing values displayed at the top of the Info window.}
  1188.         var
  1189.             tPort: GrafPtr;
  1190.             trect: rect;
  1191.             s:style;
  1192.     begin
  1193.         if xL = XLabel then
  1194.             if yL = yLabel then
  1195.                 if zL = zLabel then
  1196.                     exit(DrawLabels);
  1197.         GetPort(tPort);
  1198.         SetPort(InfoWindow);
  1199.         TextSize(9);
  1200.         TextFont(Monaco);
  1201.         TextFace([bold]);
  1202.         if length(xL) > 0 then begin
  1203.                 xLabel := xL;
  1204.                 xValueLoc := InfoHStart + StringWidth(xLabel);
  1205.                 yLabel := yL;
  1206.                 yValueLoc := InfoHStart + StringWidth(yLabel);
  1207.                 zLabel := zL;
  1208.                 zValueLoc := InfoHStart + StringWidth(zLabel);
  1209.             end;
  1210.         Setrect(trect, 0, 0, rwidth, 32);
  1211.         EraseRect(trect);
  1212.         MoveTo(InfoHStart, InfoVStart);
  1213.         DrawString(xLabel);
  1214.         MoveTo(InfoHStart, InfoVStart + 10);
  1215.         DrawString(yLabel);
  1216.         MoveTo(InfoHStart, InfoVStart + 19);
  1217.         DrawString(zLabel);
  1218.         s:=[];  {ppc-bug}
  1219.         TextFace(s);
  1220.         SetPort(tPort);
  1221.     end;
  1222.  
  1223.  
  1224.     procedure ShowNextImage;
  1225.         var
  1226.             n: integer;
  1227.     begin
  1228.         n := info^.PicNum + 1;
  1229.         if n > nPics then
  1230.             n := 1;
  1231.         SelectWindow(PicWindow[n]);
  1232.     end;
  1233.  
  1234.  
  1235.     procedure CascadeImages;
  1236.         var
  1237.             i, hloc, vloc, wwidth, wheight: integer;
  1238.             offset: boolean;
  1239.     begin
  1240.         DisableDensitySlice;
  1241.         hloc := PicLeftBase;
  1242.         vloc := PicTopBase;
  1243.         offset := not OptionKeyDown;
  1244.         for i := nPics downto 1 do begin
  1245.                 Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1246.                 with Info^ do begin
  1247.                         HideWindow(wptr);
  1248.                         ScaleToFitWindow := false;
  1249.                         WindowState := NormalWindow;
  1250.                         if offset then
  1251.                             wrect := initwrect
  1252.                         else begin
  1253.                                 wwidth := PixelsPerLine;
  1254.                                 if (hloc + wwidth) > ScreenWidth then
  1255.                                     wwidth := ScreenWidth - hloc - 5;
  1256.                                 wheight := nlines;
  1257.                                 if (vloc + wheight) > ScreenHeight then
  1258.                                     wheight := ScreenHeight - vloc - 5;
  1259.                                 SetRect(wrect, 0, 0, wwidth, wheight);
  1260.                             end;
  1261.                         SrcRect := wrect;
  1262.                         KillRoi;
  1263.                         magnification := 1.0;
  1264.                         if i = nPics then
  1265.                             DrawMyGrowIcon(wptr);
  1266.                         SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1267.                         MoveWindow(wptr, hloc, vloc, true);
  1268.                         ShowWindow(wptr);
  1269.                         UpdateTitleBar;
  1270.                     end; {with}
  1271.                 if offset then begin
  1272.                         hloc := hloc + hPicOffset;
  1273.                         vloc := vloc + vPicOffset;
  1274.                         if (vloc + 40) > ScreenHeight then
  1275.                             vloc := PicTopBase;
  1276.                     end;
  1277.             end; {for}
  1278.         PicLeft := PicLeftBase;
  1279.         PicTop := PicTopBase;
  1280.         WhatToUndo := NothingToUndo;
  1281.     end;
  1282.  
  1283.  
  1284.     procedure TileImages;
  1285.         const
  1286.             gap = 2;
  1287.             TitleBarHeight = 20;
  1288.         var
  1289.             i, hloc, vloc, width, height, hspace, vspace, nRows, nColumns: integer;
  1290.             MinWidth, MinHeight: integer;
  1291.             tInfo: array[1..MaxPics] of InfoPtr;
  1292.             trect: rect;
  1293.             TheyFit: boolean;
  1294.     begin
  1295.         DisableDensitySlice;
  1296.         PicLeft := PicLeftBase;
  1297.         PicTop := PicTopBase;
  1298.         width := MaxInt;
  1299.         height := MaxInt;
  1300.         for i := 1 to nPics do begin
  1301.                 tInfo[i] := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1302.                 with tinfo[i]^.PicRect do begin
  1303.                         if right < width then
  1304.                             width := right;
  1305.                         if bottom < height then
  1306.                             height := bottom;
  1307.                     end;
  1308.             end;
  1309.         MinWidth := width;
  1310.         MinHeight := height;
  1311.         hspace := ScreenWidth - PicLeft - 2 * gap;
  1312.         if width > hspace then
  1313.             width := hspace;
  1314.         vspace := ScreenHeight - PicTop - TitleBarHeight;
  1315.         if height > vspace then
  1316.             height := vspace;
  1317.         repeat
  1318.             hloc := PicLeft;
  1319.             vloc := PicTop;
  1320.             TheyFit := true;
  1321.             i := 0;
  1322.             repeat
  1323.                 i := i + 1;
  1324.                 if (hloc + width) > ScreenWidth then begin
  1325.                         hloc := PicLeft;
  1326.                         vloc := vloc + TitleBarHeight + height;
  1327.                         if (vloc + height) > ScreenHeight then begin
  1328.                                 TheyFit := false;
  1329.                             end;
  1330.                     end;
  1331.                 hloc := hloc + width + gap;
  1332.             until (TheyFit = false) or (i = nPics);
  1333.             if TheyFit = false then begin
  1334.                     width := round(width * 0.98);
  1335.                     height := round(height * 0.98);
  1336.                 end;
  1337.         until TheyFit;
  1338.         nColumns := (ScreenWidth - PicLeft) div (width + gap);
  1339.         nRows := nPics div nColumns;
  1340.         if (nPics mod nColumns) <> 0 then
  1341.             nRows := nRows + 1;
  1342. {ShowMessage(concat('nRows= ', Long2str(nRows), crStr, 'nColumns= ', long2str(nColumns)));}
  1343.         if not OptionKeyWasDown then begin
  1344.                 width := round((ScreenWidth - PicLeft) / nColumns);
  1345.                 width := width - gap - 1;
  1346.                 height := round((ScreenHeight - PicTop) / nRows);
  1347.                 height := height - TitleBarHeight + 3;
  1348.                 if width > MinWidth then
  1349.                     width := MinWidth;
  1350.                 if height > MinHeight then
  1351.                     height := MinHeight;
  1352.             end;
  1353.         hloc := PicLeft;
  1354.         vloc := PicTop;
  1355.         for i := 1 to nPics do begin
  1356.                 if (hloc + width) > ScreenWidth then begin
  1357.                         hloc := PicLeft;
  1358.                         vloc := vloc + TitleBarHeight + height;
  1359.                     end;
  1360.                 Info := tInfo[i];
  1361.                 with Info^ do begin
  1362.                         SetRect(wrect, 0, 0, width, height);
  1363.                         if ScaleToFitWindow then begin
  1364.                                 ScaleToFitWindow := false;
  1365.                                 SrcRect := wrect;
  1366.                                 magnification := 1;
  1367.                                 WindowState := NormalWindow;
  1368.                             end;
  1369.                         if OptionKeyWasDown then begin
  1370.                                 ScaleToFitWindow := true;
  1371.                                 SrcRect := PicRect;
  1372.                                 ScaleImageWindow(wrect);
  1373.                                 WindowState := TiledSmallScaled;
  1374.                             end
  1375.                         else begin
  1376.                                 SrcRect := wrect;
  1377.                                 magnification := 1.0;
  1378.                                 UpdateTitleBar;
  1379.                                 WindowState := TiledSmall;
  1380.                             end;
  1381.                         SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1382.                         KillRoi;
  1383.                         UpdatePicWindow;
  1384.                     end; {with}
  1385.                 MoveWindow(PicWindow[i], hloc, vloc, true);
  1386.                 hloc := hloc + width + gap;
  1387.         end; {for}
  1388.         WhatToUndo := NothingToUndo;
  1389.     end;
  1390.  
  1391.  
  1392.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  1393.         var
  1394.             width, height, i: integer;
  1395.             SaveInfo: InfoPtr;
  1396.             src, dst: ptr;
  1397.             hstart, vstart, offset: LongInt;
  1398.             AutoSelectAll: boolean;
  1399.     begin
  1400.         Duplicate := false;
  1401.         if nPics = MaxPics then
  1402.             exit(Duplicate);
  1403.         WhatToUndo := NothingToUndo;
  1404.         if (not SavingBlankField) and (NotRectangular or NotinBounds) then
  1405.             exit(Duplicate);
  1406.         AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField;
  1407.         if AutoSelectAll then
  1408.             SelectAll(false);
  1409.         ShowWatch;
  1410.         with info^ do begin
  1411.                 if name = '' then begin
  1412.                         name := concat('Copy of ', title);
  1413.                         TruncateString(name, maxTitle);
  1414.                     end;
  1415.                 with RoiRect do begin
  1416.                         width := right - left;
  1417.                         height := bottom - top;
  1418.                         hstart := left;
  1419.                         vstart := top;
  1420.                     end;
  1421.             end;
  1422.         if AutoSelectAll then
  1423.             KillRoi;
  1424.         SaveInfo := Info;
  1425.         if NewPicWindow(name, width, height) then
  1426.             with SaveInfo^ do begin
  1427.                     offset := vstart * BytesPerRow + hstart;
  1428.                     src := ptr(ord4(PicBaseAddr) + offset);
  1429.                     dst := Info^.PicBaseAddr;
  1430.                     for i := 0 to height - 1 do begin
  1431.                             BlockMove(src, dst, width);
  1432.                             src := ptr(ord4(src) + BytesPerRow);
  1433.                             dst := ptr(ord4(dst) + Info^.BytesPerRow);
  1434.                         end;
  1435.                     if SavingBlankField then begin
  1436.                             Info^.PIctureType := BlankField;
  1437.                             BlankFieldInfo := info;
  1438.                         end;
  1439.                     Duplicate := true;
  1440.                 end; {with}
  1441.     end;
  1442.  
  1443.  
  1444.     procedure InvertPic;
  1445.         var
  1446.             tPort: GrafPtr;
  1447.             SaveGDevice: GDHandle;
  1448.     begin
  1449.         SaveGDevice := GetGDevice;
  1450.         SetGDevice(osGDevice);
  1451.         GetPort(tPort);
  1452.         with Info^ do begin
  1453.                 SetPort(GrafPtr(osPort));
  1454.                 InvertRect(PicRect);
  1455.             end;
  1456.         SetPort(tPort);
  1457.         SetGDevice(SaveGDevice);
  1458.     end;
  1459.  
  1460.  
  1461.     procedure ShowMessage (str: str255);
  1462.     begin
  1463.         InfoMessage := str;
  1464.         ShowInfo;
  1465.     end;
  1466.  
  1467.  
  1468.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  1469.         var
  1470.             width, height, nPixels: LongInt;
  1471.             seconds, rate: extended;
  1472.     begin
  1473.         with r do begin
  1474.                 width := right - left;
  1475.                 height := bottom - top;
  1476.                 nPixels := width * height;
  1477.             end;
  1478.         seconds := (TickCount - StartTicks) / 60.0;
  1479.         if seconds <> 0.0 then
  1480.             rate := nPixels / seconds
  1481.         else
  1482.             rate := 0.0;
  1483.         ShowMessage(StringOf(nPixels:1, ' pixels ', crStr, seconds:1:2, ' seconds', crStr, rate:1:0, ' pixels/second', crStr, str));
  1484.     end;
  1485.     
  1486.  
  1487.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  1488.         var
  1489.             seconds: extended;
  1490.             str2: str255;
  1491.     begin
  1492.         seconds := (TickCount - StartTicks) / 60.0;
  1493.         if seconds = 0.0 then
  1494.             seconds := 0.167;
  1495.         RealToString(nFrames / seconds, 1, 2, str2);
  1496.         ShowMessage(concat(str1, str2, ' frames/second'));
  1497.     end;
  1498.  
  1499.  
  1500.     procedure ConvertHistoToText;
  1501.         var
  1502.             i: integer;
  1503.             ValuesInverted: boolean;
  1504.     begin
  1505.         ValuesInverted := InvertingCalibrationFunction;
  1506.         TextBufSize := 0;
  1507.         for i := 0 to 255 do begin
  1508.                 if ValuesInverted then
  1509.                     PutLong(Histogram[255 - i], 1)
  1510.                 else
  1511.                     PutLong(Histogram[i], 1);
  1512.                 if i <> 255 then
  1513.                     PutChar(cr);
  1514.             end;
  1515.     end;
  1516.  
  1517.  
  1518.     procedure ConvertPlotToText;
  1519.         var
  1520.             i: integer;
  1521.     begin
  1522.         TextBufSize := 0;
  1523.         for i := 0 to PlotCount - 1 do begin
  1524.                 PutReal(PlotData^[i], 1, precision);
  1525.                 if i <> PlotCount then
  1526.                     PutChar(cr);
  1527.             end;
  1528.     end;
  1529.  
  1530.  
  1531.     procedure ConvertCalibrationCurveToText;
  1532.         var
  1533.             i: integer;
  1534.     begin
  1535.         TextBufSize := 0;
  1536.         for i := 0 to 255 do begin
  1537.                 PutReal(cvalue[i], 1, 3);
  1538.                 if i <> 255 then
  1539.                     PutChar(cr);
  1540.             end;
  1541.     end;
  1542.  
  1543.  
  1544.     procedure SetupUndoInfoRec;
  1545. {Initialize the Undo buffer's Info record so we can copy}
  1546. {the current image to the Undo buffer and operate on it.}
  1547.     begin
  1548.         with UndoInfo^ do begin
  1549.                 PixelsPerLine := info^.PixelsPerLine;
  1550.                 BytesPerRow := info^.BytesPerRow;
  1551.                 nLines := Info^.nLines;
  1552.                 ImageSize := Info^.ImageSize;
  1553.                 PixMapSize := info^.PixMapSize;
  1554.                 RoiRect := info^.RoiRect;
  1555.                 CopyRgn(Info^.roiRgn, roiRgn);
  1556.                 roiType := Info^.roiType;
  1557.                 PicRect := Info^.PicRect;
  1558.                 with osPort^ do begin
  1559.                         with portPixMap^^ do begin
  1560.                                 RowBytes := BitOr(BytesPerRow, $8000);
  1561.                                 bounds := PicRect;
  1562.                             end;
  1563.                         PortRect := PicRect;
  1564.                         RectRgn(visRgn, PicRect);
  1565.                     end;
  1566.             end;
  1567.     end;
  1568.  
  1569.  
  1570. {$POP}
  1571.  
  1572.  
  1573.     procedure ActivateWindow;
  1574.         var
  1575.             tPort: GrafPtr;
  1576.             SaveGDevice: GDHandle;
  1577.     begin
  1578.         with info^ do begin
  1579.                 IsInsertionPoint := false;
  1580.                 WhatToUndo := NothingToUndo;
  1581.                 UndoFromClip := false;
  1582.                 DrawLabels('', '', '');
  1583.                 MouseState := NotInRoi;
  1584.                 RoiUpdateTime := 0;
  1585.                 if osPort <> nil then begin
  1586.                         SaveGDevice := GetGDevice;
  1587.                         SetGDevice(osGDevice);
  1588.                         GetPort(tPort);
  1589.                         SetPort(GrafPtr(osPort));
  1590.                         pmForeColor(ForegroundIndex);
  1591.                         pmBackColor(BackgroundIndex);
  1592.                         SetPort(tPort);
  1593.                         SetGDevice(SaveGDevice);
  1594.                     end;
  1595.                 ShowRoi;
  1596.             end;
  1597.     end;
  1598.  
  1599.  
  1600.     procedure UpdateResultsWindow;
  1601.     begin
  1602.         SetPort(ResultsWindow);
  1603.         DrawControls(ResultsWindow);
  1604.         DrawGrowIcon(ResultsWindow);
  1605.         UpdateList;
  1606.         if ResultsWindow = FrontWindow then begin
  1607.                 ShowControl(hScrollBar);
  1608.                 ShowControl(vScrollBar);
  1609.             end
  1610.         else begin
  1611.                 HideControl(hScrollBar);
  1612.                 HideControl(vScrollBar);
  1613.             end;
  1614.     end;
  1615.  
  1616.  
  1617.     procedure ScrollResultsText;
  1618.         var
  1619.             value: INTEGER;
  1620.     begin
  1621.         with ListTE^^ do
  1622.             TEScroll((viewRect.left - destRect.left) - GetControlValue(hScrollBar), (viewRect.top - destRect.top) - (GetControlValue(vScrollBar) * LineHeight), ListTE);
  1623.     end;
  1624.  
  1625.  
  1626.     procedure UpdateResultsScrollBars;
  1627.         var
  1628.             vMax, vValue, hMax, hValue: integer;
  1629.     begin
  1630.         with ListTE^^, ListTE^^.viewRect do begin
  1631.                 vListPageSize := (bottom - top) div LineHeight;
  1632.                 hListPageSize := right - left;
  1633.                 vMax := nLines - vListPageSize;
  1634.                 hMax := (nListColumns + 1) * (FieldWidth + 1) * 6 - hListPageSize;
  1635.                 vValue := (top - destRect.top) div LineHeight;
  1636.                 hValue := left - destRect.left
  1637.             end;
  1638.         if vMax < 0 then
  1639.             vMax := 0;
  1640.         if vValue < 0 then
  1641.             vValue := 0;
  1642.         if hMax < 0 then
  1643.             hMax := 0;
  1644.         if vValue < 0 then
  1645.             vValue := 0;
  1646.         SetControlMaximum(vScrollBar, vMax);
  1647.         SetControlValue(vScrollBar, vValue);
  1648.         SetControlMaximum(hScrollBar, hMax);
  1649.         SetControlValue(hScrollBar, hValue);
  1650. {ShowMessage(concat('nListColumns= ', Long2str(nListColumns), crStr, 'hListPageSize= ', long2str(hListPageSize)));}
  1651.     end;
  1652.  
  1653.  
  1654.     procedure ScrAction (theCtl: ControlHandle; partCode: integer);
  1655.         var
  1656.             bInc, pInc, delta: integer;
  1657.     begin
  1658.         if theCtl = vScrollBar then begin
  1659.                 bInc := 1;
  1660.                 pInc := vListPageSize
  1661.             end
  1662.         else begin
  1663.                 bInc := 4;
  1664.                 pInc := hListPageSize
  1665.             end;
  1666.         case partCode of
  1667.             kControlUpButtonPart: 
  1668.                 delta := -bInc;
  1669.             kControlDownButtonPart: 
  1670.                 delta := bInc;
  1671.             kControlPageUpPart: 
  1672.                 delta := -pInc;
  1673.             kControlPageDownPart: 
  1674.                 delta := pInc;
  1675.             otherwise
  1676.                 exit(ScrAction);
  1677.         end;
  1678.         SetControlValue(theCtl, GetControlValue(theCtl) + delta);
  1679.         ScrollResultsText;
  1680.     end;
  1681.  
  1682.  
  1683.     procedure InitResultsTextEdit (font, size: integer);
  1684.         var
  1685.             dRect, vRect: rect;
  1686.     begin
  1687.         if ResultsScrollActionProc=nil
  1688.             then ResultsScrollActionProc:=NewRoutineDescriptor(@ScrAction, uppControlActionProcInfo, GetCurrentISA);
  1689.         SetPort(ResultsWindow);
  1690.         with ResultsWindow^.portRect do
  1691.             SetRect(dRect, left + 4, top, right - 18, bottom - 24);
  1692.         vRect := dRect;
  1693.         ListTE := TENew(dRect, vRect);
  1694.         with ListTE^^ do begin
  1695.                 TxFont := font;
  1696.                 TxSize := size;
  1697.                 crOnly := -1;
  1698.             end;
  1699.         if TextBufSize > 0 then begin
  1700.                 TESetText(ptr(TextBufP), TextBufSize, ListTe);
  1701.                 TECalText(ListTE);
  1702.             end;
  1703.         UpdateResultsScrollBars;
  1704.     end;
  1705.  
  1706.  
  1707.     procedure DoMouseDownInResults (loc: point);
  1708.         var
  1709.             theCtl: ControlHandle;
  1710.             cValue: integer;
  1711.     begin
  1712.         SelectWindow(ResultsWindow);
  1713.         SetPort(ResultsWindow);
  1714.         GlobalToLocal(loc);
  1715.         case FindControl(loc, ResultsWindow, theCtl) of
  1716.             kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart, kControlPageDownPart: 
  1717.                 if TrackControl(theCtl, loc, ResultsScrollActionProc) <> 0 then
  1718.                     ;
  1719.             kControlIndicatorPart: 
  1720.                 if TrackControl(theCtl, loc, nil) <> 0 then
  1721.                     ScrollResultsText;
  1722.             otherwise
  1723.         end;
  1724.     end;
  1725.  
  1726.  
  1727.     procedure AppendResults;
  1728.         var
  1729.             vMax: integer;
  1730.     begin
  1731.         if ResultsWindow <> nil then
  1732.             with ListTE^^ do begin
  1733.                     if teLength > 32000 then
  1734.                         exit(AppendResults);
  1735.                     CopyResultsToBuffer(mCount, mCount, true);
  1736.                     TESetSelect(teLength, teLength, ListTE);
  1737.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  1738.                     with ListTE^^ do begin
  1739.                             vListPageSize := (viewRect.bottom - viewRect.top) div LineHeight;
  1740.                             vMax := nLines - vListPageSize;
  1741.                         end;
  1742.                     if vMax < 0 then
  1743.                         vMax := 0;
  1744.                     SetControlMaximum(vScrollBar, vMax);
  1745.                     SetControlValue(vScrollBar, GetControlMaximum(vScrollBar));
  1746.                     ScrollResultsText;
  1747.                 end;
  1748.     end;
  1749.  
  1750.  
  1751.     procedure DeleteLines (first, last: integer);
  1752.     begin
  1753.         if ResultsWindow <> nil then
  1754.             with ListTE^^ do begin
  1755.                     first := first + 2; {Accounts for 2 line header}
  1756.                     last := last + 2;
  1757.                     if (first = 3) and (last = 3) then
  1758.                         first := 1; {if deleting first line then delete header too}
  1759.                     if (first < 1) or (first > nLines) or (last < 1) or (last > nLines) then
  1760.                         exit(DeleteLines);
  1761.                     TESetSelect(LineStarts[first - 1], LineStarts[last], ListTE);
  1762.                     TEDelete(ListTE);
  1763.                 end;
  1764.     end;
  1765.  
  1766.  
  1767.     procedure UpdateList;
  1768.     begin
  1769.         if (ResultsWindow <> nil) and (mCount > 0) then
  1770.             with ListTE^^ do begin
  1771.                     CopyResultsToBuffer(1, mCount, true);
  1772.                     TESetSelect(0, teLength, ListTE);
  1773.                     TEDelete(ListTE);
  1774.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  1775.                     UpdateResultsScrollBars;
  1776.                 end;
  1777.     end;
  1778.  
  1779.  
  1780.     procedure ShowMeter;
  1781.         const
  1782.             MeterWidth = 264;
  1783.             MeterHeight = 64;
  1784.         var
  1785.             trect: rect;
  1786.             hloc, vloc: integer;
  1787.     begin
  1788.         hloc := ScreenWidth div 2 - MeterWidth div 2;
  1789.         vloc := ScreenHeight div 4 - MeterHeight div 2;
  1790.         SetRect(trect, hloc, vloc, hloc + MeterWidth, vloc + MeterHeight);
  1791.         MeterWindow := NewWindow(nil, trect, '', true, dBoxProc, nil, false, 0);
  1792.         BringToFront(MeterWindow);
  1793.     end;
  1794.  
  1795.  
  1796.     procedure UpdateMeter; {(percentdone: integer; str: str255)}
  1797.         const
  1798.             left = 16;
  1799.             top = 28;
  1800.             right = 248;
  1801.             bottom = 44;
  1802.         var
  1803.             r: rect;
  1804.     begin
  1805.         if percentdone < 0 then begin
  1806.             if MeterWindow <> nil then
  1807.                 DisposeWindow(MeterWindow);
  1808.             MeterWindow := nil;
  1809.             exit(UpdateMeter);
  1810.         end;
  1811.         if MeterWindow = nil then
  1812.             ShowMeter;
  1813.         SetPort(MeterWindow);
  1814.         TextFont(SystemFont);
  1815.         TextSize(12);
  1816.         TextMode(SrcCopy);
  1817.         MoveTo(left, top div 2);
  1818.         DrawString(str);
  1819.         SetRect(r, left + StringWidth(str), 0, right, top);
  1820.         EraseRect(r);
  1821.         SetRect(r, left, top, right, bottom);
  1822.         FrameRect(r);
  1823.         SetRect(r, left + 1, top + 1, left + (percentdone * (right - left)) div 100 - 1, bottom - 1);
  1824.         FillRect(r, qd.gray);
  1825.     end;
  1826.  
  1827.  
  1828.     function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean}
  1829.     begin
  1830.         RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000
  1831.     end;
  1832.  
  1833.  
  1834.     procedure GetSmoothedLength (var ulength, clength: extended; FindPerimeter: boolean);
  1835.   {Finds the length of freehand line selections or perimeter of}
  1836.   {freehand area selections using a 3-point moving average.}
  1837.         var
  1838.             i, n: integer;
  1839.             x1, y1, x2, y2, dx, dy: extended;
  1840.  
  1841.         procedure AddDelta;
  1842.         begin
  1843.             with info^ do begin
  1844.                     dx := x2 - x1;
  1845.                     dy := y2 - y1;
  1846.                     uLength := uLength + sqrt(dx * dx + dy * dy);
  1847.                     if SpatiallyCalibrated then begin
  1848.                             dx := dx / xScale;
  1849.                             dy := dy / yScale;
  1850.                             cLength := cLength + sqrt(dx * dx + dy * dy);
  1851.                         end;
  1852.                 end;
  1853.         end;
  1854.  
  1855.     begin
  1856.         with info^ do begin
  1857.                 uLength := 0.0;
  1858.                 cLength := 0.0;
  1859.                 n := nCoordinates;
  1860.                 if not CoordinatesAvailable then
  1861.                     exit(GetSmoothedLength);
  1862.                 if FindPerimeter then begin
  1863.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  1864.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  1865.                     end
  1866.                 else begin
  1867.                         x1 := (xCoordinates^[1] * 2.0 + xCoordinates^[2]) / 3.0; {1}
  1868.                         y1 := (yCoordinates^[1] * 2.0 + yCoordinates^[2]) / 3.0;
  1869.                     end;
  1870.                 x2 := (xCoordinates^[1] + xCoordinates^[2] + xCoordinates^[3]) / 3.0; {2}
  1871.                 y2 := (yCoordinates^[1] + yCoordinates^[2] + yCoordinates^[3]) / 3.0;
  1872.                 AddDelta;
  1873.                 for i := 2 to n - 2 do begin
  1874.                         x1 := x2; {i}
  1875.                         y1 := y2;
  1876.                         x2 := (xCoordinates^[i] + xCoordinates^[i + 1] + xCoordinates^[i + 2]) / 3.0; {i+1}
  1877.                         y2 := (yCoordinates^[i] + yCoordinates^[i + 1] + yCoordinates^[i + 2]) / 3.0;
  1878.                         AddDelta;
  1879.                     end;
  1880.                 x1 := x2; {n-1}
  1881.                 y1 := y2;
  1882.                 if FindPerimeter then begin
  1883.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] + xCoordinates^[1]) / 3.0; {n}
  1884.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] + yCoordinates^[1]) / 3.0;
  1885.                         AddDelta;
  1886.                         x1 := x2; {n}
  1887.                         y1 := y2;
  1888.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  1889.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  1890.                         AddDelta;
  1891.                     end
  1892.                 else begin
  1893.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] * 2.0) / 3.0; {n}
  1894.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] * 2.0) / 3.0;
  1895.                         AddDelta;
  1896.                     end;
  1897.                 if not SpatiallyCalibrated then
  1898.                     cLength := uLength;
  1899.             end; {with}
  1900.     end;
  1901.  
  1902.  
  1903.     procedure GetPerimeter (var uPerimeter, cPerimeter: extended);
  1904.   {Finds the perimeter of traced objects.}
  1905.     var
  1906.       SideLength1, SideLength2: integer;
  1907.       dx1, dx2, dy1, dy2, i: integer;
  1908.       sumdx, sumdy, nCorners, nexti: integer;
  1909.       corner: boolean;
  1910.     begin
  1911.         sumdx := 0;
  1912.         sumdy := 0;
  1913.         nCorners := 0;
  1914.         dx1 := xCoordinates^[1] - xCoordinates^[nCoordinates];
  1915.         dy1 := yCoordinates^[1] - yCoordinates^[nCoordinates];
  1916.         SideLength1 := abs(dx1) + abs(dy1);
  1917.         corner := false;
  1918.         for i := 1 to nCoordinates do begin
  1919.         nexti := i +1;
  1920.         if nexti > nCoordinates then
  1921.           nexti := 1;
  1922.         dx2 := xCoordinates^[nexti] - xCoordinates^[i];
  1923.         dy2 := yCoordinates^[nexti] - yCoordinates^[i];
  1924.         sumdx := sumdx + abs(dx1);
  1925.         sumdy := sumdy + abs(dy1);
  1926.         SideLength2 := abs(dx2) + abs(dy2);
  1927.         if (SideLength1 > 1) or (not corner) then begin
  1928.           corner := true;
  1929.           nCorners := nCorners + 1;
  1930.         end else
  1931.           corner := false;
  1932.         dx1 := dx2;
  1933.         dy1 := dy2;
  1934.         SideLength1 := SideLength2;
  1935.         end;
  1936.         uPerimeter := sumdx + sumdy - nCorners * (2.0 - sqrt(2.0));
  1937.         {ShowMessage(StringOf(sumdx, '  ', sumdy,' ', nCorners)); wait(120); beep;}        
  1938.         with info^ do
  1939.             if SpatiallyCalibrated then
  1940.                 cPerimeter := sumdx/xscale + sumdy/yscale - (nCorners * ((1.0/xscale + 1.0/yscale) - sqrt(sqr(1.0/xscale) + sqr(1.0/yscale))))
  1941.             else
  1942.                 cPerimeter := uPerimeter;
  1943.     end;
  1944.  
  1945.  
  1946.     procedure GetLength (var ulength, clength: extended; FindPerimeter: boolean);
  1947.   {Finds the length of segmented line selections or the perimeter of polygon selections.}
  1948.         var
  1949.             i: integer;
  1950.             xtemp, ytemp: LongInt;
  1951.             xt, yt: extended;
  1952.     begin
  1953.         with info^ do begin
  1954.                 uLength := 0.0;
  1955.                 cLength := 0.0;
  1956.                 if not CoordinatesAvailable then
  1957.                     exit(GetLength);
  1958.                 for i := 2 to nCoordinates do begin
  1959.                         xtemp := xCoordinates^[i] - xCoordinates^[i - 1];
  1960.                         ytemp := yCoordinates^[i] - yCoordinates^[i - 1];
  1961.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  1962.                         if SpatiallyCalibrated then begin
  1963.                                 xt := xtemp / xScale;
  1964.                                 yt := ytemp / yScale;
  1965.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  1966.                             end;
  1967.                     end;
  1968.                 if FindPerimeter then begin
  1969.                         xtemp := xCoordinates^[1] - xCoordinates^[nCoordinates];
  1970.                         ytemp := yCoordinates^[1] - yCoordinates^[nCoordinates];
  1971.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  1972.                         if SpatiallyCalibrated then begin
  1973.                                 xt := xtemp / xScale;
  1974.                                 yt := ytemp / yScale;
  1975.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  1976.                             end;
  1977.                     end;
  1978.                 if not SpatiallyCalibrated then
  1979.                     cLength := uLength;
  1980.             end; {with}
  1981.     end;
  1982.  
  1983.  
  1984.     procedure GetStraightLineLength (var ulength, clength: extended);
  1985.         var
  1986.             dx, dy: extended;
  1987.     begin
  1988.         with info^ do begin
  1989.                 dx := LX2 - LX1;
  1990.                 dy := LY2 - LY1;
  1991.                 uLength := sqrt(sqr(dx) + sqr(dy));
  1992.                 if SpatiallyCalibrated then
  1993.                     cLength := sqrt(sqr(dx / xScale) + sqr(dy / yScale))
  1994.                 else
  1995.                     cLength := uLength;
  1996.             end;
  1997.     end;
  1998.  
  1999.  
  2000.     procedure GetLengthOrPerimeter (var ulength, clength: extended);
  2001.     var
  2002.         t1,t2:extended;
  2003.     begin
  2004.         t1:=ulength; t2:=clength;
  2005.         case info^.RoiType of
  2006.             LineRoi: 
  2007.                 GetStraightLineLength(ulength, clength);
  2008.             PolygonRoi:begin 
  2009.                 GetLength(t1, t2{ulength, clength}, true);  {ppc-bug}
  2010.                 ulength:=t1;
  2011.                 clength:=t2;
  2012.                 end;
  2013.             FreehandRoi:begin 
  2014.                 GetSmoothedLength(t1,t2{ulength, clength}, true);
  2015.                 ulength:=t1;
  2016.                 clength:=t2;
  2017.                 end;
  2018.             FreeLineRoi:begin 
  2019.                 GetSmoothedLength(t1,t2{ulength, clength}, false);
  2020.                 ulength:=t1;
  2021.                 clength:=t2;
  2022.                 end;
  2023.             SegLineRoi:begin 
  2024.                 GetLength(t1, t2{ulength, clength}, false);
  2025.                 ulength:=t1;
  2026.                 clength:=t2;
  2027.                 end;
  2028.             TracedRoi:begin 
  2029.                 GetPerimeter(t1,t2{ulength, clength});
  2030.                 ulength:=t1;
  2031.                 clength:=t2;
  2032.                 end;
  2033.             otherwise begin
  2034.                     ulength := 0.0;
  2035.                     clength := 0.0;
  2036.                 end;
  2037.         end;
  2038.     end;
  2039.  
  2040.  
  2041.     procedure MakeCoordinatesRelative;
  2042.         var
  2043.             i: integer;
  2044.     begin
  2045.         with info^, info^.RoiRect do begin
  2046.                 for i := 1 to nCoordinates do begin
  2047.                         xCoordinates^[i] := xCoordinates^[i] - left;
  2048.                         yCoordinates^[i] := yCoordinates^[i] - top;
  2049.                     end;
  2050.                 CoordinatesWidth := right - left;
  2051.                 CoordinatesHeight := bottom - top;
  2052.                 CoordinatesRoiType := RoiType;
  2053.             end;
  2054.     end;
  2055.  
  2056.  
  2057.     procedure MakeOutline (RoiKind: RoiTypeType);
  2058. {Creates a "marching ants" outline from a list of absolute offscreen XY coordinates.}
  2059.         var
  2060.             i: integer;
  2061.             TempRgn: RgnHandle;
  2062.             spt, pt: point;
  2063.     begin
  2064.         with Info^ do begin
  2065.                 if SelectionMode <> NewSelection then
  2066.                     TempRgn := NewRgn;
  2067.                 SetPort(wptr);
  2068.                 PenNormal;
  2069.                 OpenRgn;
  2070.                 spt.h := xCoordinates^[1];
  2071.                 spt.v := yCoordinates^[1];
  2072.                 MoveTo(spt.h, spt.v);
  2073.                 for i := 2 to nCoordinates do begin
  2074.                         pt.h := xCoordinates^[i];
  2075.                         pt.v := yCoordinates^[i];
  2076.                         LineTo(pt.h, pt.v);
  2077.                     end;
  2078.                 LineTo(spt.h, spt.v);
  2079.                 case SelectionMode of
  2080.                     NewSelection: 
  2081.                         CloseRgn(roiRgn);
  2082.                     AddSelection:  begin
  2083.                             CloseRgn(TempRgn);
  2084.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2085.                                 UnionRgn(roiRgn, TempRgn, roiRgn);
  2086.                             nCoordinates := 0;
  2087.                         end;
  2088.                     SubSelection:  begin
  2089.                             CloseRgn(TempRgn);
  2090.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2091.                                 DiffRgn(roiRgn, TempRgn, roiRgn);
  2092.                             nCoordinates := 0;
  2093.                         end;
  2094.                 end;
  2095.                 RoiShowing := true;
  2096.                 roiType := RoiKind;
  2097.                 RoiRect := roiRgn^^.rgnBBox;
  2098.                 UpdatePicWindow;
  2099.             end;
  2100.         if SelectionMode <> NewSelection then
  2101.             DisposeRgn(TempRgn);
  2102.         WhatToUndo := NothingToUndo;
  2103.         measuring := false;
  2104.         MakeCoordinatesRelative;
  2105.     end;
  2106.  
  2107.  
  2108.     procedure ConvertCoordinates;
  2109.   {Convert from screen to offscreen coordinates}
  2110.         var
  2111.             i: integer;
  2112.     begin
  2113.         with info^, info^.SrcRect do begin
  2114.                 if (magnification <> 1.0) or (left <> 0) or (top <> 0) then begin
  2115.                         if MakingLOI then
  2116.                             for i := 1 to nCoordinates do begin
  2117.                                     xCoordinates^[i] := left + trunc(xCoordinates^[i] / magnification);
  2118.                                     yCoordinates^[i] := top + trunc(yCoordinates^[i] / magnification);
  2119.                                 end
  2120.                         else
  2121.                             for i := 1 to nCoordinates do begin
  2122.                                     xCoordinates^[i] := left + round(xCoordinates^[i] / magnification);
  2123.                                     yCoordinates^[i] := top + round(yCoordinates^[i] / magnification);
  2124.                                 end;
  2125.                     end;
  2126.             end {with}
  2127.     end;
  2128.  
  2129.  
  2130.     procedure DrawTriangle (left, top: integer);
  2131.         var
  2132.             triangle: PolyHandle;
  2133.     begin
  2134.         triangle := OpenPoly;
  2135.         if triangle = nil then
  2136.             exit(DrawTriangle);
  2137.         MoveTo(left, top);
  2138.         LineTo(left + 12, top);
  2139.         LineTo(left + 6, top + 7);
  2140.         LineTo(left, top);
  2141.         ClosePoly;
  2142.         PaintPoly(triangle);
  2143.         KillPoly(triangle);
  2144.     end;
  2145.  
  2146.  
  2147.     procedure DrawDropBox (r: rect);
  2148.   {Draws the  drop shadow box used for pop-up menus}
  2149.     begin
  2150.         with r do begin
  2151.                 EraseRect(r);
  2152.                 FrameRect(r);
  2153.                 MoveTo(left + 2, bottom);
  2154.                 LineTo(right, bottom);
  2155.                 MoveTo(right, top + 2);
  2156.                 LineTo(right, bottom);
  2157.                 DrawTriangle(right - 15, top + 6);
  2158.             end;
  2159.     end;
  2160.  
  2161.  
  2162.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  2163.   {Pops up the specified menu and returns item selected by user.}
  2164.         var
  2165.             PopupResult: LongInt;
  2166.             MenuLoc: point;
  2167.     begin
  2168.         with MenuLoc do begin
  2169.                 h := left;
  2170.                 v := top;
  2171.                 LocalToGlobal(MenuLoc);
  2172.                 PopUpResult := PopupMenuSelect(theMenu, v, h, PopUpItem);
  2173.                 PopUpMenu := LoWrd(PopUpResult);
  2174.             end;
  2175.     end;
  2176.  
  2177.  
  2178.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  2179.         var
  2180.             iType: integer;
  2181.             ignore: handle;
  2182.     begin
  2183.         GetDialogItem(d, item, itype, ignore, r)
  2184.     end;
  2185.  
  2186.  
  2187.     procedure DrawPopUpText (str: str255; r: rect);
  2188.         var
  2189.             TextRect: rect;
  2190.     begin
  2191.         with r do begin
  2192.                 TextFont(SystemFont);
  2193.                 if (str = '+') or (str = '–') or (str = '÷') then begin
  2194.                         TextSize(24);
  2195.                         MoveTo(left + 13, bottom - 2);
  2196.                     end
  2197.                 else begin
  2198.                         TextSize(12);
  2199.                         MoveTo(left + 13, bottom - 5);
  2200.                     end;
  2201.                 if length(str) = 1 then
  2202.                     DrawString(str)
  2203.                 else begin
  2204.                         SetRect(TextRect, left + 13, top + 1, right - 15, bottom - 1);
  2205.                         TETextBox(pointer(ord(@str) + 1), length(str), TextRect, TEJustLeft);
  2206.                     end;
  2207.             end;
  2208.         TextSize(12);
  2209.     end;
  2210.  
  2211.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  2212.         var
  2213.             itype: integer;
  2214.             r: rect;
  2215.             h: handle;
  2216.     begin
  2217.         GetDialogItem(d, item, itype, h, r);
  2218.         SetDialogItem(d, item, itype, pptr, r);
  2219.     end;
  2220.     
  2221.     
  2222.  
  2223.     procedure RemoveDensityCalibration;
  2224.     var
  2225.         i:integer;
  2226.     begin
  2227.         for i := 0 to 255 do
  2228.             cvalue[i] := i;
  2229.         info^.fit:=uncalibrated;
  2230.         NoInfo^.fit:=uncalibrated;
  2231.         InvertPixelValues:=false;
  2232.         DrawLabels('', '', '');
  2233.         UpdateTitleBar;
  2234.     end;
  2235.     
  2236.     
  2237.     function isInvertingFunction:boolean;
  2238.     begin
  2239.         with info^ do
  2240.             isInvertingFunction:=(fit=StraightLine) and (nCoefficients=2)
  2241.                 and (Coefficient[1]=255.0) and (Coefficient[2]=-1.0)
  2242.     end;
  2243.     
  2244.     
  2245.     function CheckCalibration: boolean;
  2246.     var
  2247.         result: integer;
  2248.     begin
  2249.         with info^ do begin
  2250.             CheckCalibration := true;
  2251.             if (fit <> uncalibrated) and (not isInvertingFunction) then begin
  2252.                 result := PutMessageWithCancel('This operation will result in loss of density calibration.');
  2253.                 if result = cancel then begin
  2254.                     CheckCalibration := false;
  2255.                     AbortMacro
  2256.                 end else
  2257.                     RemoveDensityCalibration;
  2258.             end;
  2259.         end; {with}
  2260.     end;
  2261.  
  2262.  
  2263.     procedure PlotTooLongMsg;
  2264.     begin
  2265.         PutError(StringOf('Profile plots are limited to ', MaxLine:1, ' pixels.'));
  2266.     end;
  2267.  
  2268.  
  2269. end.