Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Applications/NIH Image 1.55/Source/Stacks.p

Text File | 1994-05-02 | 44.6 KB | 1,714 lines | [TEXT/PJMM]

unit Stacks;

interface

    uses
        QuickDraw, Palettes, QDOffscreen, PictUtil, PrintTraps, globals, Utilities, Graphics, Analysis, Camera, file1, file2, filters, sound, lut;

    function MakeStackFromWindow: boolean;
    procedure MakeStack;
    procedure MakeWindowsFromStack;
    function AddSlice (update: boolean): boolean;
    procedure DeleteSlice;
    procedure ShowNextSlice (item: integer);
    procedure ShowFirstOrLastSlice (ich: integer);
    procedure DoResliceOptions;
    procedure Reslice;
    procedure Animate;
    procedure MakeMovie;
    procedure CaptureFrames;
    procedure MakeMontage;
    procedure ConvertRGBToEightBitColor (Capturing: boolean);
    procedure ConvertEightBitColorToRGB;
    procedure CaptureColor;
    procedure AverageSlices;
    procedure ConvertRGBToHSV;


implementation


    function MakeStackFromWindow: boolean;
    begin
        with info^ do begin
                StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
                if StackInfo = nil then begin
                        MakeStackFromWindow := false;
                        exit(MakeStackFromWindow);
                    end;
                with StackInfo^ do begin
                        nSlices := 1;
                        CurrentSlice := 1;
                        PicBaseH[1] := PicBaseHandle;
                        SliceSpacing := 0.0;
                        LoopTime := 0.0;
                    end;
                PictureType := NewPicture;
                MakeStackFromWindow := true;
            end;
    end;


    procedure MakeStack;
        var
            ok, isStack: boolean;
            i, result: integer;
            TempInfo, SaveInfo: InfoPtr;
            str: str255;
    begin
        if not AllSameSize then begin
                PutMessage('All currently open images must be the same size to make a stack.');
                exit(MakeStack);
            end;
        isStack := false;
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                isStack := isStack or (TempInfo^.StackInfo <> nil);
            end;
        if isStack then begin
                PutMessage('All stacks must be closed before making a new stack.');
                exit(MakeStack);
            end;
        if nPics > MaxSlices then begin
                NumToString(MaxSlices, str);
                PutMessage(concat('Maximun stack size is ', str, ' slices.'));
                exit(MakeStack);
            end;
        StopDigitizing;
        DisableDensitySlice;
        SelectWindow(PicWindow[1]);
        Info := pointer(WindowPeek(PicWindow[1])^.RefCon);
        ActivateWindow;
        KillRoi;
        UnZoom;
        if not MakeStackFromWindow then
            exit(MakeStack);
        with info^ do begin
                StackInfo^.nSlices := nPics;
                title := 'Stack';
                UpdateTitleBar;
                Revertable := false;
            end;
        SaveInfo := Info;
        MakingStack := true;
        ShowWatch;
        for i := 2 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[2])^.RefCon);
                with TempInfo^ do begin
                        hunlock(PicBaseHandle);
                        info^.StackInfo^.PicBaseH[i] := PicBaseHandle;
                    end;
                result := CloseAWindow(PicWindow[2]);
                Info := SaveInfo;
            end;
        with info^ do
            UpdateWindowsMenuItem(PixMapSize * StackInfo^.nSlices, title, 1);
        MakingStack := false;
    end;


    function AddSlice (update: boolean): boolean;
        var
            i: integer;
            h: handle;
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                AddSlice := false;
                if nSlices = MaxSlices then
                    exit(AddSlice);
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                h := GetBigHandle(PixMapSize);
                if h = nil then begin
                        PutMessage('Not enough memory available to add a slice to this stack.');
                        macro := false;
                        exit(AddSlice);
                    end;
                for i := nSlices downto CurrentSlice + 1 do
                    PicBaseH[i + 1] := PicBaseH[i];
                nSlices := nSlices + 1;
                CurrentSlice := CurrentSlice + 1;
                PicBaseH[CurrentSlice] := h;
                SelectSlice(CurrentSlice);
                if Update then begin
                        SelectAll(false);
                        DoOperation(EraseOp);
                        UpdatePicWindow;
                    end;
                UpdateTitleBar;
                if isRoi then
                    RestoreRoi;
                WhatToUndo := NothingToUndo;
                AddSlice := true;
                changes := true;
                PictureType := NewPicture;
                UpdateWindowsMenuItem(PixMapSize * nSlices, title, PicNum);
            end;
    end;


    procedure DeleteSlice;
        var
            SliceToDelete, NextSlice, i: integer;
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if nSlices = 1 then begin
                        WhatToUndo := NothingToUndo;
                        exit(DeleteSlice);
                    end;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SetupUndo;
                WhatToUndo := UndoSliceDelete;
                SliceToDelete := CurrentSlice;
                if CurrentSlice = 1 then begin
                        NextSlice := 2;
                        WhatToUndo := UndoFirstSliceDelete;
                    end
                else
                    NextSlice := CurrentSlice - 1;
                SelectSlice(NextSlice);
                UpdatePicWindow;
                DisposHandle(PicBaseH[SliceToDelete]);
                for i := SliceToDelete to nSlices - 1 do
                    PicBaseH[i] := PicBaseH[i + 1];
                nSlices := nSlices - 1;
                if CurrentSlice <> 1 then
                    CurrentSlice := CurrentSlice - 1;
                UpdateTitleBar;
                if isRoi then
                    RestoreRoi;
                changes := true;
                UpdateWindowsMenuItem(PixMapSize * nSlices, title, PicNum);
            end;
    end;


    procedure MakeWindowsFromStack;
        var
            i, ignore, N: integer;
            SaveInfo: InfoPtr;
            tmp: longint;

        function MakeName (i: integer): str255;
            var
                str: str255;
        begin
            RealToString(i, 3, 0, str);
            if str[1] = ' ' then
                str[1] := '0';
            if str[2] = ' ' then
                str[2] := '0';
            MakeName := str;
        end;

    begin
        N := info^.StackInfo^.nSlices;
        tmp := SizeOf(PicInfo);
        if MaxBlock < (MinFree + info^.ImageSize + (SizeOf(PicInfo) + 2000) * LongInt(N)) then begin
                PutMessage('There is not enough memory available to convert this stack to windows.');
                exit(MakeWindowsFromStack);
            end;
        SaveInfo := Info;
        KillRoi;
        for i := 1 to N - 1 do begin
                SelectSlice(1);
                info^.StackInfo^.CurrentSlice := 1;
                if not Duplicate(MakeName(i), false) then
                    exit(MakeWindowsFromStack);
                info := SaveInfo;
                DeleteSlice;
            end;
        if Duplicate(MakeName(N), false) then begin
                info := SaveInfo;
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
            end;
    end;


    procedure ShowNextSlice (item: integer);
        var
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if item = NextSliceItem then begin
                        CurrentSlice := CurrentSlice + 1;
                        if CurrentSlice > nSlices then
                            CurrentSlice := nSlices;
                    end
                else begin
                        CurrentSlice := CurrentSlice - 1;
                        if CurrentSlice < 1 then
                            CurrentSlice := 1;
                    end;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SelectSlice(CurrentSlice);
                UpdatePicWindow;
                UpdateTitleBar;
                WhatToUndo := NothingToUndo;
                if isRoi then
                    RestoreRoi;
            end;
    end;


    procedure ShowFirstOrLastSlice (ich: integer);
        var
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if ich = EndKey then
                    CurrentSlice := nSlices
                else
                    CurrentSlice := 1;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SelectSlice(CurrentSlice);
                UpdatePicWindow;
                UpdateTitleBar;
                WhatToUndo := NothingToUndo;
                if isRoi then
                    RestoreRoi;
            end;
    end;


    procedure DoResliceOptions;
        var
            default, tmp: extended;
            Canceled: boolean;
            prompt: str255;
    begin
        with info^.StackInfo^, info^ do begin
                if SliceSpacing = 0.0 then
                    default := 1.0
                else begin
                        if SpatiallyCalibrated then
                            default := SliceSpacing / xSpatialScale
                        else
                            default := SliceSpacing;
                    end;
                tmp := GetReal(concat('Slice Spacing(', xUnit, '):'), default, Canceled);
                if not Canceled and (tmp > 0.0) then begin
                        if SpatiallyCalibrated then
                            SliceSpacing := tmp * xSpatialScale
                        else
                            SliceSpacing := tmp;
                    end;
            end;
    end;


    procedure GetSlice (xstart, ystart, start: real; angle: extended; count: integer; var line: LineType);
        var
            i: integer;
            x, y, xinc, yinc: extended;
            IntegerStart: boolean;
    begin
        IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
        if IntegerStart and (angle = 0.0) then begin
                GetLine(trunc(xstart), trunc(ystart), count, line);
                exit(GetSlice);
            end;
        if IntegerStart and (angle = 270.0) then begin
                GetColumn(trunc(xstart), trunc(ystart), count, line);
                exit(GetSlice);
            end;
        angle := (angle / 180.0) * pi;
        xinc := cos(angle);
        yinc := -sin(angle);
        x := xstart + start * xinc;
        y := ystart + start * yinc;
        for i := 0 to count - 1 do begin
                line[i] := round(GetInterpolatedPixel(x, y));
                x := x + xinc;
                y := y + yinc;
            end;
    end;


    procedure Reslice;
        var
            DstWidth, DstHeight, nSlices: integer;
            dstLeft, dstTop, y, i, j, LineLength: integer;
            SaveWindowFlag, SaveMacro, HorizontalMode: boolean;
            SaveHScale, SaveVScale, UncalibratedLineLength, CalibratedLineLength, angle: extended;
            Stack, Reconstruction: InfoPtr;
            aLine: LineType;
            name, str1, str2: str255;
            MaskRect: rect;
            x1, y1, x2, y2, ulength, clength: real;

        procedure MakeRoi (Left, Top, Width, Height: integer);
        begin
            with info^ do begin
                    RoiType := RectRoi;
                    SetRect(RoiRect, left, top, left + width, top + height);
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
        end;

    begin
        with info^, info^.StackInfo^ do begin
                if nSlices < 2 then begin
                        PutMessage('Reslicing requires at least 2 slices.');
                        macro := false;
                        exit(Reslice);
                    end;
                if not (RoiShowing and (RoiType = LineRoi)) then begin
                        PutMessage('Please make a straight line selection first.');
                        macro := false;
                        exit(Reslice);
                    end;
                Stack := info;
                GetLengthOrPerimeter(ulength, clength);
                LineLength := round(ulength);
                if LineLength = 0 then begin
                        PutMessage('Line length cannot be zero.');
                        macro := false;
                        exit(Reslice);
                    end;
                if SliceSpacing = 0.0 then
                    DoResliceOptions;
                GetLoi(x1, y1, x2, y2);
                if (LAngle = 0.0) or (LAngle = 270.0) then
                    if NotInBounds then
                        exit(Reslice);
                HorizontalMode := not OptionKeyWasDown;
                if HorizontalMode then begin
                        DstWidth := LineLength;
                        DstHeight := round(nSlices * SliceSpacing);
                        if DstHeight < nSlices then
                            DstHeight := nSlices;
                        dstLeft := 0;
                        dstTop := round((dstHeight - nSlices) / 2);
                    end
                else begin
                        DstWidth := round(nSlices * SliceSpacing);
                        if DstWidth < nSlices then
                            DstWidth := nSlices;
                        DstHeight := LineLength;
                        dstLeft := round((dstWidth - nSlices) / 2);
                        dstTop := 0;
                    end;
                RealToString(y1, 3, 0, str1);
                RealToString(LAngle, 1, 2, str2);
                name := concat(str1, '-', str2);
                if not NewPicWindow(name, DstWidth, DstHeight) then
                    exit(Reslice);
                Reconstruction := info;
                SaveWindowFlag := rsCreateNewWindow;
                SaveHScale := rsHScale;
                SaveVScale := rsVScale;
                rsCreateNewWindow := false;
                rsMethod := bilinear;
                for i := 1 to nSlices do begin
                        Info := Stack;
                        SelectSlice(i);
                        GetSlice(x1, y1, 0.0, LAngle, LineLength, aLine);
                        info := Reconstruction;
                        if HorizontalMode then begin
                                PutLine(dstLeft, dstTop + nSlices - i, LineLength, aLine);
                                if i = 1 then {Draw extra line needed to get scaling to work right.}
                                    PutLine(dstLeft, dstTop + nSlices, LineLength, aLine);
                                SetRect(MaskRect, dstLeft, dstTop + nSlices - i, dstLeft + LineLength, dstTop + nSlices - i + 1);
                            end
                        else begin
                                PutColumn(dstLeft + nSlices - i, dstTop, LineLength, aLine);
                                if i = 1 then {Draw extra line needed to get scaling to work right.}
                                    PutLine(dstLeft + nSlices, dstTop, LineLength, aLine);
                                SetRect(MaskRect, dstLeft + nSlices - i, dstTop, dstLeft + nSlices - i + 1, dstTop + LineLength);
                            end;
                        UpdateScreen(MaskRect);
                    end;
                if HorizontalMode then begin
                        MakeRoi(dstLeft, dstTop, LineLength, nSlices);
                        rsHScale := 1.0;
                        rsVScale := SliceSpacing;
                    end
                else begin
                        MakeRoi(dstLeft, dstTop, nSlices, LineLength);
                        rsHScale := SliceSpacing;
                        rsVScale := 1.0;
                    end;
                rsAngle := 0;
                SaveMacro := macro;
                macro := true;
                ScaleAndRotate;
                macro := SaveMacro;
                Info := Stack;
                SelectSlice(CurrentSlice);
                Info := Reconstruction;
                rsCreateNewWindow := SaveWindowFlag;
                rsHScale := SaveHScale;
                rsVScale := SaveVScale;
                KillRoi;
            end;
    end;


    procedure Animate;
        var
            n, SaveN, fpsInterval, DelayCount: integer;
            Event: EventRecord;
            ch: char;
            b: boolean;
            SingleStep, GoForward, NewKeyDown, PhotoMode: boolean;
            nFrames, StartTicks, NextTicks, SaveTicks, ticks: LongInt;
            fps, seconds: extended;

        procedure ShowFPS (fps: extended);
            var
                hstart, vstart, ivalue: integer;
                key: str255;
        begin
            if PhotoMode then
                exit(ShowFPS);
            hstart := InfoHStart;
            vstart := InfoVStart;
            SetPort(InfoWindow);
            MoveTo(xValueLoc, vstart);
            case DelayTicks of
                0:
                    key := '9 ';
                2:
                    key := '8 ';
                3:
                    key := '7 ';
                4:
                    key := '6 ';
                6:
                    key := '5 ';
                8:
                    key := '4 ';
                12:
                    key := '3 ';
                30:
                    key := '2 ';
                60:
                    key := '1 ';
            end;
            if SingleStep then begin
                    if GoForward then
                        key := '->'
                    else
                        key := '<-';
                end;
            DrawString(key);
            MoveTo(yValueLoc, vstart + 10);
            DrawReal(fps, 1, 2);
            DrawChar(' ');
        end;

    begin
        if info^.StackInfo = nil then begin
                PutMessage('Animation requires a stack.');
                exit(Animate);
            end;
        with info^, info^.StackInfo^ do begin
                if nSlices < 2 then begin
                        PutMessage('Animation requires at least two "slices".');
                        exit(Animate);
                    end;
                KillRoi;
                PhotoMode := OptionKeyDown or OptionKeyWasDown;
                if PhotoMode then
                    EraseScreen
                else begin
                        ShowWatch;
                        ShowMessage(concat('Use 1...9 keys to control speed', cr, 'Use arrow keys to single step', cr, 'Press mouse button to stop'));
                    end;
                FlushEvents(EveryEvent, 0);
                fpsInterval := 10;
                SaveN := -1;
                n := 1;
                GoForward := true;
                SingleStep := false;
                nFrames := 0;
                StartTicks := TickCount;
                NextTicks := StartTicks;
                SaveTicks := StartTicks;
                if not PhotoMode then begin
                        DrawLabels('key:', 'fps:', '');
                        SetPort(InfoWindow);
                        TextSize(9);
                        TextFont(Monaco);
                        TextMode(SrcCopy);
                    end;
                repeat
                    b := WaitNextEvent(EveryEvent, Event, 0, nil);
                    NewKeyDown := (event.what = KeyDown) or (event.what = AutoKey);
                    if NewKeyDown then begin
                            Ch := chr(BitAnd(Event.message, 127));
                            SingleStep := false;
                            case ord(ch) of
                                28, 44, 60, PageUp: {<-, <}
                                    begin
                                        SingleStep := true;
                                        GoForward := false;
                                        n := n - 1;
                                        if n < 1 then
                                            n := 1;
                                        DelayTicks := 0
                                    end; {left}
                                29, 46, 62, PageDown:  {->, >}
                                    begin
                                        SingleStep := true;
                                        GoForward := true;
                                        n := n + 1;
                                        if n > nSlices then
                                            n := nSlices;
                                        DelayTicks := 0
                                    end;  {right}
                                57:
                                    DelayTicks := 0;  {'9'-max speed}
                                56:
                                    DelayTicks := 2;  {'8'-30 fps}
                                55:
                                    DelayTicks := 3;  {'7'-20 fps}
                                54:
                                    DelayTicks := 4;  {'6'-15 fps}
                                53:
                                    DelayTicks := 6;  {'5'-10 fps}
                                52:
                                    DelayTicks := 8; {'4'-7.5 fps}
                                51:
                                    DelayTicks := 12; {'3'-5 fps}
                                50:
                                    DelayTicks := 30; {'2'-2 fps}
                                49:
                                    DelayTicks := 60; {'1'-1 fps}
                                otherwise
                            end; {case}
                            if DelayTicks > 12 then
                                fpsInterval := 2
                            else if DelayTicks > 3 then
                                fpsInterval := 5
                            else
                                fpsInterval := 10;
                        end; {if NewKeyDown}
                    if GoForward then begin
                            if not SingleStep then
                                n := n + 1;
                            if n > nSlices then begin
                                    if OscillatingMovies then begin
                                            n := nSlices - 1;
                                            GoForward := false;
                                        end
                                    else
                                        n := 1;
                                end;
                        end
                    else begin
                            if not SingleStep then
                                n := n - 1;
                            if n < 1 then begin
                                    if OscillatingMovies then begin
                                            n := 2;
                                            Goforward := true;
                                        end
                                    else
                                        n := nSlices;
                                end;
                        end;
                    CurrentSlice := n;
                    SelectSlice(CurrentSlice);
                    UpdatePicWindow;
                    nFrames := nFrames + 1;
                    if SingleStep then begin
                            if (not OptionKeyWasDown) and (n <> SaveN) then begin
                                    UpdateTitleBar;
                                    SaveN := n;
                                end;
                            ShowFPS(0.0);
                        end
                    else if (nFrames mod fpsInterval) = 0 then begin
                            ticks := TickCount;
                            seconds := (ticks - SaveTicks) / 60.0;
                            if seconds <> 0.0 then
                                fps := fpsInterval / seconds
                            else
                                fps := 0.0;
                            ShowFPS(fps);
                            SaveTicks := ticks;
                        end;
                    DelayCount := 0;
                    if DelayTicks > 0 then begin
                            repeat
                                ticks := TickCount;
                            until ticks >= NextTicks;
                            NextTicks := ticks + DelayTicks;
                        end;
                until (event.what = MouseDown) or (event.what = osEvt);
                if PhotoMode then
                    RestoreScreen;
                FlushEvents(EveryEvent, 0);
            end; {with}
    end;


    procedure MakeMovie;
        var
            nFrames, wleft, wtop, width, height, frame, i: integer;
            ignore, SaveFW: integer;
            OutOfMemory: boolean;
            DisplayPoint: point;
            StartTicks, NextTicks, interval, ElapsedTime: LongInt;
            SecondsBetweenFrames, seconds: extended;
            frect: rect;
            MainDevice: GDHandle;
            SourcePixMap: PixMapHandle;
            str1, str2, str3: str255;
            Canceled: boolean;
    begin
        with info^ do begin
                if (PictureType <> FrameGrabberType) and (PictureType <> ScionType) then begin
                        PutMessage('You must be capturing to make a movie.');
                        exit(MakeMovie);
                    end;
                StopDigitizing;
                if not (RoiShowing and (RoiType = RectRoi)) then begin
                        PutMessage('Please make a rectangular selection first.');
                        exit(MakeMovie);
                    end;
                if NotInBounds then
                    exit(MakeMovie);
                SaveFW := FramesWanted;
                FramesWanted := GetInt('Number of Frames:', FramesWanted, Canceled);
                if Canceled then begin
                        FramesWanted := SaveFW;
                        exit(MakeMovie);
                    end;
                if FramesWanted < 1 then
                    FramesWanted := 1;
                if FramesWanted > MaxSlices then
                    FramesWanted := MaxSlices;
                with RoiRect do begin
                        left := band(left + 1, $fffc);   {Word align}
                        right := band(right + 2, $fffc);
                        if right > PicRect.right then
                            right := PicRect.right;
                        MakeRegion;
                        wleft := left;
                        wtop := top;
                        width := right - left;
                        height := bottom - top;
                    end;
            end; {with info^}
        if FrameGrabber = Scion then begin
                with DisplayPoint do begin
                        h := PicLeftBase;
                        v := PicTopBase;
                    end;
                with frect do begin
                        left := PicLeftBase + wleft;
                        top := PicTopBase + wtop;
                        right := left + width;
                        bottom := top + height;
                    end;
            end
        else
            with frect do begin
                    left := wleft;
                    top := wtop;
                    right := left + width;
                    bottom := top + height;
                end;
        if not NewPicWindow('Movie', width, height) then
            exit(MakeMovie);
        if not MakeStackFromWindow then
            exit(MakeMovie);
        nFrames := 1;
        OutOfMemory := false;
        while (nFrames < FramesWanted) and (not OutOfMemory) do begin
                OutOfMemory := not AddSlice(false);
                if not OutOfMemory then
                    nFrames := nFrames + 1;
            end;
        if ExternalTrigger then
            SecondsBetweenFrames := 0.0
        else
            SecondsBetweenFrames := GetReal('Delay Between Frames(seconds):', 0.0, Canceled);
        if Canceled then
            with info^ do begin
                    changes := false;
                    ignore := CloseAWindow(wptr);
                    Exit(MakeMovie);
                end;
        if SecondsBetweenFrames < 0.0 then
            SecondsBetweenFrames := 0.0;
        interval := round(60.0 * SecondsBetweenFrames);
        if FrameGrabber = Scion then begin
                HideCursor;
                MainDevice := GetMainDevice;
                SourcePixMap := MainDevice^^.gdPMap;
            end
        else begin
                ShowWatch;
                SourcePixMap := fgPort^.portPixMap;
                ResetFrameGrabber;
            end;
        ShowTriggerMessage;
        StartTicks := TickCount;
        NextTicks := StartTicks;
        with info^, info^.StackInfo^ do begin
                if Interval >= 30 then
                    ShowMessage(CmdPeriodToStop)
                else
                    DrawLabels('Frame:', 'Total:', '');
                for frame := 1 to nFrames do begin
                        CurrentSlice := frame;
                        SelectSlice(CurrentSlice);
                        NextTicks := NextTicks + Interval;
                        if FrameGrabber = Scion then begin
                                GetScionFrame(DisplayPoint);
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                            end
                        else begin
                                if Interval >= 30 then
                                    UpdateTitleBar
                                else
                                    Show2Values(CurrentSlice, nSlices);
                                GetFrame;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                                if not BlindMovieCapture then
                                    UpdatePicWindow;
                            end;
                        while TickCount < NextTicks do
                            if CommandPeriod then begin
                                    beep;
                                    wait(60);
                                    exit(MakeMovie);
                                end;
                    end; {for}
                seconds := (TickCount - StartTicks) / 60.0;
                LoopTime := seconds;
            end; {with}
        RealToString(seconds, 1, 2, str1);
        str1 := concat(long2str(nFrames), ' frames', cr, str1, ' seconds', cr);
        RealToString(seconds / nFrames, 1, 3, str2);
        str3 := concat(str1, str2, ' seconds/frame', cr);
        if nFrames >= seconds then
            ShowFrameRate(str3, StartTicks, nFrames)
        else
            ShowMessage(str3);
        ShowFirstOrLastSlice(HomeKey);
    end;


    procedure CaptureFrames;
        var
            nFrames, wleft, wtop, width, height, i: integer;
            ignore, SaveFW: integer;
            OutOfMemory, AdvanceFrame, b: boolean;
            DisplayPoint: point;
            frect: rect;
            MainDevice: GDHandle;
            SourcePixMap: PixMapHandle;
            Event: EventRecord;
            ShutterSound: handle;
            err: OSErr;

        procedure CheckButton;
        begin
            if Button and not AdvanceFrame then
                with Info^.StackInfo^ do begin
                        AdvanceFrame := true;
                        ShutterSound := GetResource('snd ', 100);
                        if ShutterSound <> nil then
                            err := SndPlay(nil, ShutterSound, false);
                        if CurrentSlice < nSlices then begin
                                CurrentSlice := CurrentSlice + 1;
                                UpdateTitleBar;
                                CurrentSlice := CurrentSlice - 1;
                            end;
                    end;
        end;

    begin
        with info^ do begin
                if (PictureType <> FrameGrabberType) and (PictureType <> ScionType) then begin
                        PutMessage('You must be capturing to capture frames.');
                        exit(CaptureFrames);
                    end;
                StopDigitizing;
                if not (RoiShowing and (RoiType = RectRoi)) then begin
                        PutMessage('Please make a rectangular selection first.');
                        exit(CaptureFrames);
                    end;
                if NotInBounds then
                    exit(CaptureFrames);
                SaveFW := FramesWanted;
                ShutterSound := nil;
                with RoiRect do begin
                        left := band(left + 1, $fffc);   {Word align}
                        right := band(right + 2, $fffc);
                        if right > PicRect.right then
                            right := PicRect.right;
                        MakeRegion;
                        wleft := left;
                        wtop := top;
                        width := right - left;
                        height := bottom - top;
                    end;
            end; {with info^}
        if FrameGrabber = Scion then begin
                with DisplayPoint do begin
                        h := PicLeftBase;
                        v := PicTopBase;
                    end;
                with frect do begin
                        left := PicLeftBase + wleft;
                        top := PicTopBase + wtop;
                        right := left + width;
                        bottom := top + height;
                    end;
            end
        else
            with frect do begin
                    left := wleft;
                    top := wtop;
                    right := left + width;
                    bottom := top + height;
                end;
        if not NewPicWindow('Frames', width, height) then
            exit(CaptureFrames);
        if not MakeStackFromWindow then
            exit(CaptureFrames);
        UpdateTitleBar;
        if FrameGrabber = Scion then begin
                HideCursor;
                MainDevice := GetMainDevice;
                SourcePixMap := MainDevice^^.gdPMap;
            end
        else begin
                ShowWatch;
                SourcePixMap := fgPort^.portPixMap;
                ResetFrameGrabber;
            end;
        FlushEvents(EveryEvent, 0);
        ExternalTrigger := false;
        UpdateVideoControl;
        with info^, info^.StackInfo^ do begin
                ShowMessage(CmdPeriodToStop);
                OutOfMemory := false;
                AdvanceFrame := false;
                while (not OutOfMemory) and (CurrentSlice <= MaxSlices) do begin
                        if AdvanceFrame then begin
                                OutOfMemory := not AddSlice(false);
                                AdvanceFrame := false;
                            end;
                        if FrameGrabber = Scion then begin
                                GetScionFrame(DisplayPoint);
                                CheckButton;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                                CheckButton;
                            end
                        else begin
                                GetFrame;
                                CheckButton;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                                CheckButton;
                                UpdatePicWindow;
                                CheckButton;
                            end;
                        b := WaitNextEvent(EveryEvent, Event, 0, nil);
                        if event.what = KeyDown then
                            leave;
                    end; {while}
            end; {with}
        if ShutterSound <> nil then
            ReleaseResource(ShutterSound);
    end;


    procedure CopyPics (sPort, dPort: cGrafPtr; sRect, dRect: rect);
    begin
        pmForeColor(BlackIndex);
        pmBackColor(WhiteIndex);
        hlock(handle(sPort^.portPixMap));
        hlock(handle(dPort^.portPixMap));
        CopyBits(BitMapHandle(sPort^.portPixMap)^^, BitMapHandle(dPort^.PortPixMap)^^, sRect, dRect, SrcCopy, nil);
        hunlock(handle(sPort^.portPixMap));
        hunlock(handle(dPort^.PortPixMap));
        pmForeColor(ForegroundIndex);
        pmBackColor(BackgroundIndex);
    end;


    procedure MakeMontage;
  {Opens a new window and creates a composite image}
  {from the slices in the current stack.}
        const
            ColumnsID = 3;
            RowsID = 4;
            ScaleID = 5;
            FirstID = 6;
            LastID = 7;
            IncrementID = 8;
            NumberID = 9;
        var
            mylog: DialogPtr;
            item, i, nRows, nColumns, Inc, slices: integer;
            StackWidth, StackHeight, mWidth, mHeight, Background: integer;
            dWidth, dHeight, dLeft, dTop, dRight, dBottom, MaxWidth, MaxHeight: integer;
            FirstSlice, LastSlice, TotalSlices: integer;
            scale, SaveScale: extended;
            sPort, dPort: cGrafPtr;
            StackInfo, MontageInfo: InfoPtr;
            sRect, dRect: rect;
            NumberSlices, IncrementSet: boolean;
            str: str255;
            loc: point;
            SaveGDevice: GDHandle;

        procedure Estimate (adjustinc: boolean);
            var
                tmp, xScale, yScale: extended;
                n: integer;
        begin
            slices := LastSlice - FirstSlice + 1;
            if adjustinc then
                inc := 0;
            repeat
                if adjustinc then
                    inc := inc + 1;
                n := trunc(slices / inc);
                tmp := sqrt(n);
                if trunc(tmp) <> tmp then
                    tmp := trunc(tmp) + 1.0;
                nColumns := trunc(tmp);
                nRows := nColumns;
                if (nColumns * (nRows - 1)) >= n then
                    nRows := nRows - 1;
                xScale := (MaxWidth / nColumns) / StackWidth;
                yScale := (MaxHeight / nRows) / StackHeight;
                if xScale < yScale then
                    scale := xScale
                else
                    scale := yScale;
                if scale > 1.0 then
                    scale := 1.0;
                SaveScale := scale;
            until (scale >= 0.5) or (inc >= 3) or not adjustinc;
        end;

    begin
        InitCursor;
        with info^ do begin
                StackWidth := PixelsPerLine;
                StackHeight := nLines;
                FirstSlice := 1;
                TotalSlices := StackInfo^.nSlices;
                LastSlice := TotalSlices;
            end;
        MaxWidth := ScreenWidth - 85;
        MaxHeight := ScreenHeight - 45;
        Estimate(true);
        NumberSlices := true;
        IncrementSet := false;
        mylog := GetNewDialog(150, nil, pointer(-1));
        SetDNum(MyLog, RowsID, nRows);
        SetDNum(MyLog, ColumnsID, nColumns);
        SetDReal(MyLog, ScaleID, scale, 2);
        SetDNum(MyLog, FirstID, FirstSlice);
        SetDNum(MyLog, LastID, LastSlice);
        SetDNum(MyLog, IncrementID, inc);
        SetDialogItem(MyLog, NumberID, ord(NumberSlices));
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = ColumnsID then begin
                    nColumns := GetDNum(MyLog, ColumnsID);
                    if nColumns < 0 then begin
                            nColumns := 0;
                            SetDNum(MyLog, ColumnsID, nRows);
                        end;
                end;
            if item = RowsID then begin
                    nRows := GetDNum(MyLog, RowsID);
                    if nRows < 0 then begin
                            nRows := 0;
                            SetDNum(MyLog, RowsID, nRows);
                        end;
                end;
            if item = ScaleID then
                scale := GetDReal(MyLog, ScaleID);
            if item = FirstID then begin
                    FirstSlice := GetDNum(MyLog, FirstID);
                    if (FirstSlice < 1) or (FirstSlice > LastSlice) then
                        FirstSlice := 1;
                    if IncrementSet then
                        Estimate(false)
                    else
                        Estimate(true);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = LastID then begin
                    LastSlice := GetDNum(MyLog, LastID);
                    if (LastSlice < FirstSlice) or (LastSlice > TotalSlices) then
                        LastSlice := TotalSlices;
                    if IncrementSet then
                        Estimate(false)
                    else
                        Estimate(true);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = IncrementID then begin
                    inc := GetDNum(MyLog, IncrementID);
                    IncrementSet := true;
                    if (inc < 1) or (inc > (slices div 2)) then begin
                            inc := 1;
                            SetDNum(MyLog, IncrementID, inc);
                        end;
                    Estimate(false);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = NumberID then begin
                    NumberSlices := not NumberSlices;
                    SetDialogItem(MyLog, NumberID, ord(NumberSlices));
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if item = cancel then
            exit(MakeMontage);
        if (scale <= 0.05) or (scale > 5) then
            scale := SaveScale;
        dWidth := round(StackWidth * scale);
        dHeight := round(StackHeight * scale);
        mWidth := nColumns * dWidth;
        mHeight := nRows * dHeight;
        StackInfo := info;
        Background := MyGetPixel(0, 0);
        SetBackgroundColor(Background);
        if Background = WhiteIndex then
            SetForegroundColor(BlackIndex)
        else
            SetForegroundColor(WhiteIndex);
        if not NewPicWindow('Montage', mWidth, mHeight) then
            exit(MakeMontage);
        MontageInfo := info;
        SaveGDevice := GetGDevice;
        SetGDevice(osGDevice);
        if NumberSlices then begin
                SetPort(GrafPtr(info^.osPort));
                pmForeColor(ForegroundIndex);
                TextFont(ApplFont);
                TextSize(9);
            end;
        dPort := info^.osPort;
        dLeft := 0;
        dTop := 0;
        sPort := StackInfo^.osPort;
        sRect := StackInfo^.PicRect;
        i := FirstSlice;
        while i <= LastSlice do begin
                Info := StackInfo;
                SelectSlice(i);
                SetRect(dRect, dLeft, dTop, dLeft + dWidth, dTop + DHeight);
                CopyPics(sPort, dPort, sRect, dRect);
                info := MontageInfo;
                if NumberSlices then begin
                        MoveTo(dLeft + (dWidth div 2) - 3, dTop + dHeight - 9);
                        NumToString(i, str);
                        loc.h := dLeft + (dWidth div 2) - 3;
                        loc.v := dTop + dHeight - 5;
                        DrawTextString(str, loc, TeJustCenter);
                    end;
                UpdateScreen(dRect);
                dLeft := dLeft + dWidth;
                if (dLeft + dWidth) > mWidth then begin
                        dLeft := 0;
                        dTop := dTop + dHeight;
                    end;
                i := i + inc;
            end;
        SetGDevice(SaveGDevice);
        info := StackInfo;
        SelectSlice(info^.StackInfo^.CurrentSlice);
        if MontageInfo^.PixMapSize > UndoBufSize then
            PutWarning;
    end;


    procedure CopyRGBToPixMap (pmap: PixMapHandle);
        type
            LongPtr = ^LongInt;
        var
            row, i, width, WatchRate: integer;
            RedLine, GreenLine, BlueLine: LineType;
            Pixel, RowOffset: LongInt;
            pmapPtr: ptr;
            LPtr, RowStart: LongPtr;
    begin
        with info^ do begin
                pmapPtr := GetPixBaseAddr(pmap);
                if pmapPtr = nil then
                    exit(CopyRGBToPixMap);
                LPtr := LongPtr(pmapPtr);
                RowStart := LPtr;
                RowOffset := band(pmap^^.RowBytes, $3FFF);
                width := PicRect.right;
                WatchRate := 20000 div PixelsPerLine;
                for row := 0 to nLines - 1 do begin
                        if (row mod WatchRate) = 0 then
                            ShowAnimatedWatch;
                        SelectSlice(1);
                        GetLine(0, row, width, RedLine);
                        SelectSlice(2);
                        GetLine(0, row, width, GreenLine);
                        SelectSlice(3);
                        GetLine(0, row, width, BlueLine);
                        LPtr := RowStart;
                        for i := 0 to PixelsPerLine - 1 do begin
                                pixel := -1;
                                pixel := RedLine[i];
                                pixel := bor(bsl(pixel, 8), GreenLine[i]);
                                pixel := bor(bsl(pixel, 8), blueLine[i]);
                                LPtr^ := BitNot(pixel);
                                LPtr := LongPtr(ord4(LPtr) + 4);
                            end;
                        RowStart := LongPtr(ord4(RowStart) + RowOffset);
                    end;
                SelectSlice(StackInfo^.CurrentSlice);
            end; {with}
    end;


    function DoColorOptions: boolean;
        const
            ExistingID = 4;
            SystemID = 5;
            CustomID = 6;
            DitherID = 7;
        var
            mylog: DialogPtr;
            item: integer;

        procedure UpdateButtons;
        begin
            SetDialogItem(mylog, ExistingID, ord(RGBLut = ExistingLUT));
            SetDialogItem(mylog, SystemID, ord(RGBLut = SystemLUT));
            SetDialogItem(mylog, CustomID, ord(RGBLut = CustomLUT));
        end;

    begin
        InitCursor;
        mylog := GetNewDialog(160, nil, pointer(-1));
        SetDialogItem(mylog, DitherID, ord(DitherColor));
        UpdateButtons;
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = DitherID then begin
                    DitherColor := not DitherColor;
                    SetDialogItem(mylog, DitherID, ord(DitherColor));
                end;
            if item = ExistingID then begin
                    RGBLut := ExistingLUT;
                    UpdateButtons
                end;
            if item = SystemID then begin
                    RGBLut := SystemLUT;
                    UpdateButtons;
                    DitherColor := true;
                    SetDialogItem(mylog, DitherID, ord(DitherColor));
                end;
            if item = CustomID then begin
                    RGBLut := CustomLUT;
                    UpdateButtons
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        DoColorOptions := item <> cancel;
    end;



    function Activate (name: str255): boolean;
  {Activates the window with the specified name.}
        var
            i: integer;
            TempInfo: InfoPtr;
    begin
        Activate := false;
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                if TempInfo^.title = name then begin
                        if PicWindow[i] <> nil then begin
                                SelectWindow(PicWindow[i]);
                                Info := TempInfo;
                                ActivateWindow;
                                Activate := true;
                            end; {if}
                        leave;
                    end; {if}
            end; {for}
    end;


    procedure ConvertRGBToEightBitColor (Capturing: boolean);
        var
            err: QDErr;
            err2: OSErr;
            osGWorld: GWorldPtr;
            flags: GWorldFlags;
            pmap: PixMapHandle;
            pRect: rect;
            thePictInfo: PictInfo;
            CopyMode, SamplingMethod: integer;
            UpdateNeeded: boolean;
            SaveGDevice: GDHandle;

        procedure abort;
        begin
            DisposeGWorld(osGWorld);
            exit(ConvertRGBToEightBitColor);
        end;

    begin
        if not System7 then begin
                PutMessage('You must be running System 7 to do 24 to 8-bit color conversions.');
                exit(ConvertRGBToEightBitColor);
            end;
        with info^ do begin
                if StackInfo^.nSlices <> 3 then begin
                        PutMessage('24 to 8-bit color conversion requires a three slice(red, green and blue) stack as input.');
                        exit(ConvertRGBToEightBitColor);
                    end;
                if Capturing then begin
                        DitherColor := true;
                        RGBLut := CustomLUT;
                    end
                else if not macro then begin
                        if not DoColorOptions then
                            exit(ConvertRGBToEightBitColor);
                    end;
                flags := [];
                err := NewGWorld(osGWorld, 32, PicRect, nil, nil, flags);
                if err <> NoErr then begin
                        PutMemoryAlert;
                        exit(ConvertRGBToEightBitColor);
                    end;
                pmap := GetGWorldPixMap(osGWorld);
                if not LockPixels(pmap) then
                    abort;
                CopyRGBToPixMap(pmap);
                pRect := PicRect;
            end; {with}
        UpdateNeeded := true;
        if Activate('Indexed Color') then begin
                if (info^.PixelsPerLine <> pRect.right) or (info^.nLines <> pRect.bottom) then begin
                        if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
                            abort;
                        UpdateNeeded := false;
                    end
            end
        else begin
                if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
                    abort;
                UpdateNeeded := false;
            end;
        if RGBLut = SystemLUT then
            SwitchColorTables(SystemPaletteItem, false)
        else if RGBLut = CustomLut then begin
                if OptionKeyWasDown then
                    SamplingMethod := PopularMethod
                else
                    SamplingMethod := SystemMethod;
                err2 := GetPixMapInfo(pmap, thePictInfo, ReturnColorTable, 256, SamplingMethod, 0);
                LoadColorTable(thePictInfo.theColorTable);
            end;
        SetForegroundColor(BlackIndex);
        SetBackgroundColor(WhiteIndex);
        if DitherColor then
            CopyMode := DitherCopy
        else
            CopyMode := SrcCopy;
        SaveGDevice := GetGDevice;
        SetGDevice(osGDevice);
        SetPort(GrafPtr(Info^.osPort));
        CopyBits(BitMapHandle(pmap)^^, BitMapHandle(info^.osPort^.PortPixMap)^^, pRect, pRect, CopyMode, nil);
        SetGDevice(SaveGDevice);
        DisposeGWorld(osGWorld);
        if UpdateNeeded then
            UpdatePicWindow;
    end;


    function MakeRGBStack (name: str255): boolean;
        var
            ignore: integer;
    begin
        MakeRGBStack := false;
        if not Duplicate(name, false) then
            exit(MakeRGBStack);
        if not MakeStackFromWindow then
            exit(MakeRGBStack);
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        MakeRGBStack := true;
    end;


    procedure ConvertEightBitColorToRGB;
        var
            width, height, i, row: integer;
            srcLine, rLine, gLine, bLine: LineType;
            rLut, gLUT, bLUT: packed array[0..255] of byte;
            value: byte;
    begin
        if isGrayscaleLUT then begin
                PutMessage('8-bit color to RGB conversion requires a color image.');
                exit(ConvertEightBitColorToRGB);
            end;
        KillRoi;
        if not MakeRGBStack(concat(info^.title, '(RGB)')) then
            exit(ConvertEightBitColorToRGB);
        LoadLUT(Info^.cTable);
        for i := 0 to 255 do
            with cScreenPort^.portPixMap^^.pmTable^^.ctTable[i].rgb do begin
                    rLUT[i] := BitNot(band(bsr(red, 8), 255));
                    gLUT[i] := BitNot(band(bsr(green, 8), 255));
                    bLUT[i] := BitNot(band(bsr(blue, 8), 255));
                end;
        width := info^.PixelsPerLine;
        height := info^.nLines;
        for row := 0 to height - 1 do begin
                SelectSlice(1);
                GetLine(0, row, width, srcLine);
                for i := 0 to width - 1 do begin
                        value := srcLine[i];
                        rLine[i] := rLUT[value];
                        gLine[i] := gLUT[value];
                        bLine[i] := bLUT[value];
                    end;
                PutLine(0, row, width, rLine);
                SelectSlice(2);
                PutLine(0, row, width, gLine);
                SelectSlice(3);
                PutLine(0, row, width, bLine);
            end;
        with Info^.StackInfo^ do begin
                CurrentSlice := 1;
                SelectSlice(CurrentSlice);
                UpdateTitleBar;
            end;
    end;


    procedure CaptureColor;
        var
            MainDevice: GDHandle;
            SourcePixMap: PixMapHandle;
            frame, width, height, SaveChannel: integer;
            frect: rect;
            DisplayPoint: point;
    begin
        with info^ do
            if (PictureType <> FrameGrabberType) and (PictureType <> ScionType) then begin
                    PutMessage('You must be capturing to capture color.');
                    macro := false;
                    exit(CaptureColor);
                end;
        StopDigitizing;
        with info^.PicRect do begin
                width := right - left;
                height := bottom - top;
            end;
        if Activate('RGB') then
            with info^.PicRect do begin
                    if ((right - left) <> width) or ((bottom - top) <> height) then
                        if not MakeRGBStack('RGB') then
                            exit(CaptureColor);
                end
        else if not MakeRGBStack('RGB') then
            exit(CaptureColor);
        if FrameGrabber = Scion then begin
                HideCursor;
                MainDevice := GetMainDevice;
                SourcePixMap := MainDevice^^.gdPMap;
            end
        else begin
                ShowWatch;
                SourcePixMap := fgPort^.portPixMap;
                ResetFrameGrabber;
            end;
        if FrameGrabber = Scion then begin
                with DisplayPoint do begin
                        h := PicLeftBase;
                        v := PicTopBase;
                    end;
                with frect do begin
                        left := PicLeftBase;
                        top := PicTopBase;
                        right := left + width;
                        bottom := top + height;
                    end;
            end
        else
            with frect do begin
                    left := 0;
                    top := 0;
                    right := left + width;
                    bottom := top + height;
                end;
        ShowTriggerMessage;
        SaveChannel := VideoChannel;
        with info^, info^.StackInfo^ do begin
                for frame := 1 to 3 do begin
                        if FrameGrabber = QuickCapture then begin
                                case frame of
                                    1:
                                        VideoChannel := 1; {Green}
                                    2:
                                        VideoChannel := 0;  {Red}
                                    3:
                                        VideoChannel := 2;  {Blue}
                                end;
                                ResetFrameGrabber;
                                repeat
                                until band(ControlReg^, $8) = 0; {mux channel not busy}
                            end
                        else begin
                                VideoChannel := frame - 1;
                                ResetFrameGrabber;
                            end;
                        if VideoControl <> nil then
                            ShowChannel;
                        CurrentSlice := frame;
                        SelectSlice(CurrentSlice);
                        if FrameGrabber = Scion then begin
                                GetScionFrame(DisplayPoint);
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                            end
                        else begin
                                GetFrame;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                            end;
                    end; {for}
                CurrentSlice := 1;
                SelectSlice(CurrentSlice);
                UpdateTitleBar;
            end; {with}
        VideoChannel := SaveChannel;
        if VideoControl <> nil then
            ShowChannel;
        ConvertRGBToEightBitColor(true);
    end;


    procedure AverageSlices;
        const
            MaxWidth = 2048;
        var
            slices, sRow, aRow, slice, i, SaveSlice: integer;
            width, height, hstart, vStart: integer;
            OldInfo, NewInfo: InfoPtr;
            aLine: LineType;
            mask: rect;
            sum: array[0..MaxWidth] of LongInt;
            AutoSelectAll: boolean;
    begin
        OldInfo := Info;
        with info^ do begin
                if StackInfo = nil then begin
                        PutMessage('Average Slices requires a stack.');
                        macro := false;
                        exit(AverageSlices);
                    end;
                AutoSelectAll := not Info^.RoiShowing;
                if AutoSelectAll then
                    SelectAll(true);
                with RoiRect do begin
                        hStart := left;
                        vStart := top;
                        width := right - left;
                        height := bottom - top;
                    end;
                if width > MaxWidth then begin
                        PutMessage(concat('NIH Image can''t average selections wider than ', Long2str(MaxWidth), ' pixels.'));
                        macro := false;
                        exit(AverageSlices);
                    end;
                with StackInfo^ do begin
                        slices := StackInfo^.nSlices;
                        SaveSlice := CurrentSlice;
                    end;
                if not NewPicWindow('Average', width, height) then begin
                        macro := false;
                        exit(AverageSlices);
                    end;
            end;
        info^.changes := true;
        NewInfo := Info;
        aRow := 0;
        for sRow := vStart to vStart + height - 1 do begin
                info := OldInfo;
                for i := 0 to width - 1 do
                    sum[i] := 0;
                for slice := 1 to slices do begin
                        SelectSlice(slice);
                        GetLine(hStart, sRow, width, aLine);
                        for i := 0 to width - 1 do
                            sum[i] := sum[i] + aLine[i];
                    end;
                for i := 0 to width - 1 do
                    aLine[i] := sum[i] div slices;
                info := NewInfo;
                PutLine(0, aRow, width, aLine);
                SetRect(mask, 0, aRow, width, aRow + 1);
                aRow := aRow + 1;
                UpdateScreen(mask);
                if CommandPeriod then
                    leave;
            end;
        info := OldInfo;
        SelectSlice(SaveSlice);
        if AutoSelectAll then
            KillRoi;
    end;


    procedure ConvertRGBToHSV;
        const
            MaxSaturation = 255;
            MaxValue = 255;
        var
            width, height, i, row, mark: integer;
            rLine, gLine, bLine, hLine, sLine, vLine: LineType;
            delta, min, max, R, G, B, H, S, V: integer;
            tmp: longint;
            UpdateR: rect;

        function Max3 (a, b, c: integer): integer;
            var
                TempMax: integer;
        begin
            if (a > b) then
                TempMax := a
            else
                TempMax := b;
            if (TempMax > c) then
                Max3 := TempMax
            else
                Max3 := c;
        end;

        function Min3 (a, b, c: integer): integer;
            var
                TempMin: integer;
        begin
            if (a < b) then
                TempMin := a
            else
                TempMin := b;
            if (TempMin < c) then
                Min3 := TempMin
            else
                Min3 := c;
        end;

    begin
        with info^ do begin
                if StackInfo^.nSlices <> 3 then begin
                        PutMessage('RGB to HSV color conversion requires a three slice(red, green and blue) stack as input.');
                        exit(ConvertRGBToHSV);
                    end;
                if Changes then begin
                        if PutMessageWithCancel('RGB to HSV color conversion is undoable.') = cancel then
                            exit(ConvertRGBToHSV);
                    end;
                KillRoi;
                with StackInfo^ do begin
                        CurrentSlice := 1;
                        SelectSlice(CurrentSlice);
                        UpdatePicWindow;
                    end;
                SwitchColorTables(SpectrumItem, true);
                title := 'HSV';
                UpdateTitleBar;
                width := PixelsPerLine;
                height := nLines;
                mark := 0;
                ShowWatch;
                for row := 0 to height - 1 do begin
                        SelectSlice(1);
                        GetLine(0, row, width, rLine);
                        SelectSlice(2);
                        GetLine(0, row, width, gLine);
                        SelectSlice(3);
                        GetLine(0, row, width, bLine);
                        for i := 0 to width - 1 do begin
                                R := 255 - rLine[i];
                                G := 255 - gLine[i];
                                B := 255 - bLine[i];
                                max := Max3(R, G, B);
                                min := Min3(R, G, B);
                                V := max;
                                if max <> 0 then begin
                                        tmp := 255 * (max - min);
                                        S := (tmp + (tmp mod max)) div max;  {adding '(tmp mod max)' simulate rounding}
                                    end
                                else
                                    S := 0;
                                if S = 0 then
                                    H := 0  {undefined but, but select red }
                                else begin
                                        delta := max - min;
                                        if R = max then begin
                                                tmp := 85 * (G - B);
                                                H := tmp div delta;
                                            end
                                        else if G = max then begin
                                                tmp := 85 * (B - R);
                                                H := 170 + tmp div delta;
                                            end
                                        else if B = max then begin
                                                tmp := 85 * (R - G);
                                                H := 340 + tmp div delta;
                                            end;
                                        H := H div 2;
                                        if H < 0 then
                                            H := H + 255
                                    end;
                                if H = 0 then
                                    hLine[i] := 1
                                else
                                    hLine[i] := H;
                                sLine[i] := S;
                                vLine[i] := 255 - V;
                            end;
                        SelectSlice(1);
                        PutLine(0, row, width, hLine);
                        if (row mod 10) = 0 then begin
                                setrect(UpdateR, 0, mark, width - 1, row);
                                mark := row;
                                UpdateScreen(UpdateR);
                            end;
                        SelectSlice(2);
                        PutLine(0, row, width, sLine);