unit Stacks; interface uses Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,{} Resources, Errors, Palettes, QDOffscreen, PictUtils, Timer, {} VDigitizerDefs, VDigitizerM, globals, Utilities, Graphics, Analysis, {} DialogSupport, Camera, file1, file2, filters, sound, lut; procedure MakeStack; procedure MakeWindowsFromStack; function AddSlice (update: boolean): boolean; procedure DeleteSlice; procedure ShowNextSlice (item: integer); procedure ShowFirstOrLastSlice (ich: integer); procedure DoStackInfo; procedure Reslice; procedure Animate; procedure MakeMovie(ShowDialog: boolean); procedure CaptureFrames; procedure MakeMontage; procedure ConvertRGBToEightBitColor (Capturing: boolean); procedure ConvertEightBitColorToRGB; procedure CaptureColor; procedure AverageSlices; procedure ConvertRGBToHSV; { ** A(4)} function PTPixelStoreExists: longint; function DoPixelStoreMovie (var frect: rect; var Canceled: boolean): boolean; procedure PTDoPixelStoreMovie (tileSize: longint; noOfFrames: integer; frameDelaysBetweenGrabs: integer); function PTSetGrabberMode (tileSize: longint): OSErr; implementation {**A whole procedure GetUsePixelStoreResponse} procedure GetUsePixelStoreResponse (var usePixelStoreCard: boolean); const psUsePixelStoreDialog = 11131; psUsePixelStoreID = 3; var nFrames, wleft, wtop, width, height, i: integer; item: integer; myDLOG: DialogPtr; oldPort: GrafPtr; ItemType: integer; ItemBox: rect; ItemHdl: handle; begin with info^ do begin 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^, info^.StackInfo^ do begin GetPort(oldPort); { Open a dialog box and init "Use PixelStore" flag. } myDLOG := DSGetNewDialog(psUsePixelStoreDialog, nil, pointer(-1)); SetPort(myDLOG); OutlineButton(myDLOG, ok, 16); GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 0); repeat ModalDialog(nil, item); if (item = psUsePixelStoreID) then begin GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); if GetControlValue(ControlHandle(ItemHdl)) = 0 then SetControlValue(ControlHandle(ItemHdl), 1) else SetControlValue(ControlHandle(ItemHdl), 0); end; until (item = ok) or (item = cancel); if (item = ok) then begin GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); if GetControlValue(ControlHandle(ItemHdl)) <> 1 then usePixelStoreCard := false else usePixelStoreCard := true; end else usePixelStoreCard := false; end; { with } DisposeDialog(myDLOG); SetPort(oldport); end; procedure MakeStack; var ok, isStack: boolean; i, result: integer; TempInfo, SaveInfo: InfoPtr; str: str255; begin if not AllSameSize then begin PutError('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 PutError('All stacks must be closed before making a new stack.'); exit(MakeStack); end; if nPics > MaxSlices then begin NumToString(MaxSlices, str); PutError(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; UpdateWindowsMenuItem; MakingStack := false; end; procedure DeleteSlice; var SliceToDelete, NextSlice, i: integer; isRoi: boolean; {**A(2) } destPM: PixMapHandle; destRect: Rect; 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); {**A (1) } if MovieStackType = MainMemStack then begin UpdatePicWindow; DisposeHandle(PicBaseH[SliceToDelete]); end else begin if PSCurrentFrameNo <> 0 then begin destPM := Info^.osPort^.portPixMap; destRect := destPM^^.bounds; UpdatePSPicWindow(destPM, @destRect); end; end; for i := SliceToDelete to nSlices - 1 do PicBaseH[i] := PicBaseH[i + 1]; nSlices := nSlices - 1; if CurrentSlice <> 1 then CurrentSlice := CurrentSlice - 1; if (StackType = rgbStack) and (nSlices <> 3) then StackType := VolumeStack; UpdateTitleBar; if isRoi then RestoreRoi; changes := true; UpdateWindowsMenuItem; end; end; procedure MakeWindowsFromStack; var i, ignore: integer; N: LongInt; 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) * N) then begin PutError('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; {**A(2) } destPM: PixMapHandle; destRect: Rect; 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); {**A(6) } if PSCurrentFrameNo <> 0 then begin destPM := Info^.osPort^.portPixMap; destRect := destPM^^.bounds; UpdatePSPicWindow(destPM, @destRect); end else UpdatePicWindow; UpdateTitleBar; WhatToUndo := NothingToUndo; isInsertionPoint:=false; if isRoi then RestoreRoi; end; end; procedure ShowFirstOrLastSlice (ich: integer); var isRoi: boolean; {**A(2) } destPM: PixMapHandle; destRect: Rect; begin with info^, info^.StackInfo^ do begin if ich = EndKey then CurrentSlice := nSlices else CurrentSlice := 1; isRoi := RoiShowing; if isRoi then KillRoi; SelectSlice(CurrentSlice); {**A(6) } if PSCurrentFrameNo <> 0 then begin destPM := Info^.osPort^.portPixMap; destRect := destPM^^.bounds; UpdatePSPicWindow(destPM, @destRect); end else UpdatePicWindow; UpdateTitleBar; WhatToUndo := NothingToUndo; isInsertionPoint:=false; if isRoi then RestoreRoi; end; end; procedure GetSlice (xstart, ystart, start: extended; 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; function DoResliceOptions: boolean; var default, tmp: extended; Canceled: boolean; prompt, str: str255; begin with info^.StackInfo^, info^ do begin if SpatiallyCalibrated then begin default := SliceSpacing / xScale; str := xUnit; end else begin default := SliceSpacing; str := 'pixels'; end; if SliceSpacing = 0.0 then default := 1.0; tmp := GetReal(concat('Slice Spacing (', str, '):'), default, 2, Canceled); if not Canceled and (tmp > 0.0) then begin if SpatiallyCalibrated then SliceSpacing := tmp * xScale else SliceSpacing := tmp; end; end; {with} DoResliceOptions := not canceled; 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: extended; 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 PutError('Reslicing requires at least 2 slices.'); AbortMacro; exit(Reslice); end; if not (RoiShowing and (RoiType = LineRoi)) then begin PutError('Please make a straight line selection first.'); AbortMacro; exit(Reslice); end; Stack := info; GetLengthOrPerimeter(ulength, clength); LineLength := round(ulength); if LineLength = 0 then begin PutError('Line length cannot be zero.'); AbortMacro; exit(Reslice); end; if SliceSpacing = 0.0 then if not DoResliceOptions then exit(reslice);; 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.0); end else begin DstWidth := round(nSlices * SliceSpacing); if DstWidth < nSlices then DstWidth := nSlices; DstHeight := LineLength; dstLeft := round((dstWidth - nSlices) / 2.0); 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; {**A (1) } destPM: PixMapHandle; 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 PutError('Animation requires a stack.'); exit(Animate); end; with info^, info^.StackInfo^ do begin if nSlices < 2 then begin PutError('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', crStr, 'Use arrow keys to single step', crStr, '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); {**A(5) } if PSCurrentFrameNo <> 0 then begin destPM := CGrafPort(wptr^).PortPixMap; UpdatePSPicWindow(destPM, @wrect); end else 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); UpdateTitleBar end; {with} 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; {**A whole procedure GetPixelStoreMovieInfo} procedure GetPixelStoreMovieInfo (cardMemSize: longint; var SecondsBetweenFrames: extended; var Canceled: boolean); const psMovieDialog = 11129; psUsePixelStoreID = 3; psTileSize1024x512 = 8; psTileSize512x512 = 9; psMaxFramesID = 4; psCaptureDelayID = 5; var usePixelStore: boolean; nFrames, wleft, wtop, width, height, i: integer; seconds: extended; item: integer; tileSize, minTileSize, maxFramesAvail: integer; maxFrames: integer; frameDelays: extended; myDLOG: DialogPtr; oldPort: GrafPtr; ItemType: integer; ItemBox: rect; ItemHdl: handle; status: OSErr; begin Canceled := false; with info^ do begin 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^, info^.StackInfo^ do begin {PSTileSize := 524288;} maxFramesAvail := cardMemSize div 524288; nFrames := maxFramesAvail; if maxFramesAvail = 0 then begin maxFramesAvail := 250; nFrames := 20; end; GetPort(oldPort); { Open a dialog box and fill it in using the info from the VDigitizer list. } myDLOG := DSGetNewDialog(psMovieDialog, nil, pointer(-1)); SetPort(myDLOG); OutlineButton(myDLOG, ok, 16); { **C (1.44C) - up to repeat } if gFirstPSMovie then begin gUsePixelStore := false; gNFrames := 20; gMaxFrames := maxFramesAvail; gTileSize := 1024; gFrameDelays := 0.0; end; usePixelStore := gUsePixelStore; if usePixelStore then begin nFrames := gNFrames; { maxFrames := gMaxFrames;} tileSize := gTileSize; if tileSize = 1024 then maxFramesAvail := cardMemSize div 524288 else maxFramesAvail := cardMemSize div 262144; maxFrames := maxFramesAvail; if nFrames > maxFrames then nFrames := maxFrames; frameDelays := gFrameDelays; end else begin nFrames := maxFramesAvail; maxFrames := maxFramesAvail; tileSize := 1024; frameDelays := 0.0; end; minTileSize := 512; {if (VDigitizerInfo^.RoiRect.right) > 512 then} if ((VDigitizerInfo^.RoiRect.left) < 64) or ((VDigitizerInfo^.RoiRect.right) > 576) then minTileSize := 1024; if minTileSize > 512 then tileSize := 1024; PSTileSize := LongInt(tileSize) * 512; if usePixelStore then begin maxFramesAvail := cardMemSize div PSTileSize; maxFrames := maxFramesAvail; if nFrames > maxFrames then nFrames := maxFrames; end; GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); if usePixelStore then SetControlValue(ControlHandle(ItemHdl), 1) else SetControlValue(ControlHandle(ItemHdl), 0); SetDNum(myDLOG, psMaxFramesID, nFrames); SetDReal(myDLOG, psCaptureDelayID, frameDelays, 1); if tileSize = 1024 then begin GetDialogItem(myDLOG, psTileSize1024x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 1); GetDialogItem(myDLOG, psTileSize512x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 0); if minTileSize > 512 then HiliteControl(ControlHandle(ItemHdl), 254); end else if tileSize = 512 then begin GetDialogItem(myDLOG, psTileSize1024x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 0); GetDialogItem(myDLOG, psTileSize512x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 1); HiliteControl(ControlHandle(ItemHdl), 0); end; repeat ModalDialog(nil, item); if (item = psUsePixelStoreID) then begin GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); if GetControlValue(ControlHandle(ItemHdl)) = 0 then begin SetControlValue(ControlHandle(ItemHdl), 1); usePixelStore := true end else begin SetControlValue(ControlHandle(ItemHdl), 0); usePixelStore := false; end; end; if (item = psTileSize1024x512) then begin GetDialogItem(myDLOG, psTileSize1024x512, ItemType, ItemHdl, ItemBox); if minTileSize = 1024 then begin SetControlValue(ControlHandle(ItemHdl), 1); PSTileSize := 524288; maxFramesAvail := cardMemSize div PSTileSize; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); end else begin if GetControlValue(ControlHandle(ItemHdl)) = 0 then begin SetControlValue(ControlHandle(ItemHdl), 1); GetDialogItem(myDLOG, psTileSize512x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 0); PSTileSize := 524288; maxFramesAvail := cardMemSize div PSTileSize; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); end else begin SetControlValue(ControlHandle(ItemHdl), 0); GetDialogItem(myDLOG, psTileSize512x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 1); PSTileSize := 262144; maxFramesAvail := cardMemSize div PSTileSize; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); end; end; end; if (item = psTileSize512x512) and (minTileSize < 1024) then begin GetDialogItem(myDLOG, psTileSize512x512, ItemType, ItemHdl, ItemBox); if GetControlValue(ControlHandle(ItemHdl)) = 0 then begin SetControlValue(ControlHandle(ItemHdl), 1); GetDialogItem(myDLOG, psTileSize1024x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 0); PSTileSize := 262144; maxFramesAvail := cardMemSize div PSTileSize; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); end else begin SetControlValue(ControlHandle(ItemHdl), 0); GetDialogItem(myDLOG, psTileSize1024x512, ItemType, ItemHdl, ItemBox); SetControlValue(ControlHandle(ItemHdl), 1); PSTileSize := 524288; maxFramesAvail := cardMemSize div PSTileSize; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); end; end; if (item = psMaxFramesID) then begin nFrames := GetDNum(myDLOG, psMaxFramesID); if (nFrames > maxFramesAvail) and (usePixelStore = true) then begin nFrames := maxFramesAvail; SetDNum(myDLOG, psMaxFramesID, maxFramesAvail); beep; end; end; if (item = psCaptureDelayID) then begin seconds := GetDReal(myDLOG, psCaptureDelayID); if seconds < 0.0 then begin seconds := 0.0; SetDReal(myDLOG, psCaptureDelayID, seconds, 2); beep; end; end; until (item = ok) or (item = cancel); if (item = ok) then begin GetDialogItem(myDLOG, psUsePixelStoreID, ItemType, ItemHdl, ItemBox); if GetControlValue(ControlHandle(ItemHdl)) <> 1 then PSUsePixelStoreForStack := false else PSUsePixelStoreForStack := true; FramesWanted := GetDNum(myDLOG, psMaxFramesID); SecondsBetweenFrames := GetDReal(myDLOG, psCaptureDelayID); {** (A - v1.44C) 11 lines } gUsePixelStore := PSUsePixelStoreForStack; gNFrames := FramesWanted; gMaxFrames := maxFrames; if PSTileSize = 262144 then tileSize := 512 else tileSize := 1024; gTileSize := tileSize; gFrameDelays := SecondsBetweenFrames; gFirstPSMovie := false; status := PTSetGrabberMode(tileSize); Show2Values(tileSize, PSRoiRect.left); if tileSize = 512 then OffsetRect(PSRoiRect, -64, 0); end else begin Canceled := true; PSUsePixelStoreForStack := false; end; end; { with } DisposeDialog(myDLOG); SetPort(Info^.wptr); { kludge: oldport is pointing to wrong port, don't know why! } end; {**A whole procedure StartLiveDisplayToMovieW } { If not already digitizing and displaying a live image, this routine enables } { the currently selected digitizer to start digitizing and displaying a live } { image from the currently selected video input channel. } procedure StartLiveDisplayToMovieW; const shortTimeout = 15 * 60; longTimeout = 5 * 60 * 60; var frames: integer; lclTrigger: integer; status: OSErr; lclDispRect: Rect; timeoutTicks: Integer; begin { Load the digitizer's lookup tables. } LoadInputLookupTable; LoadOutputLookupTable; { Adjust the display rect as necessary} AdjustDisplayRect(lclDispRect); lclTrigger := gExtTrigger; timeoutTicks := longTimeout; status := SetVDigitizerTimeOut(timeoutTicks); { We want to do a live raw sample of video } frames := 0; with info^ do begin status := CaptureVDigitizerFrames(frames, vdNone, lclTrigger, nil, nil, PSRoiRect, nil, PSRoiRect, wptr, lclDispRect); if status = noErr then BinaryPic := false else PutMessage('Had a problem starting the acquisition.'); end; { with info^ do } end; {**A whole procedure StopLiveDisplayToMovieW } procedure StopLiveDisplayToMovieW; var frames: integer; status: OSErr; nFrames: longInt; begin with info^ do begin frames := -1; status := CaptureVDigitizerFrames(frames, vdNone, vdSource, nil, nil, PSRoiRect, nil, PSRoiRect, wptr, PSRoiRect); end; end; {**A whole function DoPixelStoreMovie} function DoPixelStoreMovie (var frect: rect; var Canceled: boolean): boolean; var nFrames, wleft, wtop, width, height: integer; SecondsBetweenFrames, seconds: extended; frameDelaysBetweenGrabs: integer; StartTicks, longFrameDelaysBetweenGrabs: longInt; ignore: integer; PSMemSize: longint; SaveInfo: InfoPtr; str1, str2, str3: str255; begin DoPixelStoreMovie := false; nFrames := 1; with info^ do begin RoiRect.left := band(RoiRect.left + 1, $fffc); {Word align} RoiRect.right := band(RoiRect.right + 2, $fffc); if RoiRect.right > PicRect.right then RoiRect.right := PicRect.right; MakeRegion; wleft := RoiRect.left; wtop := RoiRect.top; width := RoiRect.right - RoiRect.left; height := RoiRect.bottom - RoiRect.top; end; with frect do begin left := wleft; top := wtop; right := left + width; bottom := top + height; end; PSRoiRect := Info^.RoiRect; if not NewPicWindow('Movie', width, height) then exit(DoPixelStoreMovie); if not MakeStackFromWindow then exit(DoPixelStoreMovie); with info^, info^.StackInfo^ do begin PSUsePixelStoreForStack := false; Canceled := false; MovieStackType := MainMemStack; PSMemSize := PTPixelStoreExists; GetPixelStoreMovieInfo(PSMemSize, SecondsBetweenFrames, Canceled); if Canceled = true then begin ignore := CloseAWindow(wptr); exit(DoPixelStoreMovie); end; if not PSUsePixelStoreForStack then exit(DoPixelStoreMovie) else begin MovieStackType := BulkMemStack; StartLiveDisplayToMovieW; StartTicks := TickCount; while (nFrames < FramesWanted) do begin PicBaseH[CurrentSlice] := Handle(nFrames - 1); CurrentSlice := CurrentSlice + 1; nSlices := nSlices + 1; nFrames := nFrames + 1; end; PicBaseH[CurrentSlice] := Handle(nFrames - 1); longFrameDelaysBetweenGrabs := round(SecondsBetweenFrames * 30.0); frameDelaysBetweenGrabs := longFrameDelaysBetweenGrabs; PTDoPixelStoreMovie(PSTileSize, FramesWanted, frameDelaysBetweenGrabs); seconds := (TickCount - StartTicks) / 60.0; 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 nSlices >= seconds then ShowFrameRate(str3, StartTicks, nFrames) else ShowMessage(str3); StopLiveDisplayToMovieW; ShowFirstOrLastSlice(HomeKey); Changes := true; DoPixelStoreMovie := true; exit(DoPixelStoreMovie); end; end; end; function DoMakeMovieOptions: boolean; const FramesID = 3; IntervalID = 5; rateID = 7; BlindID = 9; LG3BufferID = 10; StampID = 11; UseExistingStackID = 12; TriggerID = 13; TriggerFirstID = 14; TriggerEachID = 15; var mylog: DialogPtr; item, i: integer; FramesPerSecond: extended; procedure ShowFrameRate; begin if SecondsPerFrame = 0.0 then begin {**C if fgWidth = 640 then} if vdCWidth = 640 then FramesPerSecond := 30.0 else FramesPerSecond := 25.0 end else FramesPerSecond := 1.0 / SecondsPerFrame; if FramesPerSecond = trunc(FramesPerSecond) then SetDReal(MyLog, rateID, FramesPerSecond, 0) else SetDReal(MyLog, rateID, FramesPerSecond, 4); end; procedure ShowInterval; begin if SecondsPerFrame < 1.0 then SetDReal(MyLog, IntervalID, SecondsPerFrame, 4) else if SecondsPerFrame < 99.0 then SetDReal(MyLog, IntervalID, SecondsPerFrame, 2) else SetDReal(MyLog, IntervalID, SecondsPerFrame, 0); end; procedure ShowTriggerMode; begin SetDlogItem(mylog, TriggerID, ord(ExternalTrigger)); SetDlogItem(mylog, TriggerFirstID, ord(TriggerFirstFrameOnly)); SetDlogItem(mylog, TriggerEachID, ord(not TriggerFirstFrameOnly)); end; begin InitCursor; mylog := GetNewDialog(230, nil, pointer(-1)); SetDNum(MyLog, FramesID, FramesWanted); ShowFrameRate; ShowInterval; SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); {**X SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture));} SetDlogItem(mylog, StampID, ord(TimeStamp)); ShowTriggerMode; SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack)); SelectDialogItemText(MyLog, FramesID, 0, 32767); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = FramesID then FramesWanted := GetDNum(MyLog, FramesID); if item = IntervalID then begin SecondsPerFrame := GetDReal(MyLog, IntervalID); ShowFrameRate; end; if item = rateID then begin FramesPerSecond := GetDReal(MyLog, rateID); if FramesPerSecond <> 0.0 then SecondsPerFrame := 1.0 / FramesPerSecond; ShowInterval; end; if item = BlindID then begin BlindMovieCapture := not BlindMovieCapture; SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); end; {**X if item = LG3BufferID then begin {**X LG3BufferCapture := not LG3BufferCapture; {**X if LG3BufferCapture then {**X BlindMovieCapture := true; {**X SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture)); {**X SetDlogItem(mylog, BlindID, ord(BlindMovieCapture)); {**X end;} if item = StampID then begin TimeStamp := not TimeStamp; SetDlogItem(mylog, StampID, ord(TimeStamp)); end; if item = TriggerID then begin ExternalTrigger := not ExternalTrigger; SetDlogItem (mylog, TriggerID, ord (ExternalTrigger)); end; if (item = TriggerFirstID) or (item = TriggerEachID) then begin TriggerFirstFrameOnly := not TriggerFirstFrameOnly; ExternalTrigger := true; ShowTriggerMode; end; if item = UseExistingStackID then begin UseExistingStack := not UseExistingStack; SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack)); end; until (item = ok) or (item = cancel); DisposeDialog(mylog); if FramesWanted < 1 then FramesWanted := 1; if FramesWanted > MaxSlices then FramesWanted := MaxSlices; if SecondsPerFrame < 0.0 then SecondsPerFrame := 0.0; {**X if LG3BufferCapture and (item <> cancel) then begin {**X if FrameGrabber <> ScionLG3 then begin {**X LG3BufferCapture := false; {**X PutError('Capturing to an on-board frame buffer requires a Scion LG-3.'); {**X DoMakeMovieOptions := false; {**X exit(DoMakeMovieOptions); {**X end; {**X if FramesWanted > MaxLG3Frames then begin {**X FramesWanted := MaxLG3Frames; {**X PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames to its on-board buffer.')); {**X DoMakeMovieOptions := false; {**X exit(DoMakeMovieOptions); {**X end; {**X end;} DoMakeMovieOptions := item <> cancel; end; procedure CaptureFramesUsingTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect); {**A (7) } type extraPRec = record paramsPtr: Ptr; scaleResult: Integer; scaleMin: LongInt; scaleMax: LongInt; end; var StartTicks, NextTicks, LastTicks, interval, ticks: LongInt; SourcePixMap: PixMapHandle; str: str255; frame, i: integer; ElapsedTime, avgFrameInterval: extended; {**A (10) } status: OSErr; frames, nFrameBuffers, sFrames: Integer; intFrameDelaysBetweenGrabs: integer; longFrameDelaysBetweenGrabs: longint; lclDispRect: Rect; PSMemSize: longint; triggerOption: Integer; extraParams: Ptr; extraParamsRec: extraPRec; hasFeature, hasALU, okToProceed: Boolean; begin interval := round(60.0 * SecondsPerFrame); ShowWatch; {**X SourcePixMap := fgPort^.portPixMap; {**X ResetFrameGrabber;} {**X ShowTriggerMessage; } with info^, info^.StackInfo^ do begin if Interval >= 30 then ShowMessage(CmdPeriodToStop) else DrawLabels('Frame:', 'Total:', ''); if TimeStamp then begin SetPort(GrafPtr(osPort)); TextFont(Monaco); TextSize(9); end; for frame := 1 to nFrames do begin CurrentSlice := frame; SelectSlice(CurrentSlice); if Interval >= 30 then UpdateTitleBar else Show2Values(CurrentSlice, nSlices); {**X GetFrame;} ticks:=TickCount; if (frame = 1) then begin StartTicks := ticks; NextTicks := StartTicks+interval - 3; if TriggerFirstFrameOnly then ExternalTrigger := false; end else NextTicks := NextTicks + interval; if frame = nFrames then LastTicks := ticks; {**X CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); } {**A (case) } frames := 1; if (gExtTrigger = vdExternalStart) or (gExtTrigger = vdExternalStartStop) then if (frame = 1) and TriggerFirstFrameOnly then begin frames := 0; triggerOption := gExtTrigger; end else triggerOption := vdSource; case gvdOperation of vdNone: begin status := CaptureVDigitizerFrames(frames, vdNone, triggerOption, nil, nil, fRect, nil, SrcRect, nil, SrcRect); end; vdArithAvg: begin okToProceed := true; status := TestVDigitizerFeature(nil, vdFeBALU, hasALU); if not hasALU then begin if not AllocateAccumBuffer then begin okToProceed := false; end; end; if okToProceed then begin extraParamsRec.paramsPtr := Ptr(@gBigFBPtr); if gScaleDigResults then extraParamsRec.scaleResult := 1 else extraParamsRec.scaleResult := 0; ShowWatch; with info^ do begin sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdArithAvg, triggerOption, nil, Ptr(@extraParamsRec), SrcRect, osPort^.portPixMap, SrcRect, wptr, lclDispRect); end; { with info^ do } end; { if okToProceed } end; { vdArithAvg: } vdGeomAvg: begin extraParamsRec.paramsPtr := Ptr(@gGeoAveWt); extraParamsRec.scaleResult := 0; ShowWatch; if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdGeomAvg, triggerOption, nil, Ptr(@extraParamsRec), SrcRect, osPort^.portPixMap, SrcRect, wptr, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; vdIntegrate: begin okToProceed := true; status := TestVDigitizerFeature(nil, vdFeBALU, hasALU); if not hasALU then begin if not AllocateAccumBuffer then begin okToProceed := false; end; end; if okToProceed then begin extraParamsRec.paramsPtr := Ptr(@gBigFBPtr); extraParamsRec.scaleResult := ord(gIntegrationScalingType); extraParamsRec.scaleMin := gIntegrationMin; extraParamsRec.scaleMax := gIntegrationMax; ShowWatch; with info^ do begin sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdIntegrate, triggerOption, nil, Ptr(@extraParamsRec), SrcRect, osPort^.portPixMap, SrcRect, wptr, lclDispRect); end; { with info^ do } end; { if okToProceed } end; { vdIntegrate: } vdSubtractLive: begin if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); status := CaptureVDigitizerFrames(frames, vdSubtractLive, triggerOption, BkgImageInfo^.osPort^.portPixMap, nil, fRect, nil, SrcRect, nil, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; vdMultiplyLive: begin if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); status := CaptureVDigitizerFrames(frames, vdMultiplyLive, triggerOption, BkgImageInfo^.osPort^.portPixMap, nil, fRect, nil, SrcRect, nil, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; vdBgdSubAvg: begin extraParamsRec.paramsPtr := nil; if gScaleDigResults then extraParamsRec.scaleResult := 1 else extraParamsRec.scaleResult := 0; ShowWatch; if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdBgdSubAvg, triggerOption, BkgImageInfo^.osPort^.portPixMap, nil, fRect, nil, SrcRect, nil, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; vdBgdSubGeom: begin extraParamsRec.paramsPtr := Ptr(@gGeoAveWt); extraParamsRec.scaleResult := 0; ShowWatch; if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdBgdSubGeom, triggerOption, BkgImageInfo^.osPort^.portPixMap, nil, fRect, nil, SrcRect, nil, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; vdBgdSubIntegrate: begin extraParamsRec.paramsPtr := nil; extraParamsRec.scaleResult := ord(gIntegrationScalingType); extraParamsRec.scaleMin := gIntegrationMin; extraParamsRec.scaleMax := gIntegrationMax; ShowWatch; if bkgImageInfo <> nil then begin HLock(handle(BkgImageInfo^.osPort^.portPixMap)); sFrames := FramesToAverage; status := CaptureVDigitizerFrames(sFrames, vdBgdSubIntegrate, triggerOption, BkgImageInfo^.osPort^.portPixMap, nil, fRect, nil, SrcRect, nil, lclDispRect); HUnlock(handle(BkgImageInfo^.osPort^.portPixMap)); end; end; end; { case of gvdOperation } CaptureFrameOffscreen; if TimeStamp then begin ElapsedTime:=(ticks-StartTicks) / 60.0; RealToString(ElapsedTime, 9, 3, str); for i:=1 to 5 do if str[i]=' ' then str[i]:='0'; MoveTo(2,10); DrawString(str); PlotData^[frame]:=ElapsedTime; end; if not BlindMovieCapture then UpdatePicWindow; while TickCount < NextTicks do if CommandPeriod then begin beep; wait(60); exit(CaptureFramesUsingTicks); end; end; {for} ElapsedTime := (LastTicks - StartTicks) / 60.0; avgFrameInterval := ElapsedTime / (nFrames - 1); FrameInterval := avgFrameInterval; end; {with} end; function uTickCount:extended; var count:UnsignedWide; d:extended; begin microseconds(count); d:=count.lo; if d<0 then d:=band(count.lo,$7fffffff)+2147483648.0; uTickCount:=d+count.hi*4294967296.0; end; procedure CaptureFramesUsingMicroTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect); var uStartTicks, uNextTicks, uLastTicks, uInterval, uTicks: Extended; SourcePixMap: PixMapHandle; str: str255; frame, i: integer; ElapsedTime: extended; uTicksToCaptureOneFrame, avgFrameInterval:extended; ShowProgress: boolean; begin ShowWatch; {**X uInterval := 1000000.0 * SecondsPerFrame; {**X SourcePixMap := fgPort^.portPixMap; {**X ResetFrameGrabber;} {**X ShowTriggerMessage; {**X if fgWidth = 768 then {if PAL board} {**X uTicksToCaptureOneFrame := 40000.0 {PAL captures 25 fps} {**X else {**X uTicksToCaptureOneFrame := 33333.0; {non-PAL captures 33 fps} {**X ShowProgress := (not LG3BufferCapture) or (uInterval > (2 * uTicksToCaptureOneFrame)); {**X with info^, info^.StackInfo^ do begin {**X if ShowProgress and (uInterval < 500000.0) then {**X DrawLabels('Frame:', 'Total:', '') {**X else if not ExternalTrigger then {**X ShowMessage(CmdPeriodToStop); {**X if TimeStamp then begin {**X SetPort(GrafPtr(osPort)); {**X TextFont(Monaco); {**X TextSize(9); {**X end; {**X for frame := 1 to nFrames do begin {**X CurrentSlice := frame; {**X SelectSlice(CurrentSlice); {**X if showProgress then begin {**X if uInterval >= 500000.0 then {**X UpdateTitleBar {**X else {**X Show2Values(CurrentSlice, nSlices); {**X end; {**X if LG3BufferCapture then begin {**X BufferReg^ := frame - 1; {**X GetFrame; {**X uTicks := uTickCount; {**X end else begin {**X GetFrame; {**X uTicks := uTickCount; {**X CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); {**X end; {**X if frame = 1 then begin {**X uStartTicks := uTicks; {**X uNextTicks := uStartTicks + uInterval - 1.5 * uTicksToCaptureOneFrame; {**X if TriggerFirstFrameOnly then {**X ExternalTrigger := false; {**X end else {**X uNextTicks :=uNextTicks + uInterval; {**X if frame = nFrames then {**X uLastTicks := uTicks; {**X if TimeStamp then begin {**X ElapsedTime:=(uTicks-uStartTicks) / 1000000.0; {**X PlotData^[frame]:=ElapsedTime; {**X if not LG3BufferCapture then begin {**X RealToString(ElapsedTime, 9, 3, str); {**X for i:=1 to 5 do {**X if str[i]=' ' then str[i]:='0'; {**X MoveTo(2,10); {**X DrawString(str); {**X end; {**X end; {**X if not BlindMovieCapture then {**X UpdatePicWindow; {**X if uTicks < uNextTicks then {**X while uTickCount < uNextTicks do {**X if CommandPeriod then begin {**X beep; {**X wait(60); {**X exit(CaptureFramesUsingMicroTicks); {**X end; {**X end; {for} {**X ElapsedTime := (uLastTicks - uStartTicks) / 1000000.0; {**X avgFrameInterval := ElapsedTime / (nFrames - 1); {**X FrameInterval := avgFrameInterval; {**X end; {with} {**X if LG3BufferCapture then begin {**X {Copy captured frames from LG-3 to stack.} {**X with info^, info^.StackInfo^ do begin {**X for frame := 1 to nFrames do begin {**X ShowAnimatedWatch; {**X CurrentSlice := frame; {**X SelectSlice(CurrentSlice); {**X BufferReg^ := frame - 1; {**X CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect); {**X if TimeStamp then begin {**X RealToString(PlotData^[frame], 9, 3, str); {**X for i:=1 to 5 do {**X if str[i]=' ' then str[i]:='0'; {**X MoveTo(2,10); {**X DrawString(str); {**X end; {if TimeStamp} {**X end; {for} {**X end; {with} {**X BufferReg^ := 0; {**X end; {if LG3BufferCapture} end; procedure MakeMovie(ShowDialog: boolean); var nFrames, wleft, wtop, width, height: integer; ignore: integer; OutOfMemory: boolean; seconds: extended; frect: rect; Canceled: boolean; avgFrameInterval: extended; {**A (1) } PSMemSize: longint; begin SelectCameraWindow; with info^ do begin {**C if PictureType <> FrameGrabberType then begin} if PictureType <> VDigitizerType then begin PutError('You must be capturing to make a movie.'); exit(MakeMovie); end; StopDigitizing; if not (RoiShowing and (RoiType = RectRoi)) then begin PutError('Please make a rectangular selection first.'); exit(MakeMovie); end; if NotInBounds then exit(MakeMovie); 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; with frect do begin left := wleft; top := wtop; right := left + width; bottom := top + height; end; {**A (10) } PSMemSize := PTPixelStoreExists; if (PSMemSize > 0) then begin if (DoPixelStoreMovie(frect, Canceled)) then begin if not Canceled then exit(MakeMovie); end; FramesWanted := gNFrames; SecondsBetweenFrames := gFrameDelays; UseExistingStack := false; end; if ShowDialog then if not DoMakeMovieOptions then begin AbortMacro; exit(MakeMovie); end; {** X if (FrameGrabber <> ScionLG3) then {** X LG3BufferCapture := false; {** X if LG3BufferCapture and (FramesWanted > MaxLG3Frames) then {** X FramesWanted := MaxLG3Frames; {** X if LG3BufferCapture then {** X BlindMovieCapture := true;} end; {with info^} if UseExistingStack then begin if not Activate('Movie') then begin PutError('Can''t find a stack named "Movie".'); UseExistingStack := false; AbortMacro; exit(MakeMovie); end; with info^ do begin if (PixelsPerLine <> width) or (nLines <> height) then begin PutError('The dimensions of the stack "Movie" are not the same as the selection.'); exit(MakeMovie); end; nFrames := StackInfo^.nSlices; if nFrames > FramesWanted then nFrames := FramesWanted; end {with info} end else begin {**A (1) } if (PSMemSize = 0) then begin if not NewPicWindow('Movie', width, height) then exit(MakeMovie); if not MakeStackFromWindow then exit(MakeMovie); {**A (2) } end; info^.StackInfo^.MovieStackType := MainMemStack; nFrames := 1; OutOfMemory := false; while (nFrames < FramesWanted) and (not OutOfMemory) do begin OutOfMemory := not AddSlice(false); if not OutOfMemory then nFrames := nFrames + 1; end; end; if ExternalTrigger and not TriggerFirstFrameOnly then SecondsPerFrame := 0.0; If (FramesWanted < 1) then FramesWanted := 1; if SecondsPerFrame < 0.0 then SecondsPerFrame := 0.0; with info^.StackInfo^ do begin FrameInterval := 0.0; StackType := movieStack; end; {**X if OptionKeyWasDown then } CaptureFramesUsingTicks(SecondsPerFrame, nFrames, frect); {**X else} {**X CaptureFramesUsingMicroTicks(SecondsPerFrame, nFrames, frect);} ShowFirstOrLastSlice(HomeKey); avgFrameInterval := info^.StackInfo^.FrameInterval; if AvgFrameInterval <> 0.0 then ShowMessage(StringOf(nFrames:1, ' frames', cr, AvgFrameInterval * nFrames:1:2, ' seconds', cr, AvgFrameInterval:1:3, ' seconds/frame', cr, 1 / AvgFrameInterval:1:2, ' frames/second')); if TimeStamp then begin PlotData^[0] := nFrames; PlotData^[nFrames + 1] := SecondsPerFrame; PlotCount := 0; end; end; procedure CaptureFrames; var nFrames, wleft, wtop, width, height, i: integer; ignore, SaveFW: integer; OutOfMemory, AdvanceFrame, b: boolean; frect: rect; MainDevice: GDHandle; SourcePixMap: PixMapHandle; Event: EventRecord; ShutterSound: SndListHandle; err: OSErr; {**A (4) } status: OSErr; frames, PSMemSize: integer; tempRect: Rect; hasDMA: boolean; procedure CheckButton; begin if Button and not AdvanceFrame then with Info^.StackInfo^ do begin AdvanceFrame := true; ShutterSound := SndListHandle(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 {**C if PictureType <> FrameGrabberType then begin} if PictureType <> VDigitizerType then begin PutError('You must be capturing to capture frames.'); exit(CaptureFrames); end; StopDigitizing; if not (RoiShowing and (RoiType = RectRoi)) then begin PutError('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^} 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; ShowWatch; {**X SourcePixMap := fgPort^.portPixMap; {**X ResetFrameGrabber;} FlushEvents(EveryEvent, 0); ExternalTrigger := false; {**X UpdateVideoControl;} {**A (1) } status := TestVDigitizerControl(nil, vdFcBDMAOut, hasDMA); 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; {**X GetFrame; {**X CheckButton; {**X CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);} {**A (4) } frames := 1; status := CaptureVDigitizerFrames(frames, vdNone, vdSource, nil, nil, fRect, nil, SrcRect, nil, fRect); CheckButton; CaptureFrameOffscreen; CheckButton; UpdatePicWindow; CheckButton; b := WaitNextEvent(EveryEvent, Event, 0, nil); if event.what = KeyDown then leave; end; {while} end; {with} if ShutterSound <> nil then ReleaseResource(handle(ShutterSound)); end; procedure CopyPics (sPort, dPort: cGrafPtr; sRect, dRect: rect); begin pmForeColor(BlackIndex); pmBackColor(WhiteIndex); CopyBits(BitMapHandle(sPort^.portPixMap)^^, BitMapHandle(dPort^.PortPixMap)^^, sRect, dRect, SrcCopy, nil); 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; BordersID=16; 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; IncrementSet: boolean; str: str255; loc: point; SaveGDevice: GDHandle; procedure Estimate (var scale:extended{ppc-bug}; adjustinc: boolean); var tmp, xxScale, yyScale: 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; xxScale := (MaxWidth / nColumns) / StackWidth; yyScale := (MaxHeight / nRows) / StackHeight; if xxScale < yyScale then scale := xxScale else scale := yyScale; 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(scale, 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); SetDlogItem(MyLog, NumberID, ord(gNumberSlices)); SetDlogItem(MyLog, BordersID, ord(gBorders)); 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(scale, false) else Estimate(scale, 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(scale, false) else Estimate(scale, 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(scale, false); SetDNum(MyLog, RowsID, nRows); SetDNum(MyLog, ColumnsID, nColumns); SetDReal(MyLog, ScaleID, scale, 2); end; if item = NumberID then begin gNumberSlices := not gNumberSlices; SetDlogItem(MyLog, NumberID, ord(gNumberSlices)); end; if item = BordersID then begin gBorders := not gBorders; SetDlogItem(MyLog, BordersID, ord(gBorders)); end; until (item = ok) or (item = cancel); DisposeDialog(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); SetPort(GrafPtr(info^.osPort)); pmForeColor(ForegroundIndex); 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 gNumberSlices 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; if gBorders then with dRect do begin PenSize(LineWidth, LineWidth); MoveTo(left,bottom); LineTo(left,top); LineTo(right,top); LineTo(right,bottom); LineTo(left,bottom); end; UpdateScreen(dRect); dLeft := dLeft + dWidth; if (dLeft + dWidth) > mWidth then begin dLeft := 0; dTop := dTop + dHeight; end; i := i + inc; end; FrameRect(info^.PicRect); SetGDevice(SaveGDevice); info := StackInfo; SelectSlice(info^.StackInfo^.CurrentSlice); info := MontageInfo; if info^.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 := 40000 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 SetDlogItem(mylog, ExistingID, ord(RGBLut = ExistingLUT)); SetDlogItem(mylog, SystemID, ord(RGBLut = SystemLUT)); SetDlogItem(mylog, CustomID, ord(RGBLut = CustomLUT)); end; begin InitCursor; mylog := GetNewDialog(160, nil, pointer(-1)); SetDlogItem(mylog, DitherID, ord(DitherColor)); UpdateButtons; OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = DitherID then begin DitherColor := not DitherColor; SetDlogItem(mylog, DitherID, ord(DitherColor)); end; if item = ExistingID then begin RGBLut := ExistingLUT; UpdateButtons end; if item = SystemID then begin RGBLut := SystemLUT; UpdateButtons; DitherColor := true; SetDlogItem(mylog, DitherID, ord(DitherColor)); end; if item = CustomID then begin RGBLut := CustomLUT; UpdateButtons end; until (item = ok) or (item = cancel); DisposeDialog(mylog); DoColorOptions := item <> cancel; 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; begin if not System7 then begin PutError('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 PutError('24 to 8-bit color conversion requires a three slice (red, green and blue) stack as input.'); exit(ConvertRGBToEightBitColor); end; if StackInfo^.StackType <> rgbStack then begin; StackInfo^.StackType := rgbStack; UpdateTitleBar; end; if Capturing then begin DitherColor := true; RGBLut := CustomLUT; end else if not macro then begin if not DoColorOptions then exit(ConvertRGBToEightBitColor); end; flags := 0; {ppc-bug} SaveGDevice := GetGDevice; SetGDevice(osGDevice); err := NewGWorld(osGWorld, 32, PicRect, nil, nil, flags); SetGDevice(SaveGDevice); if err <> NoErr then begin PutMemoryAlert; exit(ConvertRGBToEightBitColor); end; pmap := GetGWorldPixMap(osGWorld); if not LockPixels(pmap) then begin DisposeGWorld(osGWorld); exit(ConvertRGBToEightBitColor); end; 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 begin DisposeGWorld(osGWorld); exit(ConvertRGBToEightBitColor); end; UpdateNeeded := false; end end else begin if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then begin DisposeGWorld(osGWorld); exit(ConvertRGBToEightBitColor); end; 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; SetGDevice(osGDevice); SetPort(GrafPtr(Info^.osPort)); CopyBits(BitMapHandle(pmap)^^, BitMapHandle(info^.osPort^.PortPixMap)^^, pRect, pRect, CopyMode, nil); DisposeGWorld(osGWorld); SetGDevice(SaveGDevice); 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 PutError('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); StackType := rgbStack; UpdateTitleBar; end; ResetGrayMap; end; procedure CaptureColor; var MainDevice: GDHandle; SourcePixMap: PixMapHandle; frame, width, height, SaveChannel: integer; frect: rect; {**A (3) } DisplayPoint: point; status: OSErr; frames: integer; begin with info^ do {**C if PictureType <> FrameGrabberType then begin} if PictureType <> VDigitizerType then begin PutError('You must be capturing to capture color.'); AbortMacro; 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); ShowWatch; {**X SourcePixMap := fgPort^.portPixMap; {**X ResetFrameGrabber;} with frect do begin left := 0; top := 0; right := left + width; bottom := top + height; end; {**X ShowTriggerMessage; {**X SaveChannel := VideoChannel;} {**A (1) } status := GetVDigitizerSrc(SaveChannel); with info^, info^.StackInfo^ do begin for frame := 1 to 3 do begin {**X if FrameGrabber = QuickCapture then begin {**X case frame of {**X 1: {**X VideoChannel := 1; {Green} {**X 2: {**X VideoChannel := 0; {Red} {**X 3: {**X VideoChannel := 2; {Blue} {**X end; {**X ResetFrameGrabber; {**X repeat {**X until band(ControlReg^, $8) = 0; {mux channel not busy} {**X end {**X else begin {**X VideoChannel := frame - 1; {**X ResetFrameGrabber; {**X end; {**X if VideoControl <> nil then {**X ShowChannel;} {**A (1) } status := SetVDigitizerSrc(frame); CurrentSlice := frame; SelectSlice(CurrentSlice); {**X GetFrame; {**X CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);} {**A (3) } frames := 1; status := CaptureVDigitizerFrames(frames, vdNone, vdSource, nil, nil, frect, nil, frect, nil, frect); CaptureFrameOffscreen; end; {for} CurrentSlice := 1; SelectSlice(CurrentSlice); UpdateTitleBar; end; {with} {**X VideoChannel := SaveChannel; {**X if VideoControl <> nil then {**X ShowChannel;} {**A (1) } status := SetVDigitizerSrc(SaveChannel); 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; SlicesDiv2:LongInt; begin OldInfo := Info; with info^ do begin if StackInfo = nil then begin PutError('Average Slices requires a stack.'); AbortMacro; 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 PutError(concat('NIH Image can''t average selections wider than ', Long2str(MaxWidth), ' pixels.')); AbortMacro; exit(AverageSlices); end; with StackInfo^ do begin slices := StackInfo^.nSlices; SaveSlice := CurrentSlice; end; if not NewPicWindow('Average', width, height) then begin AbortMacro; exit(AverageSlices); end; end; info^.changes := true; NewInfo := Info; aRow := 0; SlicesDiv2:=slices div 2; {Needed for rounding} 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]+SlicesDiv2) 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; info:=NewInfo; 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 PutError('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); SelectSlice(3); PutLine(0, row, width, vLine); end; SelectSlice(1); StackInfo^.StackType := hsvStack; UpdateTitleBar; end; {with} WhatToUndo := NothingToUndo; end; procedure DoStackInfo; const VolumeID = 5; MovieID = 6; RGBID = 7; HSVID = 8; SpacingID = 11; IntervalID = 12; var mylog: DialogPtr; item: integer; spacing, SaveSpacing, SaveInterval: extended; SaveType: StackTypeType; str: str255; procedure ShowStackType; begin With info^.StackInfo^ do begin SetDlogItem(MyLog, VolumeID, ord(StackType = VolumeStack)); SetDlogItem(MyLog, MovieID, ord(StackType = MovieStack)); SetDlogItem(MyLog, RGBID, ord(StackType = rgbStack)); SetDlogItem(MyLog, HSVID, ord(StackType = hsvStack)); end; end; begin With info^, info^.StackInfo^ do begin InitCursor; mylog := GetNewDialog(280, nil, pointer(-1)); SaveType := StackType; SaveSpacing := SliceSpacing; SaveInterval := Frameinterval; ShowStackType; if SpatiallyCalibrated then begin spacing := SliceSpacing / xScale; str := xunit; end else begin spacing := SliceSpacing; str := 'pixels' end; SetDReal(MyLog, SpacingID, spacing, 3); ParamText(str, '', '', ''); if Frameinterval < 99.0 then SetDReal(MyLog, IntervalID, Frameinterval, 3) else SetDReal(MyLog, IntervalID, Frameinterval, 0); SelectDialogItemText(MyLog, SpacingID, 0, 32767); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if (item >= VolumeID) and (item <= HSVID) then begin case item of VolumeID: StackType := VolumeStack; MovieID: StackType := MovieStack; rgbID: StackType := rgbStack; hsvID: StackType := hsvStack; end; ShowStackType; end; if item = SpacingID then begin spacing := GetDReal(MyLog, SpacingID); if SpatiallyCalibrated then SliceSpacing := spacing * xScale else SliceSpacing := spacing; end; if item = IntervalID then Frameinterval := GetDReal(MyLog, IntervalID); until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then begin StackType := SaveType; SliceSpacing := SaveSpacing; Frameinterval := SaveInterval; end else if ((StackType = rgbStack) or (StackType = hsvStack)) and (nSlices <> 3) then begin PutError('RGB and HSV stacks must have three slices.'); StackType := SaveType; end; end; {with} UpdateTitleBar; end; end.