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