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

Text File | 1992-03-30 | 23.3 KB | 905 lines

unit Stacks;

interface

    uses
        QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Analysis, Camera, file1, file2, functions, sound;

    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;

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 in order 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(ImageSize * 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 := NewHandle(PixMapSize);
                if (h = nil) or (MaxBlock < MinFree) then begin
                        if h <> nil then
                            DisposHandle(h);
                        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(ImageSize * 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(ImageSize * 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 GetObliqueLine (xstart, ystart: real; angle: extended; count: integer; var line: LineType);
        var
            i, xbase, ybase: integer;
            LowerLeft, LowerRight, UpperLeft, UpperRight: integer;
            x, y, xinc, yinc: extended;
            xfraction, yfraction, UpperAverage, LowerAverage: extended;
    begin
        if angle = 0.0 then begin
                GetLine(trunc(xstart), trunc(ystart), count, line);
                exit(GetObliqueLine);
            end;
        if angle = 270.0 then begin
                GetColumn(trunc(xstart), trunc(ystart), count, line);
                exit(GetObliqueLine);
            end;
        x := xstart;
        y := ystart;
        angle := (angle / 180.0) * pi;
        xinc := cos(angle);
        yinc := -sin(angle);
        for i := 0 to count - 1 do begin
                xbase := trunc(x);
                ybase := trunc(y);
                xFraction := x - xbase;
                yFraction := y - ybase;
                LowerLeft := MyGetPixel(xbase, ybase);
                LowerRight := MyGetPixel(xbase + 1, ybase);
                UpperRight := MyGetPixel(xbase + 1, ybase + 1);
                UpperLeft := MyGetPixel(xbase, ybase + 1);
                UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
                LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
                line[i] := round(LowerAverage + yfraction * (UpperAverage - LowerAverage));
                x := x + xinc;
                y := y + yinc;
            end;
    end;


    procedure DoResliceOptions;
        var
            default, tmp: extended;
            Canceled: boolean;
    begin
        with info^.StackInfo^ do begin
                if SliceSpacing = 0.0 then
                    default := 1.0
                else
                    default := SliceSpacing;
                tmp := GetReal('Slice Spacing(pixels):', default, Canceled);
                if not Canceled and (tmp > 0.0) then
                    SliceSpacing := tmp;
            end;
    end;


    procedure Reslice;
        const
            Scale = 1.0;
        var
            DstWidth, DstHeight, nSlices: integer;
            dstLeft, dstTop, y, i, LineLength: integer;
            SaveWindowFlag, SaveMacro: boolean;
            SaveHScale, SaveVScale, angle, UncalibratedLineLength, CalibratedLineLength: extended;
            Stack, Reconstruction: InfoPtr;
            aLine: LineType;
            name, str1, str2: str255;
            MaskRect: rect;
            x1, y1, x2, y2: 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;
                GetLoiLength;
                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);
                GetAngle(x2 - x1, y1 - y2, angle);
                if (angle = 0.0) or (angle = 270.0) then
                    if NotInBounds then
                        exit(Reslice);
                DstWidth := round(LineLength * scale);
                DstHeight := round(nSlices * SliceSpacing * scale);
                RealToString(y1, 3, 0, str1);
                RealToString(angle, 1, 2, str2);
                name := concat(str1, '-', str2);
                nSlices := nSlices;
                if not NewPicWindow(name, DstWidth, DstHeight) then
                    exit(Reslice);
                Reconstruction := info;
                SaveWindowFlag := rsCreateNewWindow;
                SaveHScale := rsHScale;
                SaveVScale := rsVScale;
                rsCreateNewWindow := false;
                rsMethod := bilinear;
                dstLeft := round((dstWidth - LineLength) / 2);
                dstTop := round((dstHeight - nSlices) / 2);
                for i := 1 to nSlices do begin
                        Info := Stack;
                        SelectSlice(i);
                        GetObliqueLine(x1, y1, angle, LineLength, aLine);
                        info := Reconstruction;
                        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);
                        UpdateScreen(MaskRect);
                    end;
                MakeRoi(dstLeft, dstTop, LineLength, nSlices);
                rsHScale := scale;
                rsVScale := SliceSpacing * scale;
                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 := ValuesHStart;
            vstart := ValuesVStart;
            SetPort(ValuesWindow);
            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(ValuesWindow);
                        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 <> QuickCaptureType) and (PictureType <> ScionType) then begin
                        PutMessage('You must be capturing in order 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 := qcPort^.portPixMap;
                ResetQuickCapture;
            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 = QuickCapture then begin
                                if Interval >= 30 then
                                    UpdateTitleBar
                                else
                                    Show2Values(CurrentSlice, nSlices);
                                GetQuickCaptureFrame;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, SrcRect);
                                if not BlindMovieCapture then
                                    UpdatePicWindow;
                            end
                        else begin
                                GetScionFrame(DisplayPoint);
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, SrcRect);
                            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 <> QuickCaptureType) and (PictureType <> ScionType) then begin
                        PutMessage('You must be capturing in order 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 := qcPort^.portPixMap;
                ResetQuickCapture;
            end;
        FlushEvents(EveryEvent, 0);
        ExternalTrigger := false;
        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 = QuickCapture then begin
                                GetQuickCaptureFrame;
                                CheckButton;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, SrcRect);
                                CheckButton;
                                UpdatePicWindow;
                                CheckButton;
                            end
                        else begin
                                GetScionFrame(DisplayPoint);
                                CheckButton;
                                CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, SrcRect);
                                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;

end.