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

Text File | 1992-03-30 | 64.3 KB | 2,727 lines

unit Utilities;

{Miscellaneous utility routines used by Image program}

interface

    uses
        QuickDraw, Palettes, Picker, PrintTraps, globals;{SANE}



    procedure SetDialogItem (TheDialog: DialogPtr; item, value: integer);
    procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
    function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
    function GetDString (TheDialog: DialogPtr; item: integer): str255;
    procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
    procedure GetWindowRect (w: WindowPtr; var wrect: rect);
    procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
    procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
    procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
    function StringToReal (str: str255): real;
    function GetDReal (TheDialog: DialogPtr; item: integer): extended;
    procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
    procedure DrawReal (Val: extended; width, fwidth: integer);
    procedure DrawJReal (hloc, vloc: integer; Val: extended; fwidth: integer);
    procedure DrawLong (i: LongInt);
    function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
    function GetReal (message: str255; default: extended; var Canceled: boolean): extended;
    function OptionKeyDown: boolean;
    function ShiftKeyDown: boolean;
    function ControlKeyDown: boolean;
    function CommandPeriod: boolean;
    function SpaceBarDown: boolean;

    procedure SysResume;
    procedure beep;
    procedure PutMessage (str: str255);
    procedure UnprotectLUT;
    procedure LoadLUT (table: MyCSpecArray);
    procedure SetupLutUndo;
    procedure UndoLutChange;
    procedure DisableDensitySlice;
    procedure LoadInputLookupTable (address: ptr);
    procedure ResetQuickCapture;
    procedure wait (ticks: LongInt);
    function GetScrapCount: integer;
    procedure DisplayText (update: boolean);
    procedure ScreenToOffscreen (var loc: point);
    procedure OffscreenToScreen (var loc: point);
    procedure OffScreenToScreenRect (var r: rect);
    procedure UpdateScreen (MaskRect: rect);
    procedure RestoreRoi;
    procedure Undo;
    procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
    procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
    function GetFontSize (item: integer): integer;
    function MyGetPixel (h, v: integer): integer;
    procedure PutPixel (h, v, value: integer);
    procedure GetLine (h, v, count: integer; var line: LineType);
    procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
    procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
    procedure PutLine (h, v, count: integer; var line: LineType);
    procedure Show1Value (rvalue, CalibratedValue: extended);
    procedure Show2CalibratedValues (x, y: LongInt; ShowUncalibrated: boolean);
    procedure Show2Values (current, total: LongInt);
    procedure DrawXDimension (x: real; digits: integer);
    procedure DrawYDimension (y: real; digits: integer);
    procedure DrawRGB (index: integer);
    procedure Show3Values (hloc, vloc, ivalue: LongInt);
    procedure ShowDxDy (X, Y: real);
    procedure PutChar (c: char);
    procedure PutTab;
    procedure PutString (str: str255);
    procedure PutReal (n: extended; width, fwidth: integer);
    procedure PutLong (n: LongInt; FieldWidth: integer);
    procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
    procedure ShowWatch;
    procedure UpdatePicWindow;
    procedure DoOperation (Operation: OpType);
    procedure SaveRoi;
    procedure KillRoi;
    procedure Paste;
    procedure ShowRoi;
    procedure SetupUndo;
    procedure SetupUndoFromClip;
    procedure GetLoi (var x1, y1, x2, y2: real);
    function NotRectangular: boolean;
    function NotInBounds: boolean;
    function NoSelection: boolean;
    function NoUndo: boolean;
    function NewPicWindow (name: str255; width, height: integer): boolean;
    procedure MakeRegion;
    procedure SelectAll (visible: boolean);
    procedure EraseScreen;
    procedure RestoreScreen;
    procedure UpdateTitleBar;
    procedure Unzoom;
    function FindMedian (var a: SortArray): integer;
    procedure DrawBString (str: string);
    procedure DrawMyGrowIcon (w: WindowPtr);
    procedure PutMemoryAlert;
    function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle; double: boolean): ptr;
    procedure UpdateAnalysisMenu;
    procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
    procedure MakeNewWindow (name: str255);
    procedure PutWarning;
    procedure ScaleToFit;
    procedure SetupRoiRect;
    procedure SetForegroundColor (color: integer);
    procedure SetBackgroundColor (color: integer);
    procedure GetForegroundColor (event: EventRecord);
    procedure GetBackgroundColor (event: EventRecord);
    procedure GenerateValues;
    procedure KillOperation;
    procedure ScaleImageWindow (var trect: rect);
    procedure InvertGrayLevels;
    function TooWide: boolean;
    procedure DrawTextString (str: str255; loc: point; just: integer);
    procedure IncrementCounter;
    procedure ClearResults (i: integer);
    procedure UpdateFitEllipse;
    procedure UpdateTextItems;


implementation


    type
        KeyPtrType = ^KeyMap;



{$PUSH}
{$D-}

    procedure MacsBug (str: str255);
    inline
        $abff;


    procedure SetDialogItem;{(TheDialog:DialogPtr; item,value:integer)}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        SetCtlValue(ControlHandle(ItemHdl), value)
    end;


    procedure OutlineButton;{(theDialog: DialogPtr; itemNo, CornerRad: integer)}
{ Draws a border around a button. 16 is the normal}
{  cornerRad for small buttons }
        var
            itemType: Integer;
            itemBox: Rect;
            itemHdl: Handle;
            tempPort: GrafPtr;
    begin
        GetPort(tempPort);
        SetPort(GrafPtr(theDialog));
        GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
        PenSize(3, 3);
        InSetRect(itemBox, -4, -4);
        FrameRoundRect(itemBox, cornerRad, cornerRad);
        PenSize(1, 1);
        SetPort(tempPort);
    end;


    function GetDNum;{(TheDialog:DialogPtr; item:integer):LongInt}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
            str: str255;
            n: LongInt;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        GetIText(ItemHdl, str);
        StringToNum(str, n);
        GetDNum := n;
    end;


    function GetDString;{(TheDialog:DialogPtr; item:integer):str255}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
            str: str255;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        GetIText(ItemHdl, str);
        GetDString := str;
    end;


    procedure SetDNum;{(TheDialog:DialogPtr; item:integer; n:LongInt)}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
            str: str255;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        NumToString(n, str);
        SetIText(ItemHdl, str)
    end;


    procedure GetWindowRect;{(w:WindowPtr; VAR wrect:rect)}
  {Returns global coordinates of specified window.}
    begin
        if w <> nil then
            wrect := WindowPeek(w)^.contRgn^^.rgnBBox
        else
            SetRect(wrect, 0, 0, 0, 0);
    end;


    procedure SetDReal;{(TheDialog:DialogPtr; item:integer; n:extended; fwidth:integer)}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
            str: str255;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        RealToString(n, 1, fwidth, str);
        SetIText(ItemHdl, str)
    end;

    procedure SetDString;{(TheDialog:DialogPtr; item:integer; str:str255)}
        var
            ItemType: integer;
            ItemBox: rect;
            ItemHdl: handle;
    begin
        GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
        SetIText(ItemHdl, str)
    end;


    function GetDReal;{(TheDialog:DialogPtr; item:integer):extended}
        var
            str: str255;
    begin
        str := GetDString(TheDialog, item);
        GetDReal := StringToReal(str);
    end;


    procedure DrawLong;{(i:LongInt)}
        var
            str: str255;
    begin
        NumToString(i, str);
        DrawString(str);
    end;


    procedure RealToString;{(Val:extended; width,fwidth:integer; var Str:Str255)}
  {Does number to string conversion equivalent to write(val:width:fwidth).}
{var}
{form: DecForm;}
    begin
        if fwidth < 0 then begin
                if val < 1.0 then
                    fwidth := 4
                else if trunc(val) = val then
                    fwidth := 0
                else
                    fwidth := 2;
            end;
        str := StringOf(val : width : fwidth); {Use LSP StringOf function because SANE Num2Str bombs out under A/UX}
{form.digits := fwidth;}
{form.style := FixedDecimal;}
{Num2Str(form, val, DecStr(str));}
{while length(Str) < width do begin}
{str := concat(' ', Str)}
{end;}
    end;


    procedure DrawReal;{(Val:extended; width,fwidth:integer)}
  {Displays a real(or integer) number at the current location in}
  {a form equivalent to write(val:width:fwidth) }
        var
            str: str255;
    begin
        RealToString(val, width, fwidth, str);
        DrawString(str);
    end;


    procedure DrawJReal (hloc, vloc: integer; val: extended; fwidth: integer);
  {Draws right justified real number.}
        var
            str: str255;
    begin
        if (val >= 1000.0) or (val <= -1000.0) then
            fwidth := 0;
        RealToString(val, 1, fwidth, str);
        MoveTo(hloc - StringWidth(str) - 2, vloc);
        DrawString(str);
    end;


    function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
        const
            NumberID = 3;
        var
            mylog: DialogPtr;
            item: integer;
            temp: LongInt;
    begin
        ParamText(message, '', '', '');
        mylog := GetNewDialog(3000, nil, pointer(-1));
        SetDNum(MyLog, NumberID, default);
        SelIText(MyLog, NumberID, 0, 32767);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
        until (item = ok) or (item = cancel);
        if item = ok then begin
                Canceled := false;
                temp := GetDNum(MyLog, NumberID);
                if (temp > -MaxInt) and (temp <= MaxInt) then
                    GetInt := temp
                else begin
                        SysBeep(1);
                        GetInt := default
                    end;
            end {item=ok}
        else begin
                Canceled := true;
                GetInt := default;
            end;
        DisposDialog(mylog);
    end;


    function GetReal (message: str255; default: extended; var Canceled: boolean): extended;
        const
            NumberID = 3;
        var
            mylog: DialogPtr;
            item: integer;
    begin
        InitCursor;
        ParamText(message, '', '', '');
        mylog := GetNewDialog(3000, nil, pointer(-1));
        SetDReal(MyLog, NumberID, default, 2);
        SelIText(MyLog, NumberID, 0, 32767);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
        until (item = ok) or (item = cancel);
        if item = ok then begin
                GetReal := GetDReal(MyLog, NumberID);
                Canceled := false;
            end
        else begin
                GetReal := default;
                Canceled := true;
            end;
        DisposDialog(mylog);
    end;


    function OptionKeyDown;{:boolean}
        var
            KeyPtr: KeyPtrType;
            keys: array[0..3] of LongInt;
    begin
        KeyPtr := KeyPtrType(@keys);
        GetKeys(KeyPtr^);
        OptionKeyDown := (BAND(keys[1], 4)) <> 0;
    end;


    function ShiftKeyDown;{:boolean}
        var
            KeyPtr: KeyPtrType;
            keys: array[0..3] of LongInt;
    begin
        KeyPtr := KeyPtrType(@keys);
        GetKeys(KeyPtr^);
        ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
    end;


    function ControlKeyDown;{:boolean}
        type
            KeyPtrType = ^KeyMap;
        var
            KeyPtr: KeyPtrType;
            keys: array[0..3] of LongInt;
    begin
        KeyPtr := KeyPtrType(@keys);
        GetKeys(KeyPtr^);
        ControlKeyDown := (BAND(keys[1], 8)) <> 0;
    end;


    function CommandPeriod;{:boolean}
        type
            KeyPtrType = ^KeyMap;
        var
            KeyPtr: KeyPtrType;
            keys: array[0..3] of LongInt;
    begin
        KeyPtr := KeyPtrType(@keys);
        GetKeys(KeyPtr^);
        CommandPeriod := (BAND(keys[1], $808000)) = $808000;
    end;


    function SpaceBarDown: boolean;
        var
            KeyPtr: KeyPtrType;
            keys: array[0..3] of LongInt;
    begin
        KeyPtr := KeyPtrType(@keys);
        GetKeys(KeyPtr^);
        SpaceBarDown := (BAND(keys[1], 512)) <> 0;
    end;


    procedure DrawSItem; {(itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255)}
{Draw a string item in a dialog box.}
        var
            r: rect;
            itype: integer;
            ignore: handle;
    begin
        getditem(d, itemnum, itype, ignore, r);
        textfont(fontrqst);
        textsize(sizerqst);
        textbox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
    end;


    procedure SysResume;
    begin
        FlushEvents(EveryEvent, 0);
        ExitToShell;
    end;


    procedure beep;
    begin
        SysBeep(1)
    end;


    procedure PutMessage;{(str:str255)}
        var
            ignore: integer;
    begin
        InitCursor;
        ParamText(str, '', '', '');
        Ignore := Alert(300, nil);
    end;

    function GetFontSize;{(item:integer):integer}
        var
            TempSize: integer;
            Canceled: boolean;
    begin
        case item of
            1:
                GetFontSize := 9;
            2:
                GetFontSize := 10;
            3:
                GetFontSize := 12;
            4:
                GetFontSize := 14;
            5:
                GetFontSize := 18;
            6:
                GetFontSize := 24;
            7:
                GetFontSize := 36;
            8:
                GetFontSize := 48;
            9:
                GetFontSize := 56;
            10:
                GetFontSize := 72;
            12:  begin
                    TempSize := GetInt('Font Size:', CurrentSize, Canceled);
                    if TempSize < 1 then
                        TempSize := 1;
                    if TempSize > 1000 then
                        TempSize := 1000;
                    if not canceled then
                        GetFontSize := TempSize
                    else
                        GetFontSize := CurrentSize;
                end;
        end;
    end;


    procedure SetMenuItem; {(menuh:menuhandle; itemnum:integer; on:boolean)}
{Enable or disable menuh's itemnum. }
    begin
        if on then
            EnableItem(menuh, itemnum)
        else
            DisableItem(menuh, itemnum);
        if ItemNum = 0 then
            DrawMenuBar;
    end;


    procedure CheckOnOffItem;{(MenuH:MenuHandle; item,fst,lst:Integer)}
        var
            i: integer;
    begin
        for i := fst to lst do
            if i = item then
                CheckItem(MenuH, i, true)
            else
                CheckItem(MenuH, i, false);
    end;


    procedure UpdateTextItems;
        var
            size, i, MenuItem, FontID, item: integer;
            FontName: str255;
            FontFound, FoundIt: boolean;
            str: str255;
    begin
        FontFound := false;
        for item := 1 to NumFontItems do begin
                GetItem(FontMenuH, Item, FontName);
                GetFNum(FontName, FontID);
                if FontID = CurrentFontID then begin
                        FontFound := true;
                        CheckItem(FontMenuH, Item, True)
                    end
                else
                    CheckItem(FontMenuH, Item, false);
            end;
        if not FontFound then begin
                FoundIt := False;
                Item := 1;
                repeat
                    GetItem(FontMenuH, Item, FontName);
                    GetFNum(FontName, FontID);
                    if FontID = Geneva then begin
                            CheckItem(FontMenuH, Item, True);
                            CurrentFontID := FontID;
                            FoundIt := true;
                        end;
                    Item := Item + 1;
                until (Item > NumFontItems) or FoundIt;
            end;

        for i := 1 to 10 do begin
                size := GetFontSize(i);
                if RealFont(CurrentFontID, size) then
                    SetItemStyle(SizeMenuH, i, [outline])
                else
                    SetItemStyle(SizeMenuH, i, [])
            end;
        NumToString(CurrentSize, str);
        str := concat('Other[', str, ']╔');
        SetItem(SizeMenuH, 12, str);

        for i := TxPlain to TxShadow do
            CheckItem(StyleMenuH, i, false);
        if CurrentStyle = [] then
            CheckItem(StyleMenuH, TxPlain, true)
        else begin
                if Bold in CurrentStyle then
                    CheckItem(StyleMenuH, TxBold, true);
                if Italic in CurrentStyle then
                    CheckItem(StyleMenuH, TxItalic, true);
                if Underline in CurrentStyle then
                    CheckItem(StyleMenuH, TxUnderline, true);
                if Outline in CurrentStyle then
                    CheckItem(StyleMenuH, TxOutline, true);
                if Shadow in CurrentStyle then
                    CheckItem(StyleMenuH, Txshadow, true);
            end;

        case CurrentSize of
            9:
                MenuItem := 1;
            10:
                MenuItem := 2;
            12:
                MenuItem := 3;
            14:
                MenuItem := 4;
            18:
                MenuItem := 5;
            24:
                MenuItem := 6;
            36:
                MenuItem := 7;
            48:
                MenuItem := 8;
            56:
                MenuItem := 9;
            72:
                MenuItem := 10;
            otherwise
                MenuItem := 12;
        end;
        CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);

        case TextJust of
            teJustLeft:
                MenuItem := LeftItem;
            teJustCenter:
                MenuItem := CenterItem;
            teJustRight:
                MenuItem := RightItem;
        end;
        CheckOnOffItem(StyleMenuH, MenuItem, LeftItem, RightItem);

        if TextBack = NoBack then
            MenuItem := NoBackgroundItem
        else
            MenuItem := WithBackgroundItem;
        CheckOnOffItem(StyleMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
    end;


{$POP}

    procedure LoadLUT (table: MyCSpecArray);
        var
            i, entry, screen: integer;
            cPtr: ^cSpecArray;
            SaveDevice: GDHandle;
    begin
        if nExtraColors > 0 then begin
                entry := FirstExtraColorsEntry;
                for i := 1 to nExtraColors do begin
                        table[entry].rgb := ExtraColors[i];
                        entry := entry + 1;
                    end;
            end;
        for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
            with table[i].rgb do
                if (red = 0) and (green = 0) and (blue = 0) then begin
                        red := 256;
                        green := 256;
                        blue := 256;
                    end;
        cPtr := @table[1];
        SaveDevice := GetGDevice;
        for screen := 1 to nMonitors do begin
                SetGDevice(Monitors[screen]);
                for i := 1 to 254 do begin
                        ProtectEntry(i, false);
                        ReserveEntry(i, false);
                    end;
                SetEntries(1, 253, cPtr^);
            end;
        SetGDevice(SaveDevice);
    end;


    procedure SetupLutUndo;
    begin
        with info^ do begin
                UndoInfo^.RedLut := RedLut;
                UndoInfo^.GreenLut := GreenLut;
                UndoInfo^.BlueLut := BlueLut;
                UndoInfo^.nColors := nColors;
                UndoInfo^.ColorStart := ColorStart;
                UndoInfo^.ColorEnd := ColorEnd;
                UndoInfo^.FillColor1 := FillColor1;
                UndoInfo^.FillColor2 := FillColor2;
                UndoInfo^.LutMode := LutMode;
                UndoInfo^.ColorTable := ColorTable;
                UndoInfo^.IdentityFunction := IdentityFunction;
                UndoInfo^.cTable := cTable;
                WhatToUndo := UndoLUT;
            end;
    end;


    procedure UndoLutChange;
    begin
        with info^ do begin
                RedLut := UndoInfo^.RedLut;
                GreenLut := UndoInfo^.GreenLut;
                BlueLut := UndoInfo^.BlueLut;
                nColors := UndoInfo^.nColors;
                ColorStart := UndoInfo^.ColorStart;
                ColorEnd := UndoInfo^.ColorEnd;
                FillColor1 := UndoInfo^.FillColor1;
                FillColor2 := UndoInfo^.FillColor2;
                LutMode := UndoInfo^.LutMode;
                LutMode := UndoInfo^.LutMode;
                ColorTable := UndoInfo^.ColorTable;
                cTable := UndoInfo^.cTable;
                LoadLut(cTable);
                Thresholding := false;
                WhatToUndo := NothingToUndo;
            end;
    end;


    procedure DisableDensitySlice;
    begin
        if DensitySlicing then begin
                DensitySlicing := false;
                UndoLutChange;
            end;
        Thresholding := false;
    end;


    procedure LoadInputLookupTable;{(address:ptr)}
        type
            ilutType = packed array[0..1023] of byte;
            ilutPtr = ^ilutType;
        var
            ilut: ilutPtr;
            i: integer;
    begin
        ilut := ilutPtr(address);
        if InvertVideo then begin
                for i := 0 to 255 do
                    ilut^[i * 4] := i;
                ilut^[0] := 1;
                ilut^[255 * 4] := 254
            end
        else begin
                for i := 0 to 255 do
                    ilut^[i * 4] := 255 - i;
                ilut^[0] := 254;
                ilut^[255 * 4] := 1
            end;
    end;


    procedure ResetQuickCapture;
        const
            ilutOffset = $90000;
    begin
        ControlReg^ := 1; {reset}
        while ControlReg^ < 0 do
            ;
        ChannelReg^ := VideoChannel * 64;
        while ControlReg^ < 0 do
            ;
        LoadInputLookupTable(Ptr(DTSlotBase + ilutOffset));
    end;


    procedure wait;{(ticks:LongInt)}
        var
            SaveTicks: LongInt;
    begin
        SaveTicks := TickCount + ticks;
        repeat
        until TickCount > SaveTicks;
    end;


    function GetScrapCount;{:integer}
        var
            ScrapInfo: PScrapStuff;
    begin
        ScrapInfo := InfoScrap;
        GetScrapCount := ScrapInfo^.ScrapCount;
    end;


    procedure DisplayText (update: boolean);
        var
            tPort: GrafPtr;
            i, hstart, width, ff: integer;
            MaskRect: rect;
            p1, p2: point;
    begin
        if (info = NoInfo) or (not IsInsertionPoint) then
            exit(DisplayText);
        if update then
            Undo;
        GetPort(tPort);
        SetPort(GrafPtr(Info^.osPort));
        TextFont(CurrentFontID);
        TextFace(CurrentStyle);
        TextSize(CurrentSize);
        if TextBack = NoBack then
            TextMode(SrcOr)
        else
            TextMode(SrcCopy);
        width := StringWidth(TextStr);
        case TextJust of
            teJustLeft:
                hstart := TextStart.h;
            teJustCenter:
                hstart := TextStart.h - width div 2;
            teJustRight:
                hstart := TextStart.h - width;
        end;
        if hstart < 0 then
            hstart := 0;
        MoveTo(hstart, TextStart.v);
        DrawString(TextStr);
        GetPen(InsertionPoint);
        ff := CurrentSize * 2;
        p1.h := hstart - ff;
        p1.v := TextStart.v - CurrentSize;
        p2.h := TextStart.h + width + ff;
        p2.v := TextStart.v + CurrentSize div 3;
        Pt2Rect(p1, p2, MaskRect);
        UpdateScreen(MaskRect);
        SetPort(tPort);
        Info^.changes := true;
    end;


    procedure OffScreenToScreenRect;{(VAR r:rect)}
        var
            p1, p2: point;
    begin
        with r do begin
                p1.h := left;
                p1.v := top;
                p2.h := right;
                p2.v := bottom;
                OffScreenToScreen(p1);
                OffScreenToScreen(p2);
                Pt2Rect(p1, p2, r);
            end;
    end;


    procedure ScreenToOffscreen;{(VAR loc:point)}
    begin
        with loc, Info^ do begin
                h := SrcRect.left + trunc(h / magnification);
                v := SrcRect.top + trunc(v / magnification);
            end;
    end;


    procedure OffscreenToScreen;{(VAR loc:point)}
    begin
        with loc, Info^ do begin
                h := trunc((h - SrcRect.left) * magnification);
                v := trunc((v - SrcRect.top) * magnification);
            end;
    end;


    procedure UpdateScreen;{(MaskRect:rect)}
{Refreshes the portion of the screen defined by}
{MaskRect, where MaskRect is defined in offscreen coordinates.}
        var
            tPort: GrafPtr;
            imag: integer;
    begin
        OffScreenToScreenRect(MaskRect);
        with Info^ do
            if info <> NoInfo then begin
                    getPort(tPort);
                    SetPort(wptr);
                    pmForeColor(BlackIndex);
                    pmBackColor(WhiteIndex);
                    imag := trunc(magnification);
                    InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
                    InsetRect(MaskRect, 0, 0);
                    RectRgn(MaskRgn, MaskRect);
                    hlock(handle(osPort^.portPixMap));
                    hlock(handle(CGrafPort(wptr^).PortPixMap));
                    CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
                    hunlock(handle(osPort^.portPixMap));
                    hunlock(handle(CGrafPort(wptr^).PortPixMap));
                    SetPort(tPort);
                end;
    end;


    procedure RestoreRoi;
    begin
        with Info^ do begin
                SetupUndo;
                if RoiShowing then
                    UpdateScreen(RoiRect);
                roiType := NoInfo^.roiType;
                RoiRect := NoInfo^.RoiRect;
                CopyRgn(NoInfo^.roiRgn, roiRgn);
                uLength := NoInfo^.uLength;
                cLength := NoInfo^.cLength;
                LX1 := NoInfo^.LX1;
                LY1 := NoInfo^.LY1;
                LX2 := NoInfo^.LX2;
                LY2 := NoInfo^.LY2;
                RoiShowing := true;
                measuring := false;
                nCoordinates := 0;
            end;
    end;


    procedure Undo;
        var
            SrcPtr: ptr;
            line: integer;
    begin
        if info^.PixMapSize <> CurrentUndoSize then
            exit(Undo);
        if UndoFromClip then begin
                if info^.PixMapSize > ClipBufSize then
                    exit(Undo);
                SrcPtr := ClipBuf;
            end
        else
            SrcPtr := UndoBuf;
        with info^ do
            BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
        if UndoFromClip and RestoreUndoBuf then
            with info^ do
                BlockMove(SrcPtr, UndoBuf, PixMapSize);
        if RedoSelection then
            RestoreRoi;
    end;


    function MyGetPixel;{(h,v:integer):integer}
        var
            offset: LongInt;
            p: ptr;
    begin
        with Info^ do begin
                if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then begin
                        MyGetPixel := BackgroundIndex;
                        exit(MyGetPixel);
                    end;
                offset := LongInt(v) * BytesPerRow + h;
                if offset >= PixMapSize then
                    exit(MyGetPixel);
                p := ptr(ord4(PicBaseAddr) + offset);
                MyGetPixel := BAND(p^, 255);
            end;
    end;


    procedure PutPixel;{(h,v,value:integer)}
        type
            uptr = ^UnsignedByte;
        var
            offset: LongInt;
            p: ptr;
    begin
        with Info^ do begin
                if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then
                    exit(PutPixel);
                offset := LongInt(v) * BytesPerRow + h;
                p := ptr(ord4(PicBaseAddr) + offset);
                p^ := BAND(value, 255);
            end;
    end;


    procedure GetLine (h, v, count: integer; var line: LineType);
        var
            offset: LongInt;
            p: ptr;
    begin
        with Info^ do begin
                if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
                        line := BlankLine^;
                        exit(GetLine);
                    end;
                offset := LongInt(v) * BytesPerRow + h;
                p := ptr(ord4(PicBaseAddr) + offset);
                BlockMove(p, @line, count);
            end;
    end;


    procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
        var
            i, v: integer;
    begin
        if count > MaxLine then
            count := MaxLine;
        v := vstart;
        for i := 0 to count - 1 do begin
                data[i] := MyGetPixel(hstart, v);
                v := v + 1;
            end;
    end;


    procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
        var
            i, v: integer;
    begin
        if count > MaxLine then
            count := MaxLine;
        v := vstart;
        for i := 0 to count - 1 do begin
                PutPixel(hstart, v, data[i]);
                v := v + 1;
            end;
    end;


    procedure PutLine (h, v, count: integer; var line: LineType);
        var
            offset: LongInt;
            p: ptr;
    begin
        with Info^ do begin
                if (h < 0) or (v < 0) or (v >= nlines) then
                    exit(PutLine);
                if (h + count) > PixelsPerLine then
                    count := PixelsPerLine - h;
                offset := LongInt(v) * BytesPerRow + h;
                p := ptr(ord4(PicBaseAddr) + offset);
                BlocKMove(@line, p, count);
            end;
    end;


    procedure Show1Value (rvalue, CalibratedValue: extended);
        var
            tPort: GrafPtr;
            hstart, vstart, ivalue: integer;
    begin
        hstart := ValuesHStart;
        vstart := ValuesVStart;
        GetPort(tPort);
        SetPort(ValuesWindow);
        TextSize(9);
        TextFont(Monaco);
        TextMode(SrcCopy);
        MoveTo(xValueLoc, vstart);
        if CalibratedValue <> NoValue then begin
                DrawReal(CalibratedValue, 5, 2);
                DrawString(' (');
                DrawReal(rvalue, 3, 0);
                DrawString(')');
            end
        else
            DrawReal(rvalue, 6, 2);
        DrawString('    ');
        SetPort(tPort);
    end;


    procedure Show2CalibratedValues; {(x, y: LongInt; ShowUncalibrated: boolean)}
        var
            tPort: GrafPtr;
            hstart, vstart, ivalue: integer;
    begin
        hstart := ValuesHStart;
        vstart := ValuesVStart;
        GetPort(tPort);
        SetPort(ValuesWindow);
        TextSize(9);
        TextFont(Monaco);
        TextMode(SrcCopy);
        MoveTo(xValueLoc, vstart);
        DrawLong(x);
        DrawString('     ');
        MoveTo(yValueLoc, vstart + 10);
        if info^.DensityCalibrated then begin
                DrawReal(cvalue[y], 5, 2);
                if ShowUncalibrated then begin
                        DrawString(' (');
                        DrawLong(y);
                        DrawString(')');
                    end;
            end
        else
            DrawLong(y);
        DrawString('     ');
        SetPort(tPort);
    end;


    procedure Show2Values (current, total: LongInt);
        var
            tPort: GrafPtr;
            hstart, vstart, ivalue: integer;
    begin
        hstart := ValuesHStart;
        vstart := ValuesVStart;
        GetPort(tPort);
        SetPort(ValuesWindow);
        TextSize(9);
        TextFont(Monaco);
        TextMode(SrcCopy);
        MoveTo(xValueLoc, vstart);
        DrawLong(current);
        DrawString('     ');
        MoveTo(yValueLoc, vstart + 10);
        DrawLong(total);
        DrawString('     ');
        SetPort(tPort);
    end;


    procedure DrawXDimension (x: real; digits: integer);
    begin
        with info^ do begin
                if SpatiallyCalibrated then begin
                        DrawReal(x / xSpatialScale, 5, 2);
                        DrawString(units);
                        DrawString(' (');
                        DrawReal(x, 3, digits);
                        DrawString(')')
                    end
                else
                    DrawReal(x, 1, digits);
                DrawString('      ');
            end;
    end;


    procedure DrawYDimension (y: real; digits: integer);
    begin
        with info^ do begin
                if SpatiallyCalibrated then begin
                        DrawReal(y / ySpatialScale, 5, 2);
                        DrawString(units);
                        DrawString(' (');
                        DrawReal(y, 3, digits);
                        DrawString(')')
                    end
                else
                    DrawReal(y, 1, digits);
                DrawString('      ');
            end;
    end;


    procedure DrawRGB (index: integer);
        var
            rStr, gStr, bStr: str255;
            TempRGB: rgbColor;
            i, entry: integer;

        procedure Convert (n: integer; var str: str255);
            var
                i: integer;
        begin
            RealToString(n, 3, 0, str);
            for i := 1 to 3 do
                if str[i] = ' ' then
                    str[i] := '0';
        end;

    begin
        TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb;
        with TempRGB do begin
                Convert(band(bsr(red, 8), 255), rStr);
                Convert(band(bsr(green, 8), 255), gStr);
                Convert(band(bsr(blue, 8), 255), bStr);
                DrawString(concat(rStr, ' ', gStr, ' ', bStr));
            end;
    end;


    procedure Show3Values;{(hloc,vloc,ivalue:LongInt)}
        var
            tPort: GrafPtr;
            hstart, vstart: integer;
    begin
        with info^ do begin
                hstart := ValuesHStart;
                vstart := ValuesVStart;
                GetPort(tPort);
                SetPort(ValuesWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                if hloc < 0 then
                    hloc := -hloc;
                MoveTo(xValueLoc, vstart);
                DrawXDimension(hloc, 0);
                if InvertYCoordinates and (ivalue >= 0) then
                    vloc := PicRect.bottom - vloc - 1;
                if vloc < 0 then
                    vloc := -vloc;
                MoveTo(yValueLoc, vstart + 10);
                DrawYDimension(vloc, 0);
                DrawString('    ');
                if ivalue >= 0 then begin
                        MoveTo(zValueLoc, vstart + 20);
                        if DensityCalibrated or (CurrentTool = PickerTool) then begin
                                if CurrentTool = PickerTool then
                                    DrawRGB(ivalue)
                                else
                                    DrawReal(cvalue[ivalue], 5, precision);
                                DrawString(' (');
                                DrawLong(ivalue);
                                DrawString(')');
                            end
                        else
                            DrawLong(ivalue);
                    end;
                DrawString('    ');
                SetPort(tPort);
            end;
    end;


    procedure ShowDxDy (X, Y: real);
        var
            tPort: GrafPtr;
            hstart, vstart, ivalue: integer;
    begin
        with info^ do begin
                hstart := ValuesHStart;
                vstart := ValuesVStart;
                GetPort(tPort);
                SetPort(ValuesWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                MoveTo(xValueLoc, vstart);
                DrawXDimension(x, 2);
                MoveTo(yValueLoc, vstart + 10);
                DrawYDimension(y, 2);
                MoveTo(zValueLoc, vstart + 20);
                if SpatiallyCalibrated then begin
                        DrawReal(sqrt(sqr(x / xSpatialScale) + sqr(y / ySpatialScale)), 5, 2);
                        DrawString(units);
                        DrawString(' (');
                        DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
                        DrawString(')')
                    end
                else
                    DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
                DrawString('    ');
                SetPort(tPort);
            end;
    end;


    procedure PutChar;{(c:char)}
    begin
        if TextBufSize < MaxTextBufSize then begin
                TextBufSize := TextBufSize + 1;
                TextBufP^[TextBufSize] := c;
                if c = cr then begin
                        TextBufColumn := 0;
                        TextBufLineCount := TextBufLineCount + 1
                    end
                else
                    TextBufColumn := TextBufColumn + 1;
            end;
    end;


    procedure PutTab;
    begin
        if not printing then
            PutChar(tab)
    end;


    procedure PutString (str: str255);
        var
            i: integer;
    begin
        for i := 1 to length(str) do begin
                if TextBufSize < MaxTextBufSize then
                    TextBufSize := TextBufSize + 1;
                TextBufP^[TextBufSize] := str[i];
                TextBufColumn := TextBufColumn + 1;
            end;
    end;


    procedure PutFString (str: str255; FieldWidth: integer);
        var
            LeadingSpaces: integer;
    begin
        LeadingSpaces := FieldWidth - length(str);
        if LeadingSpaces > 0 then
            str := concat(copy('            ', 1, LeadingSpaces), str);
        PutString(str);
    end;


    procedure PutReal;{(n:extended; width,fwidth:integer)}
        var
            str: str255;
    begin
        RealToString(n, width, fwidth, str);
        PutString(str);
    end;


    procedure PutLong (n: LongInt; FieldWidth: integer);
        var
            str: str255;
            LeadingSpaces: integer;
    begin
        NumToString(n, str);
        LeadingSpaces := FieldWidth - length(str);
        if LeadingSpaces > 0 then
            str := concat(copy('            ', 1, LeadingSpaces), str);
        PutString(str);
    end;


    procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
        var
            i, column, fwidth: integer;
            m: MeasurementTypes;

        procedure PutSequenceNumber;
        begin
            PutLong(i, 4);
            PutChar('.');
            PutTab;
        end;

        procedure PutUnits;
        begin
            if info^.SpatiallyCalibrated then begin
                    PutString('  (');
                    PutString(info^.Units);
                    PutString(')')
                end
            else
                PutString('(Pixels)');
            PutChar(cr);
            PutChar(cr);
        end;

        procedure PutTabDelimeter;
        begin
            Column := Column + 1;
            if Column <> nListColumns then
                PutTab;
        end;

    begin
        if mCount < 1 then begin
                TextBufSize := 0;
                TextBufLineCount := 0;
                exit(CopyResultsToBuffer);
            end;
        ShowWatch;
        Headings := Headings or OptionKeyWasDown;
        TextBufSize := 0;
        TextBufColumn := 0;
        TextBufLineCount := 0;
        nListColumns := 0;
        for m := AreaM to StdDevM do
            if m in Measurements then
                nListColumns := nListColumns + 1;
        if (xyLocM in measurements) or (nPoints > 0) then
            nListColumns := nListColumns + 2;
        if ModeM in measurements then
            nListColumns := nListColumns + 1;
        if (LengthM in measurements) or (nLengths > 0) then
            nListColumns := nListColumns + 1;
        if MajorAxisM in measurements then
            nListColumns := nListColumns + 1;
        if MinorAxisM in measurements then
            nListColumns := nListColumns + 1;
        if (AngleM in measurements) or (nAngles > 0) then
            nListColumns := nListColumns + 1;
        if IntDenM in measurements then
            nListColumns := nListColumns + 2;
        if MinMaxM in measurements then
            nListColumns := nListColumns + 2;
        if User1M in measurements then
            nListColumns := nListColumns + 1;
        if User2M in measurements then
            nListColumns := nListColumns + 1;
        with info^ do begin
                fwidth := FieldWidth;
                if Headings and (FirstCount = 1) then begin
                        PutFString(' ', 5);
                        PutTabDelimeter;
                        if AreaM in measurements then begin
                                PutFString('Area', fwidth);
                                PutTabDelimeter;
                            end;
                        if MeanM in measurements then begin
                                PutFString('Mean', fwidth);
                                PutTabDelimeter;
                            end;
                        if StdDevM in measurements then begin
                                PutFString('S.D.', fwidth);
                                PutTabDelimeter;
                            end;
                        if (xyLocM in measurements) or (nPoints > 0) then begin
                                PutFString('X', fwidth);
                                PutTabDelimeter;
                                PutFString('Y', fwidth);
                                PutTabDelimeter;
                            end;
                        if ModeM in measurements then begin
                                PutFString('Mode', fwidth);
                                PutTabDelimeter;
                            end;
                        if (LengthM in measurements) or (nLengths > 0) then begin
                                PutFString('Length', fwidth);
                                PutTabDelimeter;
                            end;
                        if MajorAxisM in measurements then begin
                                PutFString(MajorLabel, fwidth);
                                PutTabDelimeter;
                            end;
                        if MinorAxisM in measurements then begin
                                PutFString(MinorLabel, fwidth);
                                PutTabDelimeter;
                            end;
                        if (AngleM in measurements) or (nAngles > 0) then begin
                                PutFString('Angle', fwidth);
                                PutTabDelimeter;
                            end;
                        if IntDenM in measurements then begin
                                PutFString('Int.Den.', fwidth + 2);
                                PutTabDelimeter;
                                PutFString('Back.', fwidth);
                                PutTabDelimeter;
                            end;
                        if MinMaxM in measurements then begin
                                PutFString('Min', fwidth);
                                PutTabDelimeter;
                                PutFString('Max', fwidth);
                                PutTabDelimeter;
                            end;
                        if User1M in measurements then begin
                                PutFString(User1Label, fwidth);
                                PutTabDelimeter;
                            end;
                        if User2M in measurements then begin
                                PutFString(User2Label, fwidth);
                                PutTabDelimeter;
                            end;
                        PutChar(cr);
                        PutChar(cr);
                    end;
                for i := FirstCount to LastCount do begin
                        column := 0;
                        if Headings then
                            PutSequenceNumber;
                        if AreaM in measurements then begin
                                PutReal(mArea^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if MeanM in measurements then begin
                                PutReal(mean^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if StdDevM in measurements then begin
                                PutReal(sd^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if (xyLocM in measurements) or (nPoints > 0) then begin
                                PutReal(xcenter^[i], fwidth, precision);
                                PutTab;
                                PutReal(ycenter^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if ModeM in measurements then begin
                                PutReal(mode^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if (LengthM in measurements) or (nLengths > 0) then begin
                                PutReal(plength^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if MajorAxisM in measurements then begin
                                PutReal(MajorAxis^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if MinorAxisM in measurements then begin
                                PutReal(MinorAxis^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if (AngleM in measurements) or (nAngles > 0) then begin
                                PutReal(orientation^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if IntDenM in measurements then begin
                                PutReal(IntegratedDensity^[i], fwidth + 2, precision);
                                PutTabDelimeter;
                                PutReal(idBackground^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if MinMaxM in measurements then begin
                                PutReal(mMin^[i], fwidth, precision);
                                PutTabDelimeter;
                                PutReal(mMax^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if User1M in measurements then begin
                                PutReal(User1^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        if User2M in measurements then begin
                                PutReal(User2^[i], fwidth, precision);
                                PutTabDelimeter;
                            end;
                        PutChar(cr);
                    end; {for}
            end; {with}
    end;


    procedure ShowWatch;
    begin
        SetCursor(watch);
    end;


    procedure UpdatePicWindow;
        var
            tPort: GrafPtr;
    begin
        if info <> NoInfo then
            with Info^ do begin
                    getPort(tPort);
                    SetPort(wptr);
                    pmForeColor(BlackIndex);
                    pmBackColor(WhiteIndex);
                    hlock(handle(osPort^.portPixMap));
                    hlock(handle(CGrafPort(wptr^).PortPixMap));
                    CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
                    hunlock(handle(osPort^.portPixMap));
                    hunlock(handle(CGrafPort(wptr^).PortPixMap));
                    SetPort(tPort);
                    RoiUpdateTime := 0;
                end;
    end;


    procedure DoOperation;{(Operation:OpType)}
        var
            tPort: GrafPtr;
            loc: point;
            width, height, SaveWidth: integer;
            tRect: rect;
    begin
        GetPort(tPort);
        with Info^ do begin
                changes := true;
                SetPort(GrafPtr(osPort));
                PenNormal;
                case Operation of
                    InvertOp:
                        InvertRgn(roiRgn);
                    PaintOp:
                        PaintRgn(roiRgn);
                    FrameOp:  begin
                            if (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiTYpe = SegLineRoi) then
                                PenSize(1, 1)
                            else
                                PenSize(LineWidth, LineWidth);
                            FrameRgn(roiRgn);
                        end;
                    EraseOp:
                        EraseRgn(roiRgn);
                    PasteOp:
                        Paste;
                    otherwise
                end;
                if not RoiShowing then
                    UpdateScreen(RoiRect);
                if PixMapSize > UndoBufSize then
                    OpPending := false;
            end;
        SetPort(tPort);
    end;


    procedure SaveRoi;
    begin
        with info^ do
            if RoiType <> noRoi then begin
                    NoInfo^.roiType := roiType;
                    NoInfo^.RoiRect := RoiRect;
                    CopyRgn(roiRgn, NoInfo^.roiRgn);
                    NoInfo^.uLength := uLength;
                    NoInfo^.cLength := cLength;
                    NoInfo^.LX1 := LX1;
                    NoInfo^.LY1 := LY1;
                    NoInfo^.LX2 := LX2;
                    NoInfo^.LY2 := LY2;
                end;
    end;


    procedure KillRoi;
        var
            trect: rect;
    begin
        with info^ do begin
                if RoiShowing then begin
                        if OpPending then begin
                                OpPending := false;
                                DoOperation(CurrentOp);
                            end;
                        SaveRoi;
                        RoiShowing := false;
                        trect := RoiRect;
                        if RoiType = LineRoi then
                            InsetRect(trect, -RoiHandleSize, -RoiHandleSize);
                        UpdateScreen(trect);
                    end;
                RoiType := NoRoi;
                RoiUpdateTime := 0;
            end;
    end;


    procedure Paste;
        var
            srcPort: cGrafPtr;
    begin
        if info = NoInfo then begin
                beep;
                exit(Paste)
            end;
        with Info^ do begin
                if not RoiShowing then
                    exit(Paste);
                if PasteTransferMode = SrcCopy then begin
                        pmForeColor(BlackIndex);
                        pmBackColor(WhiteIndex);
                    end;
                srcPort := ClipBufInfo^.osPort;
                if LivePasteMode then
                    if (WhatsOnClip = CameraPic) and (QuickCaptureInfo <> nil) and (PictureType <> QuickCaptureType) then begin
                            ControlReg^ := BitAnd($80, 255); {Start frame capture}
                            while ControlReg^ < 0 do
                                ;       {Wait for it to complete}
                            srcPort := qcPort;
                        end;
                hlock(handle(srcPort^.portPixMap));
                hlock(handle(osPort^.portPixMap));
                CopyBits(BitMapHandle(srcPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
                hunlock(handle(srcPort^.portPixMap));
                hunlock(handle(osPort^.PortPixMap));
                if PasteTransferMode = SrcCopy then begin
                        pmForeColor(ForegroundIndex);
                        pmBackColor(BackgroundIndex);
                    end;
            end;
    end;


    procedure ShowRoi;
    begin
        with info^ do
            if RoiType <> NoRoi then begin
                    SetupUndo;
                    RoiShowing := true;
                end;
    end;


    procedure SetupUndo;
        var
            line: integer;
    begin
        WhatToUndo := NothingToUndo;
        if info = NoInfo then begin
                CurrentUndoSize := 0;
                exit(SetupUndo)
            end;
        with info^ do begin
                if PixMapSize > UndoBufSize then begin
                        CurrentUndoSize := 0;
                        exit(SetupUndo)
                    end;
                if OpPending then begin
                        DoOperation(CurrentOp);
                        OpPending := false;
                    end;
                CurrentUndoSize := PixMapSize;
                BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
                UndoFromClip := false;
                RedoSelection := false;
            end;
    end;


    procedure SetupUndoFromClip;
        var
            line: integer;
    begin
        WhatToUndo := NothingToUndo;
        if info = NoInfo then begin
                CurrentUndoSize := 0;
                exit(SetupUndoFromClip)
            end;
        with info^ do begin
                if PixMapSize > ClipBufSize then begin
                        CurrentUndoSize := 0;
                        exit(SetupUndoFromClip)
                    end;
                if OpPending then begin
                        DoOperation(CurrentOp);
                        OpPending := false;
                    end;
                CurrentUndoSize := PixMapSize;
                BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
            end;
        WhatsOnClip := nothing;
        UndofromClip := true;
        RedoSelection := false;
    end;


    function NoSelection;{:boolean}
    begin
        if Info = NoInfo then begin
                beep;
                NoSelection := true;
                exit(NoSelection);
            end;
        if not Info^.RoiShowing then begin
                PutMessage('Please use a selection tool to make a selection or use the Select All command.');
                macro := false;
            end;
        NoSelection := not Info^.RoiShowing;
    end;


    function NotRectangular;{:boolean}
    begin
        with info^ do
            if RoiShowing and (RoiType <> RectRoi) then begin
                    PutMessage('This operation requires a rectangular selection.');
                    NotRectangular := true;
                    macro := false;
                end
            else
                NotRectangular := false;
    end;


    procedure GetLoi (var x1, y1, x2, y2: real);
    begin
        with info^, info^.RoiRect do begin
                x1 := left + LX1;
                y1 := top + LY1;
                x2 := left + LX2;
                y2 := top + LY2;
            end;
    end;


    function NotInBounds;{:boolean}
        var
            x1, y1, x2, y2: real;
    begin
        NotInBounds := false;
        with info^, info^.RoiRect do
            if RoiShowing then begin
                    if RoiType = LineRoi then begin
                            GetLoi(x1, y1, x2, y2);
                            if (x1 >= 0.0) and (y1 >= 0.0) and (x2 <= right) and (y2 <= bottom) then
                                exit(NotInBounds);
                        end;
                    if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
                            PutMessage('This operation requires the selection to be entirely within the image.');
                            NotInBounds := true;
                            macro := false;
                        end;
                end;
    end;


    function NoUndo: boolean;
        var
            ImageTooLarge: boolean;
    begin
        with info^ do
            ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
        if ImageTooLarge then
            PutMessage('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
        NoUndo := ImageTooLarge;
    end;


    procedure PutMemoryAlert;
    begin
        PutMessage('Sorry, but there is not enough memory available to open this image. Try closing some windows.');
        macro := false;
    end;


    procedure CompactMemory;
        var
            size: LongInt;
            TempInfo: InfoPtr;
            i: integer;
    begin
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                hunlock(TempInfo^.PicBaseHandle)
            end;
        size := 4000000;
        PurgeMem(size);
        size := CompactMem(size);
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                with TempInfo^ do begin
                        hlock(PicBaseHandle);
                        PicBaseAddr := StripAddress(PicBaseHandle^);
                        osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
                    end;
            end;
    end;


    function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle; double: boolean): ptr;
{Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
{A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
{Would you believe up to 10 seconds when many windows are open?}
        var
            h: handle;
            FreeMem, NeededSize: LongInt;
    begin
        with info^ do begin
                if odd(PixelsPerLine) then
                    BytesPerRow := PixelsPerLine + 1
                else
                    BytesPerRow := PixelsPerLine;
                PixMapSize := LongInt(nlines) * BytesPerRow;
                ImageSize := LongInt(nlines) * PixelsPerLine;
                NeededSize := PixMapSize;
                if double then
                    NeededSize := NeededSize * 2;
                h := NewHandle(NeededSize);
            end;
        FreeMem := MaxBlock;
        if (h = nil) or (FreeMem < MinFree) then begin
                if h <> nil then
                    DisposHandle(h);
                CompactMemory;
                h := NewHandle(NeededSize);
                FreeMem := MaxBlock;
            end;
        if (h = nil) or (FreeMem < MinFree) then begin
                if h <> nil then
                    DisposHandle(h);
                PutMemoryAlert;
                DisposPtr(pointer(Info));
                Info := SaveInfo;
                GetImageMemory := nil;
                exit(GetImageMemory);
            end;
        PicBaseHandle := h;
        hlock(PicBaseHandle);
        GetImageMemory := StripAddress(PicBaseHandle^);
    end;


    function OldGetMemory (Size: LongInt; SaveInfo: infoPtr; var PicBaseHandle: handle): ptr;
        var
            h1, h2: handle;
    begin
        h1 := NewHandle(size);
        h2 := NewHandle(MinFree);
        if (h1 = nil) or (h2 = nil) then begin
                if h1 <> nil then
                    DisposHandle(h1);
                if h2 <> nil then
                    DisposHandle(h2);
                CompactMemory;
                h1 := NewHandle(size);
                h2 := NewHandle(MinFree);
            end;
        if (h1 = nil) or (h2 = nil) then begin
                if h1 <> nil then
                    DisposHandle(h1);
                if h2 <> nil then
                    DisposHandle(h2);
                PutMemoryAlert;
                DisposPtr(pointer(Info));
                Info := SaveInfo;
                OldGetMemory := nil;
                exit(OldGetMemory);
            end;
        DisposHandle(h2);
        PicBaseHandle := h1;
        hlock(PicBaseHandle);
        OldGetMemory := PicBaseHandle^;
    end;


    procedure UpdateAnalysisMenu;
        var
            ShowItems: boolean;
            i: integer;
    begin
        ShowItems := Info <> NoInfo;
        SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
        SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
        SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
        SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
        SetMenuItem(AnalyzemenuH, PlotSurfaceItem, ShowItems);
        SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
        SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
        SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
        SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
        SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
        SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
    end;


    procedure ExtendWindowsMenu;{(fname:str255; size:LongInt; wptr:WindowPtr)}
        var
            str, SizeStr: str255;
    begin
        if nPics < MaxPics then begin
                nPics := nPics + 1;
                PicWindow[nPics] := wptr;
                NumToString(size div 1024, SizeStr);
                str := concat(fname, '  ', SizeStr, 'K');
                AppendMenu(WindowsMenuH, ' ');
                SetItem(WindowsMenuH, nPics + WindowsMenuItems, str);
                InsertMenu(WindowsMenuH, 0);
            end;
    end;


    procedure InvertGrayLevels;
    begin
        with info^ do begin
                DensityCalibrated := true;
                nCoefficients := 2;
                fit := StraightLine;
                Coefficient[1] := 255.0;
                Coefficient[2] := -1.0;
                ZeroClip := false;
                UpdateTitleBar;
            end;
    end;


    procedure MakeNewWindow;{(name:str255)}
        var
            wwidth, wheight, wleft, wtop, i: integer;
            tPort: GrafPtr;
            rgb: RGBColor;
            err: OSErr;
            str: str255;
    begin
        with Info^ do begin
                wleft := PicLeft;
                wtop := PicTop;
                PicLeft := PicLeft + hPicOffset;
                PicTop := PicTop + vPicOffset;
                if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
                        PicLeft := PicLeftBase;
                        PicTop := PicTopBase;
                    end;
                wwidth := PixelsPerLine;
                if (wleft + wwidth) > ScreenWidth then
                    wwidth := ScreenWidth - wleft - 4;
                wheight := nlines;
                if (wtop + wheight) > ScreenHeight then
                    wheight := ScreenHeight - wtop - 4;
                SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
                str := name;
                if SpatiallyCalibrated then
                    str := concat(str, chr($13)); {Black Diamond}
                if DensityCalibrated then
                    str := concat(str, '╫');
                wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
                GetPort(tPort);
                SetPort(wptr);
                SetPalette(wptr, ExplicitPalette, false);
                pmForeColor(BlackIndex);
                pmBackColor(WhiteIndex);
                SetRect(wrect, 0, 0, wwidth, wheight);
                SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
                SelectWindow(wptr);
                WindowPeek(wptr)^.WindowKind := PicKind;
                WindowPeek(wptr)^.RefCon := ord4(Info);
                title := name;
                ExtendWindowsMenu(name, ImageSize, wptr);
                PicNum := nPics;
                new(osPort);
                OpenCPort(osPort);
                with osPort^ do begin
                        with PortPixMap^^ do begin
                                BaseAddr := PicBaseAddr;
                                bounds := PicRect;
                            end;
                        PortRect := PicRect;
                        RectRgn(visRgn, PicRect);
                        PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
                    end;
                SetPalette(WindowPtr(osPort), ExplicitPalette, false);
                pmForeColor(ForegroundIndex);
                pmBackColor(BackgroundIndex);
                SetPort(tPort);
                SrcRect := wrect;
                magnification := 1.0;
                RoiShowing := false;
                roiType := NoRoi;
                initwrect := wrect;
                savewrect := wrect;
                SaveSrcRect := SrcRect;
                SaveMagnification := magnification;
                savehloc := wleft;
                savevloc := wtop;
                roiRgn := NewRgn;
                NewPic := true;
                ScaleToFitWindow := false;
                OpPending := false;
                Changes := false;
                WindowState := NormalWindow;
                if not DensityCalibrated and InvertPixelValues then
                    InvertGrayLevels;
                Revertable := false;
                nCoordinates := 0;
            end;
        WhatToUndo := NothingToUndo;
    end;


    procedure MakeRegion;
        var
            deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
            tPort: GrafPtr;

        procedure SwapEnds;
        begin
            xt := x1;
            yt := y1;
            x1 := x2;
            y1 := y2;
            x2 := xt;
            y2 := yt;
        end;

    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(wptr);
                x1 := trunc(LX1);
                y1 := trunc(LY1);
                x2 := trunc(LX2);
                y2 := trunc(LY2);
                OpenRgn;
                case RoiType of
                    LineRoi:  begin
                            deltax := abs(x2 - x1);
                            deltay := abs(y2 - y1);
                            if (deltax = 0) and (deltay = 0) then begin
                                    MoveTo(x1, y1);
                                    LineTo(x1 + LineWidth, y1);
                                    LineTo(x1 + LineWidth, y1 + LineWidth);
                                    LineTo(x1, y1 + LineWidth);
                                end
                            else if deltax < deltay then begin
                                    if y1 > y2 then
                                        SwapEnds;
                                    MoveTo(x1, y1);
                                    LineTo(x2, y2);
                                    LineTo(X2, y2 + 1);
                                    LineTo(X2 + LineWidth, y2 + 1);
                                    LineTo(x2 + LineWidth, y2);
                                    LineTo(x1 + LineWidth, y1);
                                end
                            else begin
                                    if x1 > x2 then
                                        SwapEnds;
                                    MoveTo(x1, y1);
                                    LineTo(x2, y2);
                                    LineTo(x2 + 1, y2);
                                    LineTo(x2 + 1, y2 + LineWidth);
                                    LineTo(x2, y2 + LineWidth);
                                    LineTo(x1, y1 + LineWidth);
                                end;
                            LineTo(x1, y1);
                        end;
                    OvalRoi:
                        FrameOval(RoiRect);
                    RectRoi:
                        FrameRect(RoiRect);
                    otherwise
                end;
                CloseRgn(roiRgn);
                if RoiType = LineRoi then begin
                        RoiRect := roiRgn^^.rgnBBox;
                        with RoiRect do begin
                                LX1 := LX1 - left;
                                LY1 := LY1 - top;
                                LX2 := LX2 - left;
                                LY2 := LY2 - top;
                            end;
                    end;
            end;
        SetPort(tPort);
    end;


    procedure SelectAll;{(visible:boolean)}
        var
            loc: point;
            tPort: GrafPtr;
    begin
        if info <> NoInfo then
            with Info^ do begin
                    KillRoi;
                    RoiType := RectRoi;
                    RoiRect := PicRect;
                    MakeRegion;
                    if visible then begin
                            SetupUndo;
                            RoiShowing := true;
                            if (magnification > 1.0) and not ScaleToFitWindow then
                                Unzoom;
                            PreviousTool := CurrentTool;
                            CurrentTool := SelectionTool;
                            isSelectionTool := true;
                            GetPort(tPort);
                            SetPort(ToolWindow);
                            EraseRect(ToolRect[PreviousTool]);
                            EraseRect(ToolRect[CurrentTool]);
                            InvalRect(ToolRect[PreviousTool]);
                            InvalRect(ToolRect[CurrentTool]);
                            SetPort(tPort);
                        end;
                    IsInsertionPoint := false;
                    measuring := false;
                end; {with}
    end;


    procedure KillOperation;
    begin
        if OpPending then
            with info^ do
                if info <> NoInfo then begin
                        DoOperation(CurrentOp);
                        RoiShowing := false;
                        UpdateScreen(RoiRect);
                        OpPending := false;
                    end;
    end;


    function NewPicWindow;{(name:str255; width,height:integer):boolean}
        var
            iptr: ptr;
            lptr: ^LongInt;
            SaveInfo: InfoPtr;
            NeededSize: LongInt;
    begin
        NewPicWindow := false;
        if nPics = MaxPics then
            exit(NewPicWindow);
        KillOperation;
        DisableDensitySlice;
        SaveInfo := Info;
        iptr := NewPtr(SizeOf(PicInfo));
        if iptr = nil then begin
                DisposPtr(iptr);
                PutMemoryAlert;
                macro := false;
                exit(NewPicWindow);
            end;
        Info := pointer(iptr);
        info^ := SaveInfo^;
        with Info^ do begin
                nlines := height;
                PixelsPerLine := width;
                PicBaseAddr := GetImageMemory(SaveInfo, PicBaseHandle, false);
                if PicBaseAddr = nil then
                    exit(NewPicWindow);
                PicLeft := PicLeftBase;
                PicTop := PicTopBase;
                MakeNewWindow(name);
                PictureType := NewPicture;
                SelectAll(false);
                DoOperation(EraseOp);
                RoiType := NoRoi;
                changes := false;
                BinaryPic := false;
                StackInfo := nil;
                nCoordinates := 0;
            end;
        NewPicWindow := true;
    end;


    procedure EraseScreen;
    begin
        SetPort(GrafPtr(CScreenPort));
        with CScreenPort^ do begin
                HideCursor;
                pmBackColor(BackgroundIndex);
                EraseRect(portPixMap^^.Bounds);
                pmBackColor(WhiteIndex);
            end;
    end;


    procedure RestoreScreen;
        var
            GrayRgn: RgnHandle;
            rptr: rhptr;
            wp: ^WindowPtr;
    begin
        rptr := rhptr(GrayRgnGlobal);
        GrayRgn := rptr^;
        wp := pointer(GhostWindow);
        wp^ := WindowPtr(nil);
        PaintBehind(WindowPeek(FrontWindow), GrayRgn);
        wp^ := PasteControl;
        DrawMenuBar;
    end;


    procedure UpdateTitleBar;
    {Updates the window title bar to show the current magnification or the current frame within a stack.}
        var
            str, str2, str3: str255;
    begin
        with info^ do begin
                str := title;
                if SpatiallyCalibrated then
                    str := concat(str, chr($13)); {Black Diamond}
                if DensityCalibrated then
                    str := concat(str, '╫');
                if StackInfo <> nil then
                    with StackInfo^ do begin
                            NumToString(CurrentSlice, str2);
                            NumToString(nSlices, str3);
                            str := concat(str, '(', str2, '/', str3, ')');
                        end
                else if (magnification <> 1.0) or ScaleToFitWindow then begin
                        if ScaleToFitWindow then begin
                                RealToString(magnification, 1, 2, str2);
                                str := concat(str, '(', str2, ')');
                            end
                        else begin
                                RealToString(magnification, 1, 0, str2);
                                str := concat(str, '(', str2, ':1)');
                            end;
                    end;
                if Digitizing then begin
                        if ExternalTrigger then
                            str := concat(str, '(Waiting for Trigger)')
                        else
                            str := concat(str, '(Live)');
                    end;
                if wptr <> nil then
                    SetWTitle(wptr, str);
            end; {with}
    end;


    procedure ScaleToFit;
        var
            trect: rect;
    begin
        if digitizing then
            exit(ScaleToFit);
        if info <> NoInfo then
            with info^ do begin
                    ScaleToFitWindow := not ScaleToFitWindow;
                    KillRoi;
                    if ScaleToFitWindow then begin
                            savewrect := wrect;
                            SaveSrcRect := SrcRect;
                            SaveMagnification := magnification;
                            GetWindowRect(wptr, trect);
                            savehloc := trect.left;
                            savevloc := trect.top;
                            wrect := wptr^.PortRect;
                            SrcRect := PicRect;
                            ScaleImageWindow(wrect);
                            SizeWindow(wptr, wrect.right, wrect.bottom, true);
                        end
                    else begin
                            if WindowState = TiledBigScaled then begin
                                    wrect := initwrect;
                                    SrcRect := wrect;
                                    magnification := 1.0;
                                    WindowState := NormalWindow;
                                end
                            else begin
                                    wrect := savewrect;
                                    SrcRect := SaveSrcRect;
                                    magnification := SaveMagnification;
                                end;
                            HideWindow(wptr);
                            SizeWindow(wptr, wrect.right, wrect.bottom, true);
                            MoveWindow(wptr, savehloc, savevloc, true);
                            ShowWindow(wptr);
                            UpdateTitleBar;
                        end;
                    SetPort(wptr);
                    InvalRect(wrect);
                    WindowState := NormalWindow;
                end;
    end;


    procedure DrawMyGrowIcon;{(w:WindowPtr)}
        var
            tPort: GrafPtr;
            tRect: rect;
    begin
        GetPort(tPort);
        SetPort(w);
        PenNormal;
        with w^.PortRect do begin
                SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
                FrameRect(tRect);
                MoveTo(right - 6, bottom - 10);
                LineTo(right - 2, bottom - 10);
                LineTo(right - 2, bottom - 2);
                LineTo(right - 10, bottom - 2);
                LineTo(right - 10, bottom - 6);
            end;
        SetPort(tPort);
    end;


    procedure Unzoom;
    begin
        if Info <> NoInfo then
            with Info^ do begin
                    if ScaleToFitWindow then
                        ScaleToFit
                    else begin
                            wrect := initwrect;
                            SrcRect := wrect;
                        end;
                    SizeWindow(wptr, wrect.right, wrect.bottom, true);
                    LoadLUT(info^.cTable);
                    UpdatePicWindow;
                    magnification := 1.0;
                    DrawMyGrowIcon(wptr);
                    UpdateTitleBar;
                    if WhatToUndo = UndoZoom then
                        WhatToUndo := NothingToUndo;
                    ShowRoi;
                end;
    end;


    function FindMedian;{(VAR a:SortArray):integer}
  {Finds the 5th largest of 9 values}
        var
            i, j, mj, max: integer;
    begin
        for i := 1 to 4 do begin
                max := 0;
                mj := 1;
                for j := 1 to 9 do
                    if a[j] > max then begin
                            max := a[j];
                            mj := j;
                        end;
                a[mj] := 0;
            end;
        max := 0;
        for j := 1 to 9 do
            if a[j] > max then
                max := a[j];
        FindMedian := max;
    end;


    procedure DrawBString;{(str:string)}
    begin
        TextFace([bold]);
        DrawString(str);
        TextFace([]);
    end;


    procedure PutWarning;
        var
            BufSizeStr: str255;
    begin
        NumToString(UndoBufSize div 1024, BufSizeStr);
        PutMessage(concat('This image is larger than the ', BufSizeStr, 'K Undo buffer. Many operations may fail or be Undoable.'));
    end;


    procedure SetupRoiRect;
{Copies the current image to Undo buffer so it can be used for drawing}
{the "marching ants". The copy of the previous image in the Clipboard buffer}
{ buffer will be used for Undo.}
        var
            SaveWhatToUndo: WhatToUndoType;
    begin
        SaveWhatToUndo := WhatToUndo;
        SetupUndo;
        UndoFromClip := true;
        info^.RoiShowing := true;
        WhatToUndo := SaveWhatToUndo;
    end;


    procedure SetForegroundColor (color: integer);
        var
            tPort: GrafPtr;
    begin
        if (color >= 0) and (color <= 255) then
            with info^ do begin
                    ForegroundIndex := color;
                    GetPort(tPort);
                    SetPort(ToolWindow);
                    InvalRect(ToolRect[brush]);
                    if osPort <> nil then begin
                            SetPort(GrafPtr(osPort));
                            pmForeColor(ForegroundIndex);
                        end;
                    SetPort(tPort);
                    if isInsertionPoint then
                        DisplayText(true);
                end;
    end;


    procedure SetBackgroundColor (color: integer);
        var
            tPort: GrafPtr;
    begin
        if (color >= 0) and (color <= 255) then
            with info^ do begin
                    BackgroundIndex := color;
                    GetPort(tPort);
                    SetPort(ToolWindow);
                    InvalRect(ToolRect[eraser]);
                    if osPort <> nil then begin
                            SetPort(GrafPtr(osPort));
                            pmBackColor(BackgroundIndex);
                        end;
                    SetPort(tPort);
                    if isInsertionPoint then
                        DisplayText(true);
                end;
    end;


    procedure GetForegroundColor;{(event: EventRecord)}
        var
            loc: point;
            color: integer;
    begin
        loc := event.where;
        ScreenToOffScreen(loc);
        Color := MyGetPixel(loc.h, loc.v);
        SetForegroundColor(color);
    end;


    procedure GetBackgroundColor; {(event: EventRecord)}
        var
            loc: point;
            color: integer;
    begin
        loc := event.where;
        ScreenToOffScreen(loc);
        Color := MyGetPixel(loc.h, loc.v);
        SetBackgroundColor(color);
    end;


    procedure GenerateValues;
        var
            a, b, c, d, e, f, x, y: extended;
            i: integer;
    begin
        with info^ do begin
                if not DensityCalibrated then begin
                        for i := 0 to 255 do
                            cvalue[i] := i;
                        MinValue := 0.0;
                        MaxValue := 255.0;
                        exit(GenerateValues);
                    end;
                a := Coefficient[1];
                b := Coefficient[2];
                c := Coefficient[3];
                d := Coefficient[4];
                e := Coefficient[5];
                f := Coefficient[6];
                MinValue := 10e+12;
                MaxValue := -MinValue;
                for i := 0 to 255 do begin
                        x := i;
                        case fit of
                            StraightLine:
                                y := a + b * x;
                            Poly2:
                                y := a + b * x + c * x * x;
                            Poly3:
                                y := a + b * x + c * x * x + d * x * x * x;
                            Poly4:
                                y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
                            Poly5:
                                y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
                            ExpoFit:
                                y := a * exp(b * x);
                            PowerFit:
                                if x = 0.0 then
                                    y := 0.0
                                else
                                    y := a * exp(b * ln(x)); {y=ax^b}
                            LogFit:  begin
                                    if x = 0.0 then
                                        x := 0.5;
                                    y := a * ln(b * x)
                                end;
                            RodbardFit:  begin
                                    if x <= a then
                                        y := 0
                                    else begin
                                            y := (a - x) / (x - d);
                                            y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
                                            y := y * c;
                                        end;
                                end;
                            UncalibratedOD:  begin
                                    if x = 255.0 then
                                        x := 254.5;
                                    y := 0.434294481 * ln(255 / (255 - x))  {log10}
                                end;
                            otherwise
                                y := x;
                        end; {case}
                        cvalue[i] := y;
                        if y > MaxValue then
                            MaxValue := y;
                        if y < MinValue then
                            MinValue := y;
                    end; {for}
                if MinValue >= 0.0 then
                    ZeroClip := false;
                if ZeroClip then begin
                        for i := 0 to 255 do
                            if cvalue[i] < 0.0 then
                                cvalue[i] := 0.0;
                        MinValue := 0.0;
                    end;
            end;
    end;


    procedure ScaleImageWindow (var trect: rect);
        var
            WindowLeft, WindowTop: integer;
            PicAspectRatio, TempMagnification: extended;
    begin
        with info^ do begin
                SrcRect := PicRect;
                with CGrafPort(wptr^).PortPixMap^^.bounds do begin
                        WindowLeft := -left;
                        WindowTop := -top;
                    end;
                with PicRect do
                    PicAspectRatio := right / bottom;
                with trect do begin
                        if (WindowLeft + right) > (ScreenWidth - 5) then
                            right := ScreenWidth - 5 - WindowLeft;
                        bottom := round(right / PicAspectRatio);
                        if (WindowTop + bottom) > (ScreenHeight - 5) then
                            bottom := ScreenHeight - 5 - WindowTop;
                        right := round(bottom * PicAspectRatio);
                        magnification := right / PicRect.right;
                    end;
                UpdateTitleBar;
            end; {with}
    end;


    function TooWide: boolean;
        var
            SelectionTooWide: boolean;
            MaxWidth: str255;
    begin
        with info^.RoiRect do
            SelectionTooWide := (right - left) > MaxLine;
        if SelectionTooWide then begin
                NumToString(MaxLine, MaxWidth);
                PutMessage(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
            end;
        TooWide := SelectionTooWide;
    end;


    procedure DrawTextString (str: str255; loc: point; just: integer);
        var
            SaveJust: integer;
    begin
        TextStr := str;
        IsInsertionPoint := true;
        TextStart := loc;
        SaveJust := TextJust;
        TextJust := just;
        DisplayText(false);
        TextJust := SaveJust;
        IsInsertionPoint := false;
    end;


    procedure IncrementCounter;
    begin
        if mCount < MaxRegions then begin
                mCount := mCount + 1;
                UnsavedResults := true;
            end
        else
            beep;
    end;


    procedure ClearResults (i: integer);
    begin
        mean^[i] := 0.0;
        sd^[i] := 0.0;
        PixelCount^[i] := 0;
        mArea^[i] := 0.0;
        mode^[i] := 0.0;
        IntegratedDensity^[i] := 0.0;
        idBackground^[i] := 0.0;
        xcenter^[i] := 0.0;
        ycenter^[i] := 0.0;
        MajorAxis^[i] := 0.0;
        MinorAxis^[i] := 0.0;
        orientation^[i] := 0.0;
        mMin^[i] := 0.0;
        mMax^[i] := 0.0;
        plength^[i] := 0.0;
    end;

    procedure UpdateFitEllipse;
    begin
        FitEllipse := (xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
    end;


    function StringToReal (str: str255): real;
        var
            i, ndigits, StringLength: integer;
            c: char;
            n, m: real;
            negative, LeftOfPoint, NegExp: boolean;
            exponent: LongInt;
    begin
        negative := false;
        n := 0.0;
        LeftOfPoint := true;
        m := 0.1;
        ndigits := 0;
        StringLength := length(str);
        i := 0;
        repeat
            i := i + 1;
        until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
        c := str[i];
        repeat
            if c = '-' then
                negative := true
            else if c = '.' then
                LeftOfPoint := false
            else if (c >= '0') and (c <= '9') then begin
                    ndigits := ndigits + 1;
                    if LeftOfPoint then
                        n := n * 10.0 + ord(c) - ord('0')
                    else begin
                            n := n + (ord(c) - ord('0')) * m;
                            m := m * 0.1;
                        end;
                end;
            i := i + 1;
            if i <= StringLength then
                c := str[i];
        until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
        if (c = 'e') or (c = 'E') then begin
                NegExp := false;
                exponent := 0;
                i := i + 1;
                if i <= StringLength then
                    c := str[i];
                if (c = '+') or (c = '-') then begin
                        if c = '-' then
                            NegExp := true;
                        i := i + 1;
                        if i <= StringLength then
                            c := str[i];
                    end;
                repeat
                    if (c >= '0') and (c <= '9') then
                        exponent := exponent * 10 + ord(c) - ord('0');
                    i := i + 1;
                    if i <= StringLength then
                        c := str[i];
                until not (c in ['0'..'9']) or (i > StringLength);
                if negExp then
                    exponent := -exponent;
                if exponent <> 0 then
                    n := n * exp(exponent * ln(10));
            end; {if c='e'}
        if ndigits = 0 then
            n := BadReal
        else if negative then
            n := -n;
        StringToReal := n;
    end;

end.