Celestin Apprentice 4

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Applications / NIH Image 1.59 / 1.59 Source / Image.p < prev next >

Wrap

Text File | 1995-10-26 | 72.2 KB | 2,542 lines | [TEXT/PJMM]

program Image; {NIH Image is a public domain program for the Macintosh for acquiring, } {processing, analyzing, editing, printing, and animating 8-bit images.} {Version 1.58, 27 June 1995} {Developed using Metrowerks CodeWarrior CW6 PPC and 68K Pascal compilers.} {Author :} {Wayne Rasband} {National Institutes of Health} {Internet: wayne@helix.nih.gov} {Anonymous ftp: zippy.nimh.nih.gov} {Phone: 301-496-4957} uses Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, {} Resources, Errors, DiskInit, Palettes, Devices, SegLoad, Balloons, AppleEvents, timer, {} Globals, Utilities, Init, File1, File2, Analysis, Graphics, {} Edit, Filters, Camera, User, Macros1, Macros2, Stacks, Background, {,UMacroDef, UMacroRun} Lut, Projection, Plugins, Text, Math, Registration, {Profiler,} fft; {Turn off automatic toolbox initialization.} {$I-} {PROCEDURE MacsBug; inline $a9ff;} procedure UpdateOptionsMenu; var CheckIt: boolean; i: integer; begin with info^ do begin CheckItem(OptionsMenuH, GrayscaleItem, (LutMode = Grayscale) or (LutMode = CustomGrayscale)); if LutMode <> PseudoColor then ColorTable := CustomTable; CheckItem(ColorTablesMenuH, SystemPaletteItem, ColorTable = AppleDefault); CheckItem(ColorTablesMenuH, Pseudo20Item, ColorTable = Pseudo20); CheckItem(ColorTablesMenuH, Pseudo32Item, ColorTable = Pseudo32); CheckItem(ColorTablesMenuH, RainbowItem, ColorTable = Rainbow); CheckItem(ColorTablesMenuH, Fire1Item, ColorTable = Fire1); CheckItem(ColorTablesMenuH, Fire2Item, ColorTable = Fire2); CheckItem(ColorTablesMenuH, IceItem, ColorTable = Ice); CheckItem(ColorTablesMenuH, GraysItem, ColorTable = Grays); CheckItem(ColorTablesMenuH, SpectrumItem, ColorTable = Spectrum); SetMenuItem(OptionsMenuH, ScaleToFitItem, info <> NoInfo); CheckIt := ScaleToFitWindow; CheckItem(OptionsMenuH, ScaleToFitItem, CheckIt); CheckItem(OptionsMenuH, ThresholdItem, Thresholding); CheckItem(OptionsMenuH, SliceItem, DensitySlicing); SetMenuItem(OptionsMenuH, PropagateItem, nPics > 1); end; end; procedure UpdateProcessMenu; var ShowItems: boolean; i: integer; str: str255; begin ShowItems := Info <> NoInfo; for i := SmoothItem to FilterItem do SetMenuItem(ProcessMenuH, i, ShowItems); with info^ do if (LutMode = GrayScale) or (LutMode = CustomGrayscale) or DensitySlicing then SetMenuItemText(ProcessMenuH, ApplyItem, 'Apply LUT') else SetMenuItemText(ProcessMenuH, ApplyItem, 'Convert to Grayscale'); if CurrentWindow = TextKind then SetMenuItemText(ProcessMenuH, ConvolveItem, 'Convolve') else SetMenuItemText(ProcessMenuH, ConvolveItem, 'Convolve…'); for i := BinaryItem to FixColorsItem do SetMenuItem(ProcessMenuH, i, ShowItems); NumToString(BinaryCount, str); str := concat('Set Count[', str, ']…'); SetMenuItemText(BinaryMenuH, SetCountItem, str); NumToString(BinaryIterations, str); str := concat('Set Iterations[', str, ']…'); SetMenuItemText(BinaryMenuH, IterationsItem, str); CheckItem(BackgroundMenuH, FasterItem, FasterBackgroundSubtraction); NumToString(BallRadius, str); str := concat('Set Radius[', str, ']…'); SetMenuItemText(BackgroundMenuH, RadiusItem, str); end; procedure UpdateSpecialMenu; var ShowItems: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(SpecialMenuH, SaveBlankFieldItem, ShowItems); SetMenuItem(SpecialMenuH, PhotoModeItem, ShowItems); if CurrentWindow = TextKind then SetMenuItemText(SpecialMenuH, LoadMacrosItem, 'Load Macros from Window') else SetMenuItemText(SpecialMenuH, LoadMacrosItem, 'Load Macros…') end; procedure UpdateStacksMenu; var ShowItems: boolean; isStack: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(StacksMenuH, StackFromWindowsItem, nPics > 0); isStack := info^.StackInfo <> nil; SetMenuItem(StacksMenuH, WindowsFromStackItem, isStack); SetMenuItem(StacksMenuH, AddSliceItem, isStack); SetMenuItem(StacksMenuH, DeleteSliceItem, isStack); SetMenuItem(StacksMenuH, NextSliceItem, isStack); SetMenuItem(StacksMenuH, PreviousSliceItem, isStack); SetMenuItem(StacksMenuH, MakeMovieItem, ShowItems); SetMenuItem(StacksMenuH, CaptureFramesItem, ShowItems); SetMenuItem(StacksMenuH, AnimateItem, isStack); SetMenuItem(StacksMenuH, AverageSlicesItem, isStack); SetMenuItem(StacksMenuH, MakeMontageItem, isStack); SetMenuItem(StacksMenuH, RegisterItem, isStack); SetMenuItem(StacksMenuH, CaptureColorItem, ShowItems); SetMenuItem(StacksMenuH, RGBToColorItem, isStack); SetMenuItem(StacksMenuH, ColorToRGBItem, ShowItems and (not isStack)); SetMenuItem(StacksMenuH, RGBToHSVItem, isStack); SetMenuItem(StacksMenuH, ProjectItem, isStack); SetMenuItem(StacksMenuH, ResliceItem, isStack); SetMenuItem(StacksMenuH, StackInfoItem, isStack); end; function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean; { simple filter proc for about box -- must be at top level! % } begin if (event.what in [MouseDown, KeyDown, AutoKey]) then begin AboutFilter := true; ItemHit := OK; end else begin AboutFilter := false; ItemHit := 0; end; end; procedure AboutUProc (d: DialogPtr; item: integer); { About box user proc -- must be at top level!} var s: str255; saveport: grafptr; VersInfo: str255; begin getport(saveport); setport(d); if (item = MemItem) then begin NumToString(FreeMem div 1024, s); s := concat(s, 'K free'); DrawSItem(MemItem, Geneva, 9, d, s); end else if (item = VersItem) then begin RealToString(version / 100.0, 4, 2, VersInfo); VersInfo := concat('Version ', VersInfo); DrawSItem(VersItem, Geneva, 9, d, VersInfo); end; setport(saveport); end; procedure DoAbout; {About Box by David Powell} var i: integer; d: dialogptr; midscreen: point; r: rect; h: handle; itype: integer; begin if AboutBoxFilterProc=nil then AboutBoxFilterProc:=NewRoutineDescriptor(@AboutFilter, uppModalFilterProcInfo, GetCurrentISA); if AboutBoxUserProc=nil then AboutBoxUserProc:=NewRoutineDescriptor(@AboutUProc, uppUserItemProcInfo, GetCurrentISA); d := getnewdialog(AboutID, nil, pointer(-1)); if (d <> nil) then begin SetPort(d); GetDialogItem(d, VersItem, itype, h, r); SetDialogItem(d, VersItem, itype, handle(AboutBoxUserProc), r); GetDialogItem(d, MemItem, itype, h, r); SetDialogItem(d, MemItem, itype, handle(AboutBoxUserProc), r); ShowWindow(d); repeat ModalDialog(AboutBoxFilterProc, i); until (i = OK); DisposeDialog(d); FlushEvents(EveryEvent, 0); end; end; procedure DoPreferences; const BufferSizeID = 4; ScaleConvolutionsID = 6; InvertValuesID = 7; InvertYID = 8; SwitchingID = 9; HighlightID = 10; CreatorID = 12; OscillatingID = 14; var mylog: DialogPtr; item, i: integer; SaveScaleC: boolean; SaveInvertValues, SaveInvertY, SaveMovies: boolean; SaveBufferSize: LongInt; SaveCreator: packed array[1..4] of char; tCreator:str255; SaveInfo:InfoPtr; begin InitCursor; if isInvertingFunction then InvertPixelValues:=true; SaveBufferSize := BufferSize; SaveInvertY := InvertYCoordinates; SaveScaleC := ScaleConvolutions; SaveCreator := TextCreator; SaveMovies := OscillatingMovies; mylog := GetNewDialog(6000, nil, pointer(-1)); SetDNum(MyLog, BufferSizeID, BufferSize div 1024); SetDlogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); SetDlogItem(mylog, InvertYID, ord(InvertYCoordinates)); SetDlogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); SetDlogItem(mylog, HighlightID, ord(HighlightMode)); SetDlogItem(mylog, OscillatingID, ord(OscillatingMovies)); SaveInvertValues := InvertPixelValues; if InvertPixelValues then SetDlogItem(mylog, InvertValuesID, 1); tCreator:='1234'; tCreator[1]:=TextCreator[1]; tCreator[2]:=TextCreator[2]; tCreator[3]:=TextCreator[3]; tCreator[4]:=TextCreator[4]; SetDString(mylog, CreatorID, tCreator); repeat ModalDialog(nil, item); if item = BufferSizeID then begin BufferSize := GetDNum(MyLog, BufferSizeID) * 1024; if BufferSize < 1 then begin beep; BufferSize := 1; SetDNum(MyLog, BufferSizeID, BufferSize); end; end; if item = ScaleConvolutionsID then begin ScaleConvolutions := not ScaleConvolutions; SetDlogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); end; if item = InvertValuesID then begin InvertPixelValues := not InvertPixelValues; SetDlogItem(mylog, InvertValuesID, ord(InvertPixelValues)); end; if item = InvertYID then begin InvertYCoordinates := not InvertYCoordinates; SetDlogItem(mylog, InvertYID, ord(InvertYCoordinates)); end; if item = SwitchingID then begin SwitchLUTOnSuspend := not SwitchLUTOnSuspend; SetDlogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); end; if item = HighlightID then begin HighlightMode := not HighlightMode; SetDlogItem(mylog, HighlightID, ord(HighlightMode)); LoadLUT(info^.ctable); end; if item = CreatorID then begin tCreator := GetDString(mylog, item); if length(tCreator)=4 then begin TextCreator[1]:=tCreator[1]; TextCreator[2]:=tCreator[2]; TextCreator[3]:=tCreator[3]; TextCreator[4]:=tCreator[4]; end; end; if item = OscillatingID then begin OscillatingMovies := not OscillatingMovies; SetDlogItem(mylog, OscillatingID, ord(OscillatingMovies)); end; until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then begin BufferSize := SaveBufferSize; ScaleConvolutions := SaveScaleC; InvertYCoordinates := SaveInvertY; OscillatingMovies := SaveMovies; if PasteControl <> nil then DrawPasteControl; TextCreator := SaveCreator; end else with info^ do begin if InvertPixelValues then begin SaveInfo:=info; for i := 1 to nPics do begin Info := pointer(WindowPeek(PicWindow[i])^.RefCon); if info^.fit=uncalibrated then InvertGrayLevels end; {for} info:=SaveInfo; end else if (InvertPixelValues = false) and SaveInvertValues then begin SaveInfo:=info; for i := 1 to nPics do begin Info := pointer(WindowPeek(PicWindow[i])^.RefCon); if isInvertingFunction then RemoveDensityCalibration; end; {for} info:=SaveInfo; end; end; if BufferSize <> SaveBufferSIze then begin PutError('You must quit and restart NIH Image before the Undo and Clipboard buffer size change will take effect.'); SaveSettings; end; end; procedure UpdateWindowsMenu; var i, n: integer; begin for i := NextImageItem to TileImagesItem do SetMenuItem(WindowsMenuH, i, nPics > 1); for i := SelectToolsItem to SelectResultsItem do CheckItem(WindowsMenuH, i, false); SetMenuItem(WindowsMenuH, SelectHistogramItem, HistoWindow <> nil); SetMenuItem(WindowsMenuH, SelectPlotItem, PlotWindow <> nil); SetMenuItem(WindowsMenuH, SelectResultsItem, ResultsWindow <> nil); for i := 1 to nTextWindows do CheckItem(WindowsMenuH, WindowsMenuItems - 1 + i, false); for i := 1 to nPics do CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + i, false); if PasteControl = nil then SetMenuItemText(WindowsMenuH, PasteControlItem, 'Show Paste Control') else SetMenuItemText(WindowsMenuH, PasteControlItem, 'Hide Paste Control'); if CurrentKind < 0 then exit(UpdateWindowsMenu); {System Window} case CurrentKind of ToolKind: CheckItem(WindowsMenuH, SelectToolsItem, true); MapKind: CheckItem(WindowsMenuH, SelectGrayMapItem, true); LUTKind: CheckItem(WindowsMenuH, SelectLutItem, true); InfoKind: CheckItem(WindowsMenuH, SelectInfoItem, true); HistoKind: CheckItem(WindowsMenuH, SelectHistogramItem, true); ProfilePlotKind, CalibrationPLotKind: CheckItem(WindowsMenuH, SelectPlotItem, true); ResultsKind: CheckItem(WindowsMenuH, SelectResultsItem, true); TextKind: begin if TextInfo <> nil then CheckItem(WindowsMenuH, WindowsMenuItems - 1 + TextInfo^.WindowNum, true); end; PicKind: CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + info^.PicNum, true); otherwise end; end; procedure CloseAll; FORWARD; procedure DoNew; const ImageID = 4; TextID = 5; WidthID = 6; HeightID = 7; TitleID = 8; var mylog: DialogPtr; item, i: integer; SaveWidth, SaveHeight: integer; SaveTitle: string[31]; okay, OpenImage: boolean; procedure SetButtons; begin SetDlogItem(mylog, ImageID, ord(OpenImage)); SetDlogItem(mylog, TextID, ord(not OpenImage)); end; begin InitCursor; OpenImage := true; SaveWidth := NewPicWidth; SaveHeight := NewPicHeight; SaveTitle := NewTitle; mylog := GetNewDialog(180, nil, pointer(-1)); SetButtons; SetDNum(MyLog, WidthID, NewPicWidth); SelectdialogItemText(MyLog, WidthID, 0, 32767); SetDNum(MyLog, HeightID, NewPicHeight); SetDString(MyLog, TitleID, NewTitle); repeat ModalDialog(nil, item); if item = ImageID then begin OpenImage := true; SetButtons; end; if item = TextID then begin OpenImage := false; SetButtons; end; if item = WidthID then begin NewPicWidth := GetDNum(MyLog, WidthID); if (NewPicWidth < 0) or (NewPicWidth > MaxPicSize) then begin NewPicWidth := SaveWidth; SetDNum(MyLog, WidthID, NewPicWidth); end; end; if item = HeightID then begin NewPicHeight := GetDNum(MyLog, HeightID); if (NewPicHeight < 0) or (NewPicHeight > MaxPicSize) then begin NewPicHeight := SaveHeight; SetDNum(MyLog, HeightID, NewPicHeight); end; end; until (item = ok) or (item = cancel); if item = ok then NewTitle := GetDString(MyLog, TitleID); DisposeDialog(mylog); if NewPicWidth < 32 then NewPicWidth := 32; if NewPicHeight < 16 then NewPicHeight := 16; if item = cancel then begin NewPicWidth := SaveWidth; NewPicHeight := SaveHeight; NewTitle := SaveTitle; exit(DoNew); end; if OpenImage then begin okay := NewPicWindow(NewTitle, NewPicWidth, NewPicHeight); if okay then if info^.PixMapSize > UndoBufSize then PutWarning; end else okay := MakeNewTextWindow(NewTitle, 500, 400); end; procedure DoMenuEvent (MenuChoice: LongInt); var MenuID, MenuItem, i, ignore: integer; name, str: str255; dna, RefNum: integer; ItemName: str255; FontName: str255; ok, isSelection: boolean; NewStyle: StyleItem; t: FateTable; {Only needed for MakeSkeleton} SaveBFInfo: InfoPtr; err: OSErr; begin MenuID := HiWrd(MenuChoice); MenuItem := LoWrd(MenuChoice); case MenuID of AppleMenu: begin if MenuItem = 1 then DoAbout else begin GetMenuItemText(GetMenuHandle(AppleMenu), MenuItem, name); ignore := OpenDeskAcc(name) end; end; FileMenu: begin StopDigitizing; isInsertionPoint := false; case MenuItem of NewItem: DoNew; OpenItem: ok := DoOpen('', 0); ImportItem: ok := ImportFile('', 0); {-} CloseItem: if OptionKeyWasDown and (CurrentWindow <> TextKInd) then CloseAll else DoClose; SaveItem: if OptionKeyWasDown and (info^.StackInfo = nil) and (CurrentWindow <> TextKind) then SaveAll else SaveFile; SaveAsItem: case CurrentWindow of TextKind: SaveTextAs; ResultsKind: Export('', 0); otherwise SaveAs('', 0); end; ExportItem: Export('', 0); {-} RecordPreferencesItem: SaveSettings; RevertItem: with info^ do if DataType = EightBits then RevertToSaved else RescaleToEightBits; DuplicateItem: ok := Duplicate('', false); GetInfoItem: GetInfo; {-} PageSetupItem: if OptionKeyDown then SetHalftone else DoPageSetup; PrintItem: Print(true); {-} QuitItem: finished := true; end; if OpeningRGB then begin ConvertRGBToEightBitColor(true); OpeningRGB := false; end; end; AcquireMenu: RunAcqPlugIn(MenuItem); ExportMenu: RunExportPlugIn(MenuItem); EditMenu: begin StopDigitizing; GetMenuItemText(GetMenuHandle(EditMenu), MenuItem, ItemName); if not SystemEdit(MenuItem - 1) then case MenuItem of UndoItem: DoUndo; {-} CutItem: DoCut; CopyItem: DoCopy; PasteItem: DoPaste; ClearItem: DoClear; {-} FillItem: if CurrentWindow = TextKind then DoFind else SetupOperation(FillItem); InvertItem, DrawBoundaryItem: SetupOperation(MenuItem); DrawScaleItem: DrawScale; {-} SelectAllItem: with info^ do if CurrentWindow = TextKind then SelectAllText else if RoiShowing and EqualRect(RoiRect, PicRect) then KillRoi else SelectAll(true); DeselectItem: KillRoi; ScaleAndRotateItem: ScaleAndRotate; {-} RotateLeftItem: Rotate(RotateLeft); RotateRightItem: Rotate(RotateRight); FlipVerticalItem: FlipOrRotate(FlipVertical); FlipHorizontalItem: FlipOrRotate(FlipHorizontal); {-} UnzoomItem: Unzoom; ShowClipboardItem: ShowClipboard; end; end; OptionsMenu: begin case MenuItem of GrayscaleItem: ResetGrayMap; LutOptionsItem: DoLutOptions; {-} PreferencesItem: DoPreferences; PlotOptionsItem: DoProfilePlotOptions; ScaleToFitItem: ScaleToFit; ThresholdItem: begin if DensitySlicing then DisableDensitySlice; if Info^.Thresholding then DisableThresholding else begin SetupLutUndo; AutoThreshold; end; end; SliceItem: if DensitySlicing then DisableDensitySlice else begin if info^.thresholding then DisableThresholding; EnableDensitySlice; end; end; end; ColorTablesMenu: SwitchColorTables(MenuItem, true); FontMenu: begin GetMenuItemText(FontMenuH, MenuItem, FontName); GetFNum(FontName, CurrentFontID); DisplayText(true); if CurrentWindow = TextKind then ChangeFontOrSize; end; SizeMenu: begin case MenuItem of 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12: CurrentSize := GetFontSize(MenuItem); end; DisplayText(true); if IsInsertionPoint then UpdatePicWindow; if CurrentWindow = TextKind then ChangeFontOrSize; end; StyleMenu: begin case MenuItem of 1: CurrentStyle := []; 2, 3, 4, 5, 6: begin case MenuItem of TxBold: NewStyle := Bold; TxItalic: NewStyle := Italic; TxUnderLine: NewStyle := Underline; TxOutLine: NewStyle := Outline; TxShadow: NewStyle := Shadow; end; if NewStyle in CurrentStyle then CurrentStyle := CurrentStyle - [NewStyle] else CurrentStyle := CurrentStyle + [NewStyle]; end; LeftItem: TextJust := teJustLeft; CenterItem: TextJust := teJustCenter; RightItem: TextJust := teJustRight; NoBackgroundItem: TextBack := NoBack; WithBackgroundItem: TextBack := WithBack; end; {case} DisplayText(true); end; PropagateMenu: DoPropagate(MenuItem); ProcessMenu: begin StopDigitizing; SetupUndo; case MenuItem of SmoothItem: if OptionKeyDown then Filter(UnweightedAvg, 0, t) else Filter(WeightedAvg, 0, t); SharpenItem: Filter(fsharpen, 0, t); ShadowItem: DoShadowFilter; FindEdgesItem: Filter(FindEdges, 0, t); RankItem: DoRankFilter; DitherItem: Filter(Dither, 0, t); ConvolveItem: if CurrentWindow = TextKind then ConvolveUsingText else Convolve('', 0); {-} ImageMathItem: DoImageMath; ApplyItem: if CheckCalibration then ApplyLookupTable; EnhanceItem: EnhanceContrast; EqualizeItem: EqualizeHistogram; FixColorsItem: if not isBinaryImage then FixColors; end; end; FilterMenu: RunFilterPlugin(menuItem); BinaryMenu: case MenuItem of MakeBinaryItem: MakeBinary; ErosionItem: DoErosion; DilationItem: DoDilation; OpeningItem: DoOpening; ClosingItem: DoClosing; SetCountItem: SetBinaryCount; IterationsItem: SetIterations; OutlineItem: filter(OutlineFilter, 0, t); SkeletonizeItem: MakeSkeleton; end; ArithmeticMenu: DoArithmetic(MenuItem, 0); fftMenu: case MenuItem of ForewardFFTItem: doFFT(ForewardFFT); InverseFFTItem: doFFT(InverseFFTWithMask); RedisplayItem: RedisplayPowerSpectrum; SwapItem: doSwapQuadrants; end; BackgroundMenu: DoBackgroundMenuEvent(MenuItem); AnalyzeMenu: begin if MenuItem <> HistogramItem then StopDigitizing; SetupUndo; case MenuItem of MeasureItem: Measure; AnalyzeItem: AnalyzeParticles; ShowItem: ShowResults; OptionsItem: DoMeasurementOptions; HistogramItem: DoHistogram; PlotItem: PlotDensityProfile; PlotSurfaceItem: PlotSurface; {-} SetScaleItem: SetScale; CalibrateItem: Calibrate; RedoItem: RedoMeasurement; DeleteItem: DeleteMeasurement; ResetItem: ResetCounter; RestoreItem: RestoreRoi; MarkItem: MarkSelection(mCount); end; end; SpecialMenu: begin case MenuItem of StartItem: StartDigitizing; AverageItem: AverageFrames; SaveBlankFieldItem: begin SaveBFInfo := BlankFieldInfo; BlankFieldInfo := nil; {Prevents shading correction.} StopDigitizing; BlankFieldInfo := SaveBFInfo; SaveBlankField; end; VideoControlItem: ShowVideoDialog; PhotoModeItem: PhotoMode; LoadMacrosItem: begin LoadMacros; {$ifc not PowerPC} UnloadSeg(@LoadMacros); {$endc} end; otherwise if MenuItem >= FirstMacroItem then RunMacro(MenuItem - FirstMacroItem + 1); {if MenuItem >= FirstMacroItem then begin if ProfilerInit(collectDetailed, bestTimeBase, 50, 25) = noErr then begin RunMacro(MenuItem - FirstMacroItem + 1); err := ProfilerDump('Image.prof'); ProfilerTerm; end; end;} end; end; StacksMenu: begin StopDigitizing; case MenuItem of StackFromWindowsItem: MakeStack; WindowsFromStackItem: MakeWindowsFromStack; AddSliceItem: ok := AddSlice(true); DeleteSliceItem: DeleteSlice; NextSliceItem, PreviousSliceItem: ShowNextSlice(MenuItem); MakeMovieItem: MakeMovie(true); CaptureFramesItem: CaptureFrames; AnimateItem: Animate; AverageSlicesItem: AverageSlices; MakeMontageItem: MakeMontage; CaptureColorItem: CaptureColor; RGBToColorItem: ConvertRGBToEightBitColor(false); ColorToRGBItem: ConvertEightBitColorToRGB; RGBToHSVItem: ConvertRGBToHSV; RegisterItem: DoRegister; ProjectItem: Project; ResliceItem: Reslice; StackInfoItem: DoStackInfo; otherwise beep end; end; WindowsMenu: begin if MenuItem <> PasteControlItem then StopDigitizing; case MenuItem of NextImageItem: ShowNextImage; CascadeImagesItem: CascadeImages; TileImagesItem: TileImages; PasteControlItem: if PasteControl = nil then ShowPasteControl else ignore := CloseAWindow(PasteControl); {-} SelectToolsItem: SelectWindow(ToolWindow); SelectGrayMapItem: SelectWindow(MapWindow); SelectLutItem: SelectWindow(LUTWindow); SelectInfoItem: SelectWindow(InfoWindow); SelectHistogramItem: if HistoWindow <> nil then SelectWindow(HistoWindow); SelectPlotItem: if PlotWindow <> nil then SelectWindow(PlotWindow); SelectResultsItem: if ResultsWindow <> nil then SelectWindow(ResultsWindow); {-} otherwise if MenuItem <= (WindowsMenuItems - 1 + nTextWindows) then SelectWindow(TextWindow[MenuItem - (WindowsMenuItems - 1)]) else SelectWindow(PicWindow[MenuItem - (WindowsMenuItems + nTextWindows)]); end; end; UserMenu: DoUserMenuEvent(MenuItem); otherwise end; HiliteMenu(0); RoiUpdateTime := 0; end; procedure DoFreehand; var finish: point; event: EventRecord; wright, wbottom: integer; b: boolean; begin SetPort(info^.wptr); PenPat(AntPattern[PatIndex]); PenSize(1, 1); with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; while Button do begin GetMouse(finish); with finish do begin if h < 0 then h := 0; if v < 0 then v := 0; if h > wright then h := wright; if v > wbottom then v := wbottom; if (xCoordinates^[nCoordinates] <> h) or (yCoordinates^[nCoordinates] <> v) then begin if nCoordinates < MaxCoordinates then nCoordinates := nCoordinates + 1 else beep; LineTo(h, v); xCoordinates^[nCoordinates] := h; yCoordinates^[nCoordinates] := v; wait(1); end; {if mouse has moved} end; {with} end; {while Button} end; procedure DoPolygon (start: point); var Finish, OldFinish: point; finished, DoubleClick, done: boolean; ticks, MouseUpTime, LastMouseUpTime: LongInt; wright, wbottom: integer; StartRect: rect; MouseDown, MouseUpEvent: boolean; begin DrawLabels('DX:', 'DY:', 'Length:'); SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); if CurrentTool = PolygonTool then begin Pt2Rect(Start, Start, StartRect); InsetRect(StartRect, -4, -4); FrameRect(StartRect); end else SetRect(StartRect, 0, 0, 0, 0); finish := start; finished := false; with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; MouseUpTime := 0; done := false; MouseUpEvent := false; MouseDown := button; repeat ShowDxDy(0, 0); repeat OldFinish := finish; GetMouse(finish); with finish do begin n begin KillRoi; MouseState := NotInRoi; exit(DoMouseDownInWindow); end; if MouseState <> NotInRoi then exit(DoMouseDownInWindow); if SpaceBarDown and (CurrentTool <> TextTool) then tool := grabber else tool := CurrentTool; if (SelectionMode = NewSelection) and not ((tool = MagnifyingGlass) or (tool = Grabber)) then KillRoi; SetupUndo; case tool of SelectionTool: DoObject(SelectionRect, event); PolygonTool, FreehandTool: MakePolygon(event); OvalSelectionTool: DoObject(SelectionOval, event); LineTool: MakeLineRoi(event); MagnifyingGlass: ZoomIn(event); Grabber: Scroll(event); Pencil, Brush, Eraser: DoBrush(event); SprayCanTool: DoSprayCan; Ruler: if OptionKeyDown or ControlKeyDown then PutError('Use the line selection tool and Measure to measure path lengths.') else begin DoObject(LineObj, event); WhatToUndo := UndoEdit; end; PaintBucket: DoFill(event); TextTool: DoText(event.where); PlotTool: DoProfilePlot(event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); CrossHairTool: DoPoints(event); AngleTool: FindAngle(event); Wand: begin if Digitizing then StopDigitizing; start := event.where; ScreenToOffscreen(start); AutoOutline(start); end; otherwise beep; end; end; procedure DoPopupMenusInTools; var Item: integer; ticks: LongInt; procedure DrawCurrentTool; begin InvalRect(ToolRect[CurrentTool]); BeginUpdate(ToolWindow); DrawTools; EndUpdate(ToolWindow); end; begin DrawCurrentTool; ticks := TickCount; repeat until (not button) or (TickCount > ticks + 20); if button and (TickCount > (ticks + 20)) then with ToolRect[CurrentTool] do begin Item := PopUpMenu(LineToolMenuH, left, top, ord(LOIType) + 1); case Item of 1: LOIType := Straight; 2: LOIType := Freehand; 3: LOIType := Segmented; otherwise end; DrawCurrentTool; end; end; procedure DoMouseDownInTools (loc: point); {Handles mouse down events in the tool palette.} var r: rect; OddTool, DoubleClick: boolean; ToolNum, i: integer; begin SetPort(ToolWindow); GlobalToLocal(loc); if loc.v <= StartOfLines then begin PreviousTool := CurrentTool; OddTool := loc.h < tmiddle; ToolNum := (loc.v div tmiddle) * 2; if not OddTool then ToolNum := ToolNum + 1; CurrentTool := ToolType(ToolNum); isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool); DoubleClick := (TickCount - ToolTime) < GetDblTime; ToolTime := TickCount; InvalRect(ToolRect[CurrentTool]); InvalRect(ToolRect[PreviousTool]); IsInsertionPoint := false; if DoubleClick and (CurrentTool = PreviousTool) then case CurrentTool of MagnifyingGlass: Unzoom; SelectionTool: begin StopDigitizing; SelectAll(true); end; SprayCanTool: SetSprayCanSize; Brush: SetBrushSize; LineTool: SetScale; PolygonTool: DoMeasurementOptions; FreehandTool: Calibrate; ruler: SetLineWidth; PlotTool: DoProfilePlotOptions; Eraser: if info <> NoInfo then begin KillRoi; SetupUndo; WhatToUndo := UndoClear; StopDigitizing; SelectAll(false); DoOperation(eraseOp); end; LutTool, Wand: if DensitySlicing then DisableDensitySlice else begin if Info^.Thresholding then ResetGrayMap; if OptionKeyDown then AutoDensitySlice; EnableDensitySlice; end; PickerTool: if info^.LutMode <> PseudoColor then begin {Switch to pseudocolor mode} DisableDensitySlice; UpdateLUT; CurrentTool := LutTool; isSelectionTool := false; InvalRect(ToolRect[CurrentTool]); end else ResetGrayMap; otherwise end; {case} if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) and (CurrentTool <> Wand) then KillRoi; if not DoubleClick and (CurrentTool = LineTool) then KillRoi; with info^ do if RoiShowing then if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All} KillRoi; if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin InfoMessage := ''; if mCount > 0 then ShowInfo; end; RoiMode := MoveMode; if CurrentTool = LineTool then begin if Button then DoPopUpMenusInTools; if (LoiType = Straight) and (LineWidth <> 1) then begin LineWidth := 1; UpdateRoiLineWidth; ShowLineWidth; end; end; end else begin for i := 1 to nLineTypes do begin r := lines[i]; with r do begin left := left - 13; top := top - 2; right := right + 2; bottom := bottom + 2; end; if i = 1 then with r do top := top - 7; if PtInRect(loc, r) then begin with lines[i] do LineWidth := bottom - top; LineIndex := i; end; end; EraseRect(CheckRect); InvalRect(CheckRect); UpdateRoiLineWidth; end; end; procedure ScaleToFitScreen; var trect: rect; ignore: boolean; begin with info^ do begin MoveWindow(wptr, PicLeftBase, PicTopBase, true); SetRect(trect, 0, 0, ScreenWidth, ScreenHeight); ScaleImageWindow(trect); wrect := trect; SizeWindow(wptr, trect.right, trect.bottom, true); end; end; procedure DoDrag (WhichWindow: WindowPtr; loc: point); var WinRect, DragBounds, trect: rect; kind: integer; begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind = PicKind then begin with info^ do begin {Save window location} GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; end; PicLeft := PicLeftBase; PicTop := PicTopBase; end; DragBounds := qd.ScreenBits.bounds; DragWindow(WhichWindow, loc, DragBounds); if (info^.PictureType = FrameGrabberType) or OptionKeyDown then begin GetWindowRect(WhichWindow, trect); MoveWindow(WhichWindow, band(trect.left, $fffc), trect.top, true); end; if WhichWindow = InfoWindow then ShowInfo; if WhichWindow = ResultsWindow then begin GetWindowRect(WhichWindow, trect); ResultsTop := trect.top; ResultsLeft := trect.left; end; end; procedure UpdateMenus; begin OptionKeyWasDown := OptionKeyDown; CurrentKind := CurrentWindow; UpdateFileMenu; UpdateEditMenu; UpdateOptionsMenu; UpdateTextItems; UpdateProcessMenu; UpdateAnalysisMenu; UpdateSpecialMenu; UpdateStacksMenu; UpdateWindowsMenu; end; function BalloonHelp: boolean; begin if not System7 then begin BalloonHelp := false; exit(BalloonHelp); end; BalloonHelp := HMGetBalloons; end; procedure DoMouseDown (event: EventRecord); {Handle mouse-down events} var WhichWindow: WindowPtr; ThePart, ignore, kind: integer; trect: rect; begin ThePart := FindWindow(event.where, WhichWindow); case ThePart of InDesk: ; InMenuBar: begin UpdateMenus; DoMenuEvent(MenuSelect(event.where)); end; InSysWindow: SystemClick(Event, WhichWindow); InContent: begin {The Tools, Map, LUT and PasteControl windows do not have to be activated to process the mouse-down event.} RoiUpdateTime := 0; if WhichWindow = ToolWindow then begin if BalloonHelp then SelectWindow(ToolWindow); DoMouseDownInTools(event.where); exit(DoMouseDown); end; if WhichWindow = MapWindow then begin if BalloonHelp then SelectWindow(MapWindow); DoMouseDownInMap; exit(DoMouseDown) end; if WhichWindow = LUTWindow then begin if BalloonHelp then SelectWindow(LUTWindow); DoMouseDownInLUT(event); exit(DoMouseDown) end; if WhichWindow = PasteControl then begin DoMouseDownInPasteControl(event.where); exit(DoMouseDown) end; if WhichWindow <> FrontWindow then begin {Image windows, text windows and the Result window must be activated if they are not the current window.} SelectWindow(WhichWindow); exit(DoMouseDown); end; if WhichWindow = ResultsWindow then begin DoMouseDownInResults(event.where); exit(DoMouseDown) end; kind := WindowPeek(WhichWindow)^.WindowKind; if Kind = TextKind then begin DoMouseDownInText(Event, WhichWindow); exit(DoMouseDown) end; if kind = PicKind then DoMouseDownInWindow(Event, WhichWindow); end; InDrag: DoDrag(WhichWindow, event.where); InGrow: DoGrow(WhichWindow, event); InGoAway: if TrackGoAway(WhichWindow, event.where) then if OptionKeyDown and (CurrentWindow = PicKind) then CloseAll else begin if WhichWindow <> VideoControl then StopDigitizing; ignore := CloseAWindow(WhichWindow); end; InZoomIn, InZoomOut: with info^ do case WindowState of NormalWindow: begin if digitizing then exit(DoMouseDown); ScaleToFit; if ScaleToFitWindow then ScaleToFitScreen; end; TiledSmall, TiledSmallScaled: begin if WindowState = TiledSmall then begin ScaleToFitWindow := true; WindowState := TiledBig; end else WindowState := TiledBigScaled; savewrect := wrect; SaveSrcRect := SrcRect; SaveMagnification := magnification; GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; ScaleToFitScreen; UpdatePicWindow; end; TiledBig: begin ScaleToFitWindow := false; WindowState := TiledSmall; wrect := savewrect; SrcRect := SaveSrcRect; magnification := SaveMagnification; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; magnification := 1.0; UpdateTitleBar; end; TiledBigScaled: begin WindowState := TiledSmallScaled; wrect := savewrect; SrcRect := PicRect; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; if PicRect.right <> 0 then magnification := wrect.right / PicRect.right; UpdateTitleBar; end; end; {case WindowState} end; {case thePart} end; procedure NudgeRoi (key: integer); var dh, dv: integer; begin with info^ do begin if not RoiShowing then exit(NudgeRoi); if OpPending and (CurrentOp <> PasteOp) then begin KillRoi; RestoreRoi; end; case key of LeftArrow: begin dh := -1; dv := 0 end; RightArrow: begin dh := 1; dv := 0 end; UpArrow: begin dh := 0; dv := -1 end; DownArrow: begin dh := 0; dv := 1 end; end; if OptionKeyDown then begin if RoiType = RectRoi then with RoiRect do begin right := right + dh; if right < left + 2 then right := left + 2; bottom := bottom + dv; if bottom < top + 2 then bottom := top + 2; MakeRegion; end else beep; end else begin OffsetRgn(roiRgn, dh, dv); RoiRect := roiRgn^^.rgnBBox; end; RoiNudged := true; RoiUpdateTime := 0; end; end; procedure DoKeyDown (event: EventRecord); var ch: char; ich, KeyCode: integer; begin Ch := chr(band(Event.message, CharCodeMask)); ich := ord(ch); {ShowMessage(long2str(ich));} KeyCode := bsr(band(Event.message, KeyCodeMask), 8); if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin UpdateMenus; if OptionKeyWasDown then begin case KeyCode of 1: ch := 'S'; 3: ch := 'F'; 5: ch := 'G'; 8: ch := 'C'; 9: ch := 'V'; 13: ch := 'W'; 17: ch := 'T'; 24: ch := '='; 35: ch := 'P'; 44: ch := '/'; end; end; DoMenuEvent(MenuKey(Ch)); exit(DoKeyDown) end; if CurrentWindow = TextKind then begin DoKeyDownInText(ch); exit(DoKeyDown) end; with info^ do if (CurrentTool = TextTool) and IsInsertionPoint and (ord(ch) <> FunctionKey) then DrawCharacter(ch) else if ch = BackSpace then DoClear else if RoiShowing and (ich >= LeftArrow) and (ich <= DownArrow) then NudgeRoi(ich) else if (StackInfo <> nil) and (ch in ['<', ',', chr(PageUp), '>', '.', chr(PageDown), chr(HomeKey), chr(EndKey)]) then begin if ch in ['<', ',', chr(PageUp)] then ShowNextSlice(PreviousSliceItem) else if ch in ['>', '.', chr(PageDown)] then ShowNextSlice(NextSliceItem) else if (ich = HomeKey) or (ich = EndKey) then ShowFirstOrLastSlice(ich); end else if nMacros > 0 then RunKeyMacro(ch, KeyCode); end; procedure DoActivate (event: EventRecord); var WhichWindow: WindowPtr; Activating, SwitchingWindows, isOK: boolean; I, kind: integer; NewInfo: InfoPtr; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; Activating := odd(event.modifiers); case kind of PicKind: begin if Activating then begin NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon); SwitchingWindows := NewInfo <> Info; if SwitchingWindows then begin StopDigitizing; SaveRoi; DisableDensitySlice; end; Info := NewInfo; if SwitchingWindows then ActivateWindow; Measuring := false; with info^ do begin LoadLUT(cTable); DrawMap; if digitizing and HighlightSaturatedPixels then HighlightPixels; GenerateValues; if fit = uncalibrated then DrawLabels('', '', ''); end; {with} end else KillOperation; {Deactivate} end; ResultsKind: UpdateResultsWindow; TextKind: ActivateTextWindow(WhichWindow, Activating); otherwise end; {case} if not activating then begin WhichWindow := FrontWindow; if WhichWindow <> nil then begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then ConverToSystemClipboard; {DA has become active} end; end; end; procedure DoUpdate (event: EventRecord); var WhichWindow: WindowPtr; SaveInfo: InfoPtr; kind: integer; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; BeginUpdate(WhichWindow); case kind of Pickind: begin SaveInfo := info; Info := pointer(WindowPeek(WhichWindow)^.RefCon); if not digitizing then begin UpdatePicWindow; DrawMyGrowIcon(info^.wptr); end; info := SaveInfo; end; ToolKind: DrawTools; MapKind: DrawMap; LutKind: DrawLUT; InfoKind: begin DrawLabels('', '', ''); if (mCount > 0) or (InfoMessage <> '') then ShowInfo; end; HistoKind: DrawHistogram; ProfilePlotKind, CalibrationPlotKind: UpdatePlotWindow; ResultsKind: UpdateResultsWindow; PasteControlKind: DrawPasteControl; TextKind: UpdateTextWindow(WhichWindow); end; EndUpdate(WhichWindow); end; procedure DoDiskInsert (event: EventRecord); { Process disk insertion event, check for damaged or uninitialized disks. } var p: point; intjunk: integer; begin if (HiWrd(event.message) <> NoErr) then begin DiLoad; SetPt(p, 100, 80); intjunk := DiBadMount(p, event.message); DiUnload; end; end; procedure DoDialogEvent (event: EventRecord); {Handles modeless dialog box events} var isItemHit: boolean; theDialog: DialogPtr; ItemHit: integer; ch: char; begin if (Event.what = KeyDown) and (BitAnd(Event.modifiers, CmdKey) = CmdKey) then begin UpdateMenus; ch := chr(band(Event.message, CharCodeMask)); DoMenuEvent(MenuKey(ch)); exit(DoDialogEvent); end; isItemHit := DialogSelect(event, theDialog, ItemHit); if isItemHit and (theDialog = VideoControl) then DoVideoControl(ItemHit); end; function MyGotRequiredParams(var theAppleEvent:AppleEvent):OSErr; var err:OSErr; returnedType:DescType; actualSize:Size; begin err:=AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize); if err=errAEDescNotFound then myGotRequiredParams:=noErr else if err=noErr then myGotRequiredParams:=errAEParamMissed; end; procedure PrintDocument; begin UpdatePicWindow; WhatToPrint := PrintImage; Print(false); DoClose; end; function OpenFinderFile(myFSS:FSSpec; PrintDoc:boolean):OSErr; var theInfo: FInfo; err, err1, err2:OSErr; wdRefNum, f:integer; okay:boolean; begin OpenFinderFile:=fnfErr; with myFSS do begin err := OpenWD(VRefNum, parID, 0, wdRefNum); if err<>noErr then exit(OpenFinderFile); err := GetFInfo(name, wdRefNum, theInfo); if err<>noErr then exit(OpenFinderFile); okay:=false; OpeningFinderFiles:=true; if theInfo.fdType = 'TIFF' then begin WhatToOpen := OpenTIFF; okay := OpenFile(name, wdRefNum); if OpeningRGB then begin if okay then ConvertRGBToEightBitColor(true); OpeningRGB := false; end; if PrintDoc then PrintDocument; end; if theInfo.fdType = 'PICT' then begin okay := OpenPICT(name, wdRefNum, false); if PrintDoc then PrintDocument; end; if theInfo.fdType = 'TEXT' then begin okay := OpenTextFile(name, wdRefNum); end; if theInfo.fdType = 'PICS' then begin okay := OpenPICS(name, wdRefNum); end; if theInfo.fdType = 'Iout' then begin OpenOutline(name, wdRefNum); okay:=true; end; if theInfo.fdType = 'ICOL' then begin OpenColorTable(name, wdRefNum); okay:=true; end; if theInfo.fdType = 'IPIC' then begin WhatToOpen := OpenImage; okay := OpenFile(name, wdRefNum); if PrintDoc then PrintDocument; end; if (theInfo.fdType = 'PREF') or (theInfo.fdType = 'pref') then begin err := fsopen(name, wdRefNum, f); GetPreferences(f); okay:=true; end; OpeningFinderFiles:=false; if okay then OpenFinderFile:=noErr; end; end; function HandleOpenOrPrint(var theAppleEvent, reply:AppleEvent; RefCon:LongInt; PrintDoc:boolean):OSerr; var err, ignoreErr:OSErr; docList:AEDescList; index, ItemsInList:LongInt; actualSize:Size; keywd:AEKeyword; returnedType:DescType; myFSS:FSSpec; begin err:=AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList); if err=noErr then begin err:=myGotRequiredParams(theAppleEvent); if err=noErr then begin err:=AECountItems(docList, itemsInList); if err=noErr then for index:=1 to ItemsInList do begin err:=AEGetNthPtr(docList, index, typeFSS, keywd, returnedType, @myFSS, SizeOf(myFSS), actualSize); if err=noErr then begin err:=OpenFinderFile(myFSS, PrintDoc); end; end; end; ignoreErr:=AEDisposeDesc(docList); end; HandleOpenOrPrint:=err; end; function HandleOpenApp(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin HandleOpenApp:=noErr; end; function HandleOpenDoc(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin HandleOpenDoc:=HandleOpenOrPrint(theAppleEvent, reply, RefCon, false); end; function HandlePrintDoc(var theAppleEvent, reply: AppleEvent; RefCon:LongInt):OSerr; begin HandlePrintDoc:=HandleOpenOrPrint(theAppleEvent, reply, RefCon, true); end; function HandleQuit(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin Finished:=true; HandleQuit:=noErr; end; function HandleEvents: boolean; const mousemovedmessage = $FA; SuspendResumeMessage = 1; ResumeMask = 1; var Event: EventRecord; result: boolean; theDialog: DialogPtr; ItemHit: integer; SleepTicks: LongInt; okay: boolean; err:OSErr; begin if Digitizing then SleepTicks := 0 else SleepTicks := 2; if WaitNextEvent(EveryEvent, Event, SleepTicks, nil) then begin if isDialogEvent(event) then DoDialogEvent(event) else case Event.what of KeyDown, AutoKey: DoKeyDown(Event); MouseDown: DoMouseDown(Event); ActivateEvt: DoActivate(Event); DiskEvt: DoDiskInsert(Event); UpdateEvt: DoUpdate(Event); osEvt: case BSR(event.message, 24) of MouseMovedMessage: ; SuspendResumeMessage: if BAND(event.message, ResumeMask) <> 0 then begin{Resume event} if SwitchLUTOnSuspend and (WhatToUndo = UndoLUT) then begin UndoLUTChange; WhatToUndo := NothingToUndo; end else LoadLUT(info^.ctable); end else begin {Suspend event} KillOperation; ConverToSystemClipboard; if SwitchLUTOnSuspend then begin SetupLUTUndo; okay := LoadCLUTResource(AppleDefaultCLUT); end; end; end; kHighLevelEvent: err:=AEProcessAppleEvent (Event); otherwise {Do nothing} end; {case} HandleEvents := true end else HandleEvents := false; end; procedure ShowInsertionPoint; var tRect: rect; Loc: point; height, imag: integer; begin if (not isInsertionPoint) or (info = NoInfo) then exit(ShowInsertionPoint); if CurrentWindow <> PicKind then exit(ShowInsertionPoint); if (TickCount mod (BlinkTime * 2)) < BlinkTime then exit(ShowInsertionPoint); Loc := InsertionPoint; OffscreenToScreen(loc); with info^, tRect do begin SetPort(wptr); imag := trunc(magnification + 0.5); height := CurrentSize * imag; height := height - height div 4; left := loc.h; bottom := loc.v - imag + 1; top := bottom - height; right := left + 1; PenNormal; PenSize(imag, imag); PenMode(PatXor); FrameRect(tRect); ipTicks := TickCount + 3; repeat until TickCount > ipTicks; FrameRect(tRect); end; end; procedure UndoRoi; var SrcPtr, DstPtr: ptr; offset, ByteCount, tTop, tBottom: LongInt; tRect: rect; begin with info^ do begin if PixMapSize <> CurrentUndoSize then exit(UndoRoi); tRect := RoiRect; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize, -RoiHandleSize); with tRect do begin tTop := top; tBottom := bottom; if tTop < 0 then tTop := 0; if tTop > PicRect.bottom then tTop := PicRect.bottom; if tBottom < 0 then tBottom := 0; if tBottom > PicRect.bottom then tBottom := PicRect.bottom; end; offset := tTop * BytesPerRow; if offset < 0 then offset := 0; SrcPtr := ptr(ord4(UndoBuf) + offset); DstPtr := ptr(ord4(PicBaseAddr) + offset); ByteCount := (tBottom - tTop) * BytesPerRow; BlockMove(SrcPtr, DstPtr, ByteCount); end; end; procedure GetLineHandles (var LeftHandle, MiddleHandle, RightHandle: rect); var offset1, offset2, xcenter, ycenter, x1, y1, x2, y2: integer; rx1, ry1, rx2, ry2: extended; begin offset1 := RoiHandleSize div 2; offset2 := offset1 + 1; GetLoi(rx1, ry1, rx2, ry2); x1 := trunc(rx1); y1 := trunc(ry1); x2 := trunc(rx2); y2 := trunc(ry2); SetRect(LeftHandle, x1 - offset1, y1 - offset1, x1 + offset2, y1 + offset2); with info^.RoiRect do begin xcenter := left + (right - left) div 2; ycenter := top + (bottom - top) div 2; end; SetRect(MiddleHandle, xcenter - offset1, ycenter - offset1, xcenter + offset2, ycenter + offset2); SetRect(RightHandle, x2 - offset1, y2 - offset1, x2 + offset2, y2 + offset2); end; procedure DrawROI; var tRect: rect; RoiHandle, LeftHandle, MiddleHandle, RightHandle: rect; psize: integer; StartTicks: LongInt; SaveGDevice: GDHandle; begin with Info^ do begin StartTicks := TickCount; if OpPending then DoOperation(CurrentOp); SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(Info^.osPort)); PenNormal; if ScaleToFitWindow then if (magnification < 1.0) and (magnification <> 0.0) then begin psize := round(1.0 / magnification + 1.5); PenSize(psize, psize); end; if not ((MouseState = DownInRoi) and OpPending) then if PixMapSize <= UndoBufSize then begin pmForeColor(BlackIndex); pmBackColor(WhiteIndex); case RoiType of RectRoi: with RoiRect do begin SetRect(RoiHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom); if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then PaintRect(RoiHandle); end; LineRoi: if Magnification <= 2.0 then begin GetLineHandles(LeftHandle, MiddleHandle, RightHandle); PaintRect(LeftHandle); if LineWidth < 4 then PaintRect(MiddleHandle); PaintRect(RightHandle); pmForeColor(WhiteIndex); FrameRect(LeftHandle); if LineWidth < 4 then FrameRect(MiddleHandle); FrameRect(RightHandle); pmForeColor(BlackIndex); end; otherwise end; PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); FrameRgn(roiRgn); pmForeColor(ForegroundIndex); pmBackColor(BackgroundIndex); end; if PixMapSize > UndoBufSize then begin if magnification < 1.0 then PenSize(2, 2); PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); PenMode(PatXor); FrameRgn(roiRgn); if MouseState = DownInRoi then begin UnionRect(RoiRect, OldRoiRect, tRect); UpdateScreen(tRect); end else UpdateScreen(RoiRect); FrameRgn(roiRgn); end else begin tRect := RoiRect; if MouseState = DownInRoi then UnionRect(RoiRect, OldRoiRect, tRect) else if RoiNudged then begin tRect := RoiRect; RoiNudged := false; end; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize * 2, -RoiHandleSize * 2) else InsetRect(tRect, -2, -2); UpdateScreen(tRect); UndoRoi; {Erase offscreen ROI} end; RoiUpdateTime := TickCount - StartTicks; end; {with} SetGDevice(SaveGDevice); end; procedure MoveLineEndPoint (osloc: point); var deltax, deltay: extended; begin with info^, osloc, info^.RoiRect do begin if h < 0 then h := 0; if h > PicRect.right then h := PicRect.right; if v < 0 then v := 0; if v > PicRect.bottom then v := PicRect.bottom; if RoiMode = LeftEndMode then begin LX1 := h; LY1 := v; LX2 := left + LX2; LY2 := top + LY2; end else begin LX2 := h; LY2 := v; LX1 := left + LX1; LY1 := top + LY1; end; if ShiftKeyDown then begin deltax := LX2 - LX1; deltay := LY2 - LY1; if abs(deltax) > abs(deltay) then begin if RoiMode = LeftEndMode then LY2 := LY1 else LY1 := LY2 end else begin if RoiMode = LeftEndMode then LX2 := LX1 else LX1 := LX2 end; end; {if ShiftKeyDown} MakeRegion; osMouseDownLoc := osloc; RoiUpdateTime := 0; Show3Values(h, v, MyGetPixel(h, v)); end; end; procedure MoveRoi (osloc: point); var dh, dv: integer; begin with info^, info^.RoiRect, osloc do begin dh := h - osMouseDownLoc.h; dv := v - osMouseDownLoc.v; OldRoiRect := RoiRect; if RoiType = LineRoi then if (RoiMode = LeftEndMode) or (RoiMode = RightEndMode) then begin MoveLineEndPoint(osloc); exit(MoveRoi); end; if RoiMode = MoveMode then begin if RoiMovementState = Constrained then begin if dv <> 0 then RoiMovementState := ConstrainedV else if dh <> 0 then RoiMovementState := ConstrainedH end; if RoiMovementState = ConstrainedH then dv := 0 else if RoiMovementState = ConstrainedV then dh := 0; if not OpPending then begin if left + dh < 0 then dh := -left; if top + dv < 0 then dv := -top; end; end; if not OpPending then begin if right + dh > PicRect.right then dh := PicRect.right - right; if bottom + dv > PicRect.bottom then dv := PicRect.bottom - bottom; end; if RoiMode = StretchMode then begin measuring := false; DrawLabels('Width:', 'Height:', ''); if h > left then begin right := right + dh; if right < (left + 1) then right := left + 1; if (right - h) > 5 then right := h + 2; end else right := left + 1; if v > top then begin bottom := bottom + dv; if bottom < (top + 1) then bottom := top + 1; if (bottom - v) > 5 then bottom := v + 2; end else bottom := top + 1; Show3Values(right - left, bottom - top, -1); MakeRegion; end else begin OffsetRgn(roiRgn, dh, dv); Show3Values(left, top, MyGetPixel(left, top)); end; RoiRect := roiRgn^^.rgnBBox; osMouseDownLoc := osloc; RoiUpdateTime := 0; {Forces ROI outline to be redrawn} end; {with Info} end; procedure ShowHistogramValues (GrayLevel: LongInt); var hstart, vstart, ivalue: integer; begin hstart := InfoHStart; vstart := InfoVStart; SetPort(InfoWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); MoveTo(xValueLoc, vstart); with info^ do if fit = uncalibrated then DrawLong(GrayLevel) else begin if InvertingCalibrationFunction then DrawReal(cvalue[255 - GrayLevel], 8, 2) else DrawReal(cvalue[GrayLevel], 8, 2); DrawString(' ('); DrawLong(GrayLevel); DrawString(' )'); end; DrawString(' '); MoveTo(yValueLoc, vstart + 10); if InvertingCalibrationFunction then DrawLong(histogram[255 - GrayLevel]) else DrawLong(histogram[GrayLevel]); DrawString(' '); end; procedure DoPlotCursor (loc: point; kind: integer); var xxscale, angle: extended; xvalue, xinc, yinc: integer; pt: point; begin DrawLabels('X:', 'Y:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(PlotWindow); GlobalToLocal(loc); xxscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin); xvalue := trunc((loc.h - PlotLeftMargin) * xxscale); if (xvalue < 0) or (xvalue >= PlotCount) then exit(DoPlotCursor); Show2PlotValues(xvalue, PlotData^[xvalue]); if (kind = CalibrationPlotKind) or (info^.RoiType <> LineRoi) then exit(DoPlotCursor); if button and (info <> NoInfo) then with loc do begin SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); angle := (PlotAngle / 180.0) * pi; xinc := round(cos(angle) * xvalue); yinc := round(-sin(angle) * xvalue); h := PlotStart.h + xinc; v := PlotStart.v + yinc; OffscreenToScreen(loc); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); wait(2); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); end; end; procedure SelectCursor; var loc, osloc, gloc: point; where, kind, i, color, x, y, margin: integer; WhichWindow: WindowPtr; MouseInRoi: boolean; fwptr: WindowPtr; CalValue: extended; RoiStretchHandle, LeftHandle, MiddleHandle, RightHandle: rect; MovingRoi: boolean; pvalue: integer; begin if PasteControl <> nil then begin fwptr := FrontWindow; if fwptr <> nil then if WindowPeek(fwptr)^.WLabels('X:', 'Y:', 'Value:'); with osloc do begin if Digitizing then pvalue := GetFGPixel(h, v) else pvalue := MyGetPixel(h, v); Show3Values(h, v, pvalue); end; end; end; HistoKind: begin DrawLabels('Level:', 'Count:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(HistoWindow); GlobalToLocal(loc); ShowHistogramValues(loc.h); end; ProfilePlotKind, CalibrationPlotKind: DoPlotCursor(loc, kind); LUTKind: begin if info^.fit <> uncalibrated then DrawLabels('Index:', 'Value:', ' RGB:') else DrawLabels('Index:', ' RGB:', ''); SetPort(LUTWindow); GlobalToLocal(loc); if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin if loc.v < 256 then SetCursor(LUTCursor) else InitCursor end else SetCursor(PickerCursor); if loc.v < 256 then begin ShowRGBValues(loc.v); end else begin color := 0; for i := 1 to nExtraColors + 2 do if PtInRect(loc, ExtraColorsRect[i]) then Color := ExtraColorsEntry[i]; ShowRGBValues(color); end; end; MapKind: if OptionKeyDown then SetCursor(ToolCursor[SelectionTool]) else SetCursor(gmCursor); TextKind: begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^ do begin SetPort(TextWindowPtr); GlobalToLocal(loc); TEIdle(TextTE); with TextWindowPtr^.portRect do begin if (loc.h < (right - ScrollBarWidth)) and (loc.v < (bottom - ScrollBarWidth)) then SetCursor(ToolCursor[TextTool]) else InitCursor; end; end; end; otherwise InitCursor; end; {case} end; procedure CloseAll; var i, j, result: integer; WPeek, NextWPeek: WindowPeek; ignore: boolean; begin InitCursor; WPeek := WindowPeek(FrontWindow); StopDigitizing; while wpeek <> nil do begin NextWPeek := WPeek^.NextWindow; case wPeek^.WindowKind of PicKind: begin Info := pointer(WPeek^.RefCon); result := CloseAWindow(info^.wptr); if not CommandPeriod then for j := 1 to 2 do ignore := HandleEvents; if result = cancel then begin ActivateWindow; finished := false; exit(CloseAll) end; end; TextKind: begin result := CloseAWindow(WindowPtr(wPeek)); if result = cancel then begin finished := false; exit(CloseAll) end; end; otherwise ; end; {case} wpeek := NextWPeek; end; end; procedure LoadDefaultMacros; {Looks for a text file named "Image Macros" in the same folder as} {Image, and, if found, loads the macros contained in it.} var err: OSErr; LaunchRefNum: integer; FinderInfo: FInfo; id: LongInt; begin err := GetVol(nil, LaunchRefNum); if err = noerr then err := GetFInfo('Image Macros', LaunchRefNum, FinderInfo); if err = NoErr then begin LoadMacrosFromFile('Image Macros', LaunchRefNum); {$ifc not PowerPC} UnloadSeg(@LoadMacros); {$endc} end; end; procedure Shutdown; var AlertID: integer; begin if (UnsavedResults and (mCount > 10)) or (UnsavedResults and (ResultsWindow <> nil)) then begin InitCursor; AlertID := alert(500, nil); if AlertID = CancelResetID then begin finished := false; exit(Shutdown) end; end; CloseAll; if finished then ConverToSystemClipboard; end; procedure InstallEventHandlers; {Installs event handlers for the four required Apple Events.} var err:OSErr; begin err:=AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, NewAEEventHandlerProc(@HandleOpenApp), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, NewAEEventHandlerProc(@HandleOpendoc), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, NewAEEventHandlerProc(@HandlePrintDoc), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, NewAEEventHandlerProc(@HandleQuit), 0, false); 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 test; var a,b:extended; c: array [1..2] of extended; begin a:=2.0; b:=2.0; c[1]:=a; c[2]:=b; ShowMessage(StringOf('SizeOf(boolean)=', sizeof(boolean), cr, '=', round(2.5) )); end; begin Init; InstallEventHandlers; SetupMenus; GetSettings; AllocateBuffers; AllocateArrays; ConvertFromSystemClipboard; LoadDefaultMacros; FindPlugIns; {$ifc not PowerPC} UnloadSeg(@Init); {$endc} {InitUser;} repeat if not HandleEvents then if info^.RoiShowing and (RoiUpdateTime < 30) then DrawRoi; ShowInsertionPoint; SelectCursor; if Digitizing then begin CaptureAndDisplayFrame; if ContinuousHistogram then ShowContinuousHistogram; end; if Finished then Shutdown; until finished; CloseSerialPorts; isOK := LoadCLUTResource(AppleDefaultCLUT); RestoreScreen; {Force Finder to redraw color icons} end.