unit Utilities;

{Miscellaneous utility routines used by NIH Image}

interface

   uses
        Types, Memory, QuickDraw, Packages, Devices, Menus, Events, Fonts, Scrap, TextEdit, ToolUtils, Dialogs,
        Controls, Palettes, ColorPicker, Printing, SegLoad, Processes, QuickDrawText, TextUtils, Windows,
				OSUtils, QDOffscreen, Components, QuickTimeComponents, DriverServices, globals;



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

	procedure SysResume;
	procedure beep;
	procedure PutMessage (str: str255);
	procedure PutError (str: str255);
	procedure UnprotectLUT;
	procedure LoadLUT (table: MyCSpecArray);
	procedure SetupLutUndo;
	procedure UndoLutChange;
	procedure DisableDensitySlice;
	procedure LoadInputLUT (address: ptr);
	procedure ResetQuickCapture;
	procedure ResetScionLG3;
	procedure ResetScionAG5;
	procedure ResetScionVG5f;
	procedure ResetFrameGrabber;
	procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
	procedure wait (ticks: LongInt);
	function GetScrapCount: integer;
	procedure DisplayText (update: boolean);
	procedure ScreenToOffscreen (var loc: point);
	procedure OffscreenToScreen (var loc: point);
	procedure OffScreenToScreenRect (var r: rect);
	procedure UpdateScreen (MaskRect: rect);
	procedure RestoreRoi;
	procedure Undo;
	procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
	procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
	function GetFontSize (item: integer): integer;
	function MyGetPixel (h, v: LongInt): integer;
	procedure PutPixel (h, v: LongInt; value: integer);
	procedure GetLine (h, v, count: LongInt; var line: LineType);
	procedure GetColumn (h, v, count: LongInt; var data: LineType);
	procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
	procedure PutLine (h, v, count: LongInt; var line: LineType);
	procedure Show1Value (rvalue, CalibratedValue: extended);
	procedure Show2PlotValues (x, y: extended);
	procedure Show2Values (current, total: LongInt);
	procedure DrawXDimension (x: extended; digits: integer);
	procedure DrawYDimension (y: extended; digits: integer);
	procedure DrawRGB (index: integer);
	procedure Show3Values (hloc, vloc, ivalue: LongInt);
	procedure ShowDxDy (X, Y: extended);
	procedure PutChar (c: char);
	procedure PutTab;
	procedure PutString (str: str255);
	procedure PutReal (n: extended; width, fwidth: integer);
	procedure PutLong (n: LongInt; FieldWidth: integer);
	procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
	procedure ShowWatch;
	procedure ShowAnimatedWatch;
	procedure UpdatePicWindow;
	procedure DoOperation (Operation: OpType);
	procedure SaveRoi;
	procedure KillRoi;
	procedure ShowRoi;
	procedure SetupUndo;
	procedure SetupUndoFromClip;
	procedure GetLoi (var x1, y1, x2, y2: extended);
	function NotRectangular: boolean;
	function NotInBounds: boolean;
	function NoSelection: boolean;
	function NoUndo: boolean;
	procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
	function NewPicWindow (name: str255; width, height: integer): boolean;
	function GetAngle (dx, dy: extended):extended;
	procedure MakeRegion;
	procedure SelectAll (visible: boolean);
	procedure EraseScreen;
	procedure RestoreScreen;
	procedure UpdateTitleBar;
	procedure Unzoom;
	procedure DrawBString (str: string);
	procedure DrawMyGrowIcon (w: WindowPtr);
	procedure PutMemoryAlert;
	function GetBigHandle (NeededSize: LongInt): handle;
	function GetImageMemory (SaveInfo: infoPtr): ptr;
	procedure UpdateAnalysisMenu;
	procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
	procedure MakeNewWindow (name: str255);
	function long2str (num: LongInt): str255;
	procedure PutWarning;
	procedure ScaleToFit;
	procedure SetupRoiRect;
	procedure SetForegroundColor (color: integer);
	procedure SetBackgroundColor (color: integer);
	procedure GetForegroundColor (event: EventRecord);
	procedure GetBackgroundColor (event: EventRecord);
	procedure GenerateValues;
	procedure KillOperation;
	procedure ScaleImageWindow (var trect: rect);
	procedure InvertGrayLevels;
	function TooWide: boolean;
	procedure DrawTextString (str: str255; loc: point; just: integer);
	procedure IncrementCounter;
	procedure ClearResults (i: integer);
	procedure UpdateFitEllipse;
	procedure UpdateTextItems;
	procedure MakeLowerCase (var str: str255);
	function PutMessageWithCancel (str: str255): integer;
	function CurrentWindow: integer;
	procedure FindMonitors (NewScreenDepth: integer);
	function ScreenDepth: integer;
	procedure SetFColor (index: integer);
	procedure SetBColor (index: integer);
	function DoubleToReal(d:FakeDouble):extended; {68k-bug}
	procedure RealToDouble(rr: extended; var d:FakeDouble);
	function MakeStackFromWindow: boolean;
	procedure SelectSlice (i: integer);
	procedure UpdateWindowsMenuItem;
	function AddSlice (update: boolean): boolean;
	procedure AbortMacro;
	procedure TruncateString(var str: str255; length: integer);
	procedure RemovePath(var str: str255);
	procedure CloseVdig;
	procedure FlushCache;
	procedure IndexToRgbForeColor(index: integer);{18.11.2002 replaces pmForeColor}
	procedure IndexToRgbBackColor(index: integer);{18.11.2002 replaces pmBackColor}
	

implementation


	type
		KeyPtrType = ^KeyMap;



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


	procedure ShowMessage (str: str255);
		var
			vloc, hloc: integer;
			tPort: GrafPtr;
			trect: rect;
			SaveGDevice: GDHandle;
			font: integer;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(GetMainDevice);
	  InfoMessage := str;
		GetPort(tPort);
		vloc := 35;
		hloc := 4;
		SetPort(InfoWindow);
		{TextFont(Geneva);}
		GetFNum ('Geneva', font);
		TextFont(font);
		TextSize(9);
		Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
		TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft);
		SetPort(tPort);
		SetGDevice(SaveGDevice);
		wait(120);
	end;


	procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
	begin
		GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		SetControlValue(ControlHandle(ItemHdl),value)
	end;


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


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


	function GetDString (TheDialog: DialogPtr; item: integer): str255;
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
			str: str255;
	begin
		GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		GetDialogItemText(ItemHdl, str);
		GetDString := str;
	end;


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


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


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

	procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
	begin
		GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		SetDialogItemText(ItemHdl, str)
	end;


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


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


	procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  {Does number to string conversion equivalent to write(val:width:fwidth).}
  var
  	i:integer;
	begin
		if width<1 then width:=1;
		if (fwidth<0) or (fwidth>8) then fwidth:=0;
		str:=StringOf(val:width:fwidth);
	end;


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


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


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


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


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


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


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


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


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


	procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
 {Draw a string item in a dialog box.}
		var
			r: rect;
			iType: integer;
			ignore: handle;
	begin
		GetDialogItem(d, ItemNum, iType, ignore, r);
		TextFont(fontrqst);
		TextSize(sizerqst);
		TETextBox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
	end;


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


	procedure beep;
	{Sets the current gdevice to the screen because SysBeep flashes
  the menu bar if the sound level is zero and this is reported to sometimes
	cause a crash on older Macs when using an offscreen gdevice.} 
		var
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(GetMainDevice);
		SysBeep(1);
		SetGDevice(SaveGDevice);
	end;


	procedure PutMessage (str: str255);
		var
			ignore: integer;
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(GetMainDevice);
		InitCursor;
		ParamText(str, '', '', '');
		Ignore := Alert(300, nil);
		SetGDevice(SaveGDevice);
	end;
	

	procedure PutError (str: str255);
		var
			ignore: integer;
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(GetMainDevice);
		InitCursor;
		ParamText(str, '', '', '');
		Ignore := Alert(310, nil);
		SetGDevice(SaveGDevice);
	end;


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


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


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


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

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

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

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

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

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


	procedure LoadLUT (table: MyCSpecArray);
		var
			i, entry, screen: integer;
			cPtr: ^cSpecArray;
			SaveDevice: GDHandle;
	begin
		if nExtraColors > 0 then begin
				entry := FirstExtraColorsEntry;
				for i := 1 to nExtraColors do begin
						table[entry].rgb := ExtraColors[i];
						entry := entry + 1;
					end;
			end;
		if HighLightMode then begin
				table[1].rgb := Highlight1;
				table[254].rgb := Highlight254;
			end;
		for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
			with table[i].rgb do
				if (red = 0) and (green = 0) and (blue = 0) then begin
						red := 256;
						green := 256;
						blue := 256;
					end;
		cPtr := @table[1];
		if ScreenDepth = 8 then begin
			SaveDevice := GetGDevice;
			for screen := 1 to nMonitors do begin
					SetGDevice(Monitors[screen]);
					for i := 1 to 254 do begin
							ProtectEntry(i, false);
							ReserveEntry(i, false);
						end;
					SetEntries(1, 253, cPtr^);
				end;
			SetGDevice(SaveDevice);
		end;
		table[0].rgb := WhiteRGB;
		table[255].rgb := BlackRGB;
		BlockMove(@table, @osGDevice^^.gdPMap^^.pmTable^^.ctTable, SizeOf(table));
		with osGDevice^^.gdPMap^^.pmTable^^ do
			if ScreenDepth = 8 then
				ctSeed := ScreenPixMap^^.pmTable^^.ctSeed
			else
				ctSeed := GetCtSeed;
	end;


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


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


	procedure UpdatePicWindow;
		var
			tPort: GrafPtr;
			SaveGDevice: GDHandle;
	begin
		if (info <> NoInfo) and (info^.wptr <> nil) then
			with Info^ do begin
					SaveGDevice := GetGDevice;
					SetGDevice(GetMainDevice);
					getPort(tPort);
					SetPort(wptr);
					SetFColor(BlackIndex);
					SetBColor(WhiteIndex);
					CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, nil);
					SetPort(tPort);
					SetGDevice(SaveGDevice);
					RoiUpdateTime := 0;
				end;
	end;


	procedure DisableDensitySlice;
		var
			tPort: GrafPtr;
	begin
		if DensitySlicing then begin
				DensitySlicing := false;
				UndoLutChange;
				if ScreenDepth <> 8 then begin
						UpdatePicWindow;
						GetPort(tPort);
						SetPort(LUTWindow);
						InvalRect(LutWindow^.PortRect);
						SetPort(tPort);
					end;
			end;
	end;


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


	procedure ResetQuickCapture;
		const
			ilutOffset = $90000;
	begin
		ControlReg^ := 1; {reset}
		while BitAnd(ControlReg^, $80) = $80 do
			;
		ChannelReg^ := VideoChannel * 64;
		while BitAnd(ControlReg^, $80) = $80 do
			;
		LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
	end;


	procedure ResetScionLG3;
		const
			ilutOffset = $80000;
		var
			SyncChannel, t: integer;
	begin
		ControlReg^ := 0;
		BufferReg^ := 0;
		if SyncMode = SeparateSync then
			SyncChannel := 3
		else
			SyncChannel := VideoChannel;
		t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
		ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
		DacHighReg^ := DacHigh;
		DacLowReg^ := DacLow;
		DacAReg^ := LG3DacA;
		DacBReg^ := LG3DacB;
		LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
	end;


	procedure ResetScionAG5;
		const
			ilutOffset = $E0000;
		var
			SyncChannel: integer;
	begin
		ControlReg^ := 0;
		if SyncMode = SeparateSync then
			SyncChannel := 3
		else
			SyncChannel := VideoChannel;
		ChannelReg^ := bor(ord(AG5BufferMode), bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
		DacHighReg^ := DacHigh;
		DacLowReg^ := DacLow;
		LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
	end;


	procedure ResetScionVG5f;
		const
			ilutOffset = $80000;
		var
			SyncChannel, t: integer;
	begin
		ControlReg^ := 0;
		if SyncMode = SeparateSync then
			SyncChannel := 3
		else
			SyncChannel := VideoChannel;
		t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
		ChannelReg^ := bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
		DacHighReg^ := DacHigh;
		DacLowReg^ := DacLow;
		LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
	end;


	procedure ResetFrameGrabber;
	begin
		case FrameGrabber of
			QuickCapture: 
				ResetQuickCapture;
			ScionLG3: 
				ResetScionLG3;
			ScionAG5: 
				ResetScionAG5;
			ScionVG5f:
				ResetScionVG5f;
			otherwise
				;
		end;
	end;


	procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
		var
			SaveGDevice: GDHandle;
	begin
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		IndexToRgbForeColor(BlackIndex);
		IndexToRgbBackColor(WhiteIndex);
		CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(dst)^^, sRect, dRect, DitherCopy, nil);
		IndexToRgbForeColor(ForegroundIndex);
		IndexToRgbBackColor(BackgroundIndex);
		SetGDevice(SaveGDevice);
	end;


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


	function GetScrapCount: integer;
		var
			ScrapInfo: ScrapStuffPtr;
	begin
		ScrapInfo := InfoScrap;
		GetScrapCount := ScrapInfo^.ScrapCount;
	end;


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


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


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


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



	procedure UpdateScreen (MaskRect: rect);
 {Refreshes the portion of the screen defined by}
  {MaskRect, where MaskRect is defined in offscreen coordinates.}
		var
			tPort: GrafPtr;
			imag: integer;
			SaveGDevice: GDHandle;
	begin
		OffScreenToScreenRect(MaskRect);
		with Info^ do
			if info <> NoInfo then begin
					SaveGDevice := GetGDevice;
					SetGDevice(GetMainDevice);
					getPort(tPort);
					SetPort(wptr);
					SetFColor(BlackIndex);
					SetBColor(WhiteIndex);
					imag := trunc(magnification);
					InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
					InsetRect(MaskRect, 0, 0);
					RectRgn(MaskRgn, MaskRect);
					CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
					SetPort(tPort);
					SetGDevice(SaveGDevice);
				end;
	end;


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


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


	function MyGetPixel (h, v: LongInt): integer;
	begin
		MyGetPixel := BackgroundIndex;
		with Info^ do
			if h >= 0 then
				if v >= 0 then
					if h < PixelsPerLine then
						if v < nlines then
							MyGetPixel := ImageP(PicBaseAddr)^[v * BytesPerRow + h];
               {MyGetPixel := band(ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h)^, 255);}
	end;


	procedure PutPixel (h, v: LongInt; value: integer);
		var
			addr: Ptr;
	begin
		with Info^ do
			if h >= 0 then
				if v >= 0 then
					if h < PixelsPerLine then
						if v < nlines then begin
								addr := Ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h);
								addr^ := value;
							end;
	end;


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


	procedure GetColumn (h, v, count: LongInt; var data: LineType);
		var
			col, pic, bpr: LongInt;
			i: integer;
	begin
		if count > MaxLine then
			count := MaxLine;
		with Info^ do begin
				if (h < 0) or (v < 0) or (h >= PixelsPerLine) or ((v + count) > nlines) then begin
						for i := 0 to count - 1 do
							data[i] := MyGetPixel(h, v + i);
						exit(GetColumn);
					end;
				col := Ord4(@data);
				bpr := BytesPerRow;
				pic := Ord4(PicBaseAddr) + v * bpr + h;
				while count > 0 do begin
						Ptr(col)^ := Ptr(pic)^;
						pic := pic + bpr;
						col := col + 1;
						count := count - 1;
					end;
			end;
	end;


	procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
		var
			col, pic, bpr: LongInt;
	begin
		col := Ord4(@data);
		with Info^ do begin
				bpr := BytesPerRow;
				if count > 0 then
					if hstart >= 0 then
						if vstart >= 0 then
							if hstart < PixelsPerLine then begin
									if vstart > nlines - count then
										count := nlines - vstart;
									pic := Ord4(PicBaseAddr) + vstart * bpr + hstart;
									while count > 0 do begin
											Ptr(pic)^ := Ptr(col)^;
											pic := pic + bpr;
											col := col + 1;
											count := count - 1;
										end;
								end;
			end;
	end;


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


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


	procedure Show2PlotValues (x, y: extended);
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		with info^ do begin
				hstart := InfoHStart;
				vstart := InfoVStart;
				GetPort(tPort);
				SetPort(InfoWindow);
				TextSize(9);
				TextFont(Monaco);
				TextMode(SrcCopy);
				MoveTo(xValueLoc, vstart);
				DrawXDimension(round(x), 0);
				MoveTo(yValueLoc, vstart + 10);
				DrawReal(y, 6, 2);
				SetPort(tPort);
			end;
	end;


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


	procedure DrawXDimension (x: extended; digits: integer);
	begin
		with info^ do begin
				if SpatiallyCalibrated then begin
						DrawReal(x / xScale, 5, 2);
						DrawChar(xUnit[1]);
						DrawChar(xUnit[2]);
						DrawString(' (');
						DrawReal(x, 3, digits);
						DrawString(')')
					end
				else
					DrawReal(x, 1, digits);
				DrawString('      ');
			end;
	end;


	procedure DrawYDimension (y: extended; digits: integer);
	begin
		with info^ do begin
				if SpatiallyCalibrated then begin
						DrawReal(y / yScale, 5, 2);
						DrawChar(xUnit[1]);
						DrawChar(xUnit[2]);
						DrawString(' (');
						DrawReal(y, 3, digits);
						DrawString(')')
					end
				else
					DrawReal(y, 1, digits);
				DrawString('      ');
			end;
	end;


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

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

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


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


	procedure ShowDxDy (X, Y: extended);
		var
			tPort: GrafPtr;
			hstart, vstart, ivalue: integer;
	begin
		with info^ do begin
				hstart := InfoHStart;
				vstart := InfoVStart;
				GetPort(tPort);
				SetPort(InfoWindow);
				TextSize(9);
				TextFont(Monaco);
				TextMode(SrcCopy);
				MoveTo(xValueLoc, vstart);
				DrawXDimension(x, 2);
				MoveTo(yValueLoc, vstart + 10);
				DrawYDimension(y, 2);
				MoveTo(zValueLoc, vstart + 20);
				if SpatiallyCalibrated then begin
						DrawReal(sqrt(sqr(x / xScale) + sqr(y / yScale)), 5, 2);
						DrawChar(xUnit[1]);
						DrawChar(xUnit[2]);
						DrawString(' (');
						DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
						DrawString(')')
					end
				else
					DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
				DrawString('    ');
				SetPort(tPort);
			end;
	end;


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


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


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


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


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


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


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

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

		procedure PutUnits;
		begin
			if info^.SpatiallyCalibrated then begin
					PutString('  (');
					DrawChar(info^.xUnit[1]);
					DrawChar(info^.xUnit[2]);
					PutString(')')
				end
			else
				PutString('(Pixels)');
			PutChar(cr);
			PutChar(cr);
		end;

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

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


	procedure ShowWatch;
	begin
		SetCursor(watch);
	end;


	procedure ShowAnimatedWatch;
	begin
		SetCursor(AnimatedWatch[WatchIndex]);
		WatchIndex := WatchIndex + 1;
		if WatchIndex > 8 then
			WatchIndex := 1;
	end;


	procedure FlushCache;
		var
			address: LogicalAddress;
			length: ByteCount;
			ignore: OSStatus;
		begin
			{$ifc PowerPC}
			if not PCIFrameGrabber then
				exit(FlushCache);
			if info = NoInfo then
				exit(FlushCache);
			if (FrameGrabber = ScionAG5) and (AG5GrabMode = GrabSum) then
				exit(FlushCache);
			if GrabbingToScreen then
				exit(FlushCache);
			address := LogicalAddress(fgPort^.PortPixMap^^.BaseAddr);
			length := ByteCount(longint(fgRowBytes) * longint(fgHeight));
			ignore := FlushProcessorCache(AddressSpaceID(-1), address, length);
			{$endc}
		end;


	procedure CaptureImage;
		var
			Timeout: LongInt;
			vdigErr: ComponentResult;
	begin
		case FrameGrabber of
			QuickCapture:  begin
					ControlReg^ := BitAnd($80, 255); {Start frame capture}
					while BitAnd(ControlReg^, $80) = $80 do
						;       {Wait for it to complete}
				end;
			ScionLG3, ScionAG5, ScionVG5f:  begin
					TimeOut := TickCount + 30;  {1/2sec. timeout}
					ControlReg^ := $80; {Start frame capture}
					while BitAnd(ControlReg^, $80) = $00 do begin    {Wait for it to complete}
							if TickCount > TimeOut then begin
									ControlReg^ := $00;
									leave
								end;
						end;
					ControlReg^ := $00;
				end;
			QTvdig:
				if vdig <> nil then
					vdigErr := VDGrabOneFrame(vdig);
		end; {case}
		FlushCache
	end;


	procedure Paste;
		var
			srcPixMap: PixMapHandle;
			PCILivePaste: boolean;
	begin
		if info = NoInfo then begin
				beep;
				exit(Paste)
			end;
		with Info^ do begin
				if not RoiShowing then
					exit(Paste);
				if PasteTransferMode = SrcCopy then begin
						IndexToRgbForeColor(BlackIndex);
						IndexToRgbBackColor(WhiteIndex);
					end;
				srcPixMap := ClipBufInfo^.osPort^.PortPixMap;
				PCILivePaste := false;
				if LivePasteMode then
					if ((WhatsOnClip = CameraPic) or (WhatsOnClip = LivePic)) and (PictureType <> FrameGrabberType) then begin
							if PCIFrameGrabber then
								with fgPort^.PortPixMap^^ do begin
									BaseAddr := ptr(fgSlotBase);
									PCILivePaste := true;
								end;
							CaptureImage;
							srcPixMap := fgPixMap;
						end;
				CopyBits(BitMapHandle(srcPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
				if PCILivePaste then
					with fgPort^.PortPixMap^^ do
						BaseAddr := ptr(fgSuperSlotBase0);
				if PasteTransferMode = SrcCopy then begin
						IndexToRgbForeColor(ForegroundIndex);
						IndexToRgbBackColor(BackgroundIndex);
					end;
			end;
	end;


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


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


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


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


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


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


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


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


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


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


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



	procedure PutMemoryAlert;
	begin
		if not OpeningFinderFiles then
			PutError('There is not enough free memory to open this image. Try closing some windows or allocating more memory to NIH Image.');
		AbortMacro;
	end;


	procedure CompactMemory;
		var
			size: LongInt;
			TempInfo: InfoPtr;
			i: integer;
	begin
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				hunlock(TempInfo^.PicBaseHandle)
			end;
		size := MaxSize;
		size := MaxMem(size);
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				with TempInfo^ do begin
						hlock(PicBaseHandle);
						{$ifc PowerPC}
						PicBaseAddr := PicBaseHandle^;
						{$elsec}
						PicBaseAddr := StripAddress(PicBaseHandle^);
						{$endc}
						osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
					end;
			end;
	end;



	function GetBigHandle (NeededSize: LongInt): handle;
{Allocates a handle and guarantees MinFree contiguous free bytes after allocation . }
{Does NOT arrange for the new handle to be unlocked during CompactMemory. }
{GetBigHandle returns nil if CompactMemory fails to obtain enough contiguous free space . }
		var
			h: handle;
			FreeMem: LongInt;
	begin
		h := NewHandle(NeededSize);
		FreeMem := MaxBlock;
		if (h = nil) or (FreeMem < MinFree) then begin
				if h <> nil then
					DisposeHandle(h);
				if FreeMem > 0 then {Why does FreeMem get set to 0 sometimes and MaxMem}
					CompactMemory       {crash, but only when using the Modern Memory Manager?}
				else
					beep;
				h := NewHandle(NeededSize);
				FreeMem := MaxBlock;
			end;
		if (h = nil) or (FreeMem < MinFree) then begin
				if h <> nil then
					DisposeHandle(h);
				h := nil;
			end;
		GetBigHandle := h;
	end;


	function GetImageMemory (SaveInfo: infoPtr): ptr;
{Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
{A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
		var
			h: handle;
			NeededSize: LongInt;
	begin
		with info^ do begin
				if odd(PixelsPerLine) then
					BytesPerRow := PixelsPerLine + 1
				else
					BytesPerRow := PixelsPerLine;
				PixMapSize := nlines * BytesPerRow;
				ImageSize := nlines * PixelsPerLine;
				NeededSize := PixMapSize;
			end;
		h := GetBigHandle(NeededSize);
		if h = nil then begin
				DisposePtr(pointer(Info));
				PutMemoryAlert;
				Info := SaveInfo;
				GetImageMemory := nil;
				exit(GetImageMemory);
			end;
		with info^ do begin
				PicBaseHandle := h;
				hlock(PicBaseHandle);
				{$ifc PowerPC}
				GetImageMemory := PicBaseHandle^;
				{$elsec}
				GetImageMemory := StripAddress(PicBaseHandle^);
				{$endc}
			end;
	end;


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


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


	procedure InvertGrayLevels;
	begin
		with info^ do begin
				fit := StraightLine;
				nCoefficients := 2;
				Coefficient[1] := 255.0;
				Coefficient[2] := -1.0;
				ZeroClip := false;
				UnitOfMeasure := '';
				nKnownValues := 0;
				NoInfo^.fit := StraightLine;
				NoInfo^.nCoefficients := 2;
				NoInfo^.Coefficient := Coefficient;
				NoInfo^.ZeroClip := false;
				NoInfo^.UnitOfMeasure := '';
				GenerateValues;
				UpdateTitleBar;
			end;
	end;


	function GetAngle (dx, dy: extended):extended;
		var
			angle:extended;
			quadrant: (q1, q2orq3, q4);
	begin
		if dx <> 0.0 then
			angle := arctan(dy / dx)
		else begin
				if dy >= 0.0 then
					angle := pi / 2.0
				else
					angle := -pi / 2.0
			end;
		angle := (180.0 / pi) * angle;
		if (dx >= 0.0) and (dy >= 0.0) then
			quadrant := q1
		else if dx < 0.0 then
			quadrant := q2orq3
		else
			quadrant := q4;
		case quadrant of
			q1: 
				;
			q2orq3: 
				angle := angle + 180.0;
			q4: 
				angle := angle + 360.0;
		end;
		GetAngle:=angle; {ppc-bug}
	end;


	procedure MakeRegion;
		var
			deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
			dx, dy, pAngle: extended;
			add: boolean;
			tPort: GrafPtr;
	begin
		with info^ do begin
				GetPort(tPort);
				SetPort(wptr);
				OpenRgn;
				case RoiType of
					LineRoi:  begin
							LAngle:=GetAngle(LX2 - LX1, LY1 - LY2);
							x1 := round(LX1);
							y1 := round(LY1);
							x2 := round(LX2);
							y2 := round(LY2);
							if (x1 = x2) and (y1 = y2) then begin
									MoveTo(x1, y1);
									LineTo(x1 + 1, y1);
									LineTo(x1 + 1, y1 + 1);
									LineTo(x1, y1 + 1);
									LineTo(x1, y1);
								end
							else begin
									add := (LAngle > 90.0) and (LAngle <= 270.0);
									pAngle := (LAngle / 180.0) * pi;
									if add then
										pAngle := pAngle + pi / 2.0
									else
										pAngle := pAngle - pi / 2.0;
									dx := cos(pAngle) * LineWidth;
									dy := -sin(pAngle) * LineWidth;
									MoveTo(x1, y1);
									LineTo(round(x1 + dx), round(y1 + dy));
									LineTo(round(x2 + dx), round(y2 + dy));
									LineTo(x2, y2);
									LineTo(x1, y1);
								end;
						end;
					OvalRoi: 
						FrameOval(RoiRect);
					RectRoi: 
						FrameRect(RoiRect);
					otherwise
				end;
				CloseRgn(roiRgn);
				if RoiType = LineRoi then begin
						RoiRect := roiRgn^^.rgnBBox;
						with RoiRect do begin
								LX1 := LX1 - left;
								LY1 := LY1 - top;
								LX2 := LX2 - left;
								LY2 := LY2 - top;
							end;
					end;
			end;
		SetPort(tPort);
	end;


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


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


	procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
	begin
		NewInfo := OldInfo;
		with NewInfo do begin
				PicBaseAddr := nil;
				PicBaseHandle := nil;
				osPort := nil;
				roiRgn := nil;
				RoiType := NoRoi;
				RoiShowing := false;
				Magnification := 1.0;
				vref := 0;
				wPtr := nil;
				ScaleToFitWindow := false;
				WindowState := NormalWindow;
				StackInfo := nil;
				fileVersion := 0;
				PictureType := NewPicture;
				DataType := EightBits;
				changes := false;
				DataH := nil;
				LittleEndian := false;
				InvertedImage := false;
				if OldInfo.DataH <> nil then {real image}
					fit := uncalibrated;
				if (not SpatiallyCalibrated and (fit=uncalibrated)) or (nPics=0) then begin
					if NoInfo^.SpatiallyCalibrated then begin
						SpatiallyCalibrated:=true;
						xUnit := NoInfo^.xUnit;
						xScale := NoInfo^.xScale;
						PixelAspectRatio := NoInfo^.PixelAspectRatio;
						yScale := xScale / PixelAspectRatio;
					end;
					if NoInfo^.fit<>uncalibrated then begin
						fit := NoInfo^.fit;
						nCoefficients := NoInfo^.nCoefficients;
						Coefficient := NoInfo^.Coefficient;
						ZeroClip := NoInfo^.ZeroClip;
						UnitOfMeasure := NoInfo^.UnitOfMeasure;
					end;
				end;
			end;
	end;


	function NewPicWindow (name: str255; width, height: integer): boolean;
		var
			iptr, p: ptr;
			lptr: ^LongInt;
			SaveInfo: InfoPtr;
			NeededSize: LongInt;
			trect: rect;
	begin
		NewPicWindow := false;
		PicLeft := PicLeftBase;
		PicTop := PicTopBase;
		if (info <> noInfo) then begin
				with info^ do begin
						GetWindowRect(wptr, trect);
						if trect.left = PicLeftBase then
							if pos('Camera', name) = 0 then begin
									PicLeft := trect.left + hPicOffset;
									PicTop := trect.top + vPicOffset;
								end;
					end;
			end;
		if nPics = MaxPics then
			exit(NewPicWindow);
		KillOperation;
		DisableDensitySlice;
		SaveInfo := Info;
		iptr := NewPtr(SizeOf(PicInfo));
		if iptr = nil then begin
				PutMemoryAlert;
				AbortMacro;
				exit(NewPicWindow);
			end;
		Info := pointer(iptr);
		CloneInfo(SaveInfo^, Info^);
		with Info^ do begin
				nlines := height;
				PixelsPerLine := width;
				p := GetImageMemory(SaveInfo);
				if p = nil then
					exit(NewPicWindow);
				PicBaseAddr := p;
				MakeNewWindow(name);
				SelectAll(false);
				if not OptionKeyDown then DoOperation(EraseOp);
				KillRoi;
				Changes := false;
				BinaryPic := false;
			end;
		UpdateTitleBar;
		NewPicWindow := true;
	end;


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


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


	procedure UpdateTitleBar;
    {Updates the window title bar to show the current magnification or the current frame within a stack.}
		var
			str, str2, str3: str255;
			SaveGDevice: GDHandle;
	begin
		if info = NoInfo then
			exit(UpdateTitleBar);
		with info^ do begin
				str := title;
				if info^.DataH <> nil then
					str := concat('<<',str, '>>');
				if SpatiallyCalibrated then
					str := concat(str, chr($13)); {Black Diamond}
				if fit <> uncalibrated then
					str := concat(str, '×');
				if StackInfo <> nil then
					with StackInfo^ do
						if (nSlices = 3) and (StackType = rgbStack) then begin
								case CurrentSlice of
									1: str2 := 'Red';
									2: str2 := 'Green';
									3: str2 := 'Blue';
								end;
								str := concat(str, ' (', str2, ')');
						end else begin
								NumToString(CurrentSlice, str2);
								NumToString(nSlices, str3);
								str := concat(str, ' (', str2, '/', str3, ')');
						end
				else if (magnification <> 1.0) or ScaleToFitWindow then begin
						if ScaleToFitWindow then begin
								RealToString(magnification, 1, 2, str2);
								str := concat(str, ' (', str2, ')');
							end
						else begin
								RealToString(magnification, 1, 0, str2);
								str := concat(str, ' (', str2, ':1)');
							end;
					end;
				if Digitizing then begin
						if ExternalTrigger then
							str := concat(str, ' (Waiting for Trigger)')
						else
							str := concat(str, ' (Live)');
					end;
				if wptr <> nil then begin
					SaveGDevice := GetGDevice;
					SetGDevice(GetMainDevice);
					SetWTitle(wptr, str);
					SetGDevice(SaveGDevice);
					end;
			end; {with}
	end;


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


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


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


	procedure DrawBString(str:string);
	var
		s:style;
	begin
		TextFace([bold]);
		DrawString(str);
		s:=[];  {ppc-bug}
		TextFace(s);
	end;


	function long2str (num: LongInt): str255;
		var
			str: str255;
	begin
		NumToString(num, str);
		long2str := str;
	end;


	procedure PutWarning;
	begin
		PutError(concat('This ', long2str((info^.PixmapSize + 511) div 1024), 'K image is larger than the ', long2str(UndoBufSize div 1024), 'K Undo buffer. Many operations may fail or may not be Undoable.'));
	end;


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


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


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


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


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


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


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


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


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


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


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

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



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


	procedure RemovePath(var str: str255);
	var
		loc: integer;
	begin
		repeat
			loc := pos(':', str);
			if loc > 0 then
				delete(str, 1, loc);
		until loc = 0;
	end;


	procedure MakeNewWindow (name: str255);
		var
			wwidth, wheight, wleft, wtop, i: integer;
			tPort: GrafPtr;
			rgb: RGBColor;
			err: OSErr;
			str: str255;
			SaveGDevice: GDHandle;
	begin
		with Info^ do begin
				RemovePath(name);
				wleft := PicLeft;
				wtop := PicTop;
				PicLeft := PicLeft + hPicOffset;
				PicTop := PicTop + vPicOffset;
				if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
						PicLeft := PicLeftBase;
						PicTop := PicTopBase;
					end;
				wwidth := PixelsPerLine;
				if (wleft + wwidth) > ScreenWidth then
					wwidth := ScreenWidth - wleft - 4;
				wheight := nlines;
				if (wtop + wheight) > ScreenHeight then
					wheight := ScreenHeight - wtop - 4;
				if OpeningPlugInWindow then
					SetRect(wrect, -10000, wtop, -10000 + wwidth, wtop + wheight)
				else
					SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
				str := name;
				if SpatiallyCalibrated then
					str := concat(str, chr($13)); {Black Diamond}
				if fit <> uncalibrated then
					str := concat(str, '×');
				wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
				GetPort(tPort);
				SetPort(wptr);
				SetPalette(wptr, ExplicitPalette, false);
				IndexToRgbForeColor(BlackIndex);
				IndexToRgbBackColor(WhiteIndex);
				SetRect(wrect, 0, 0, wwidth, wheight);
				SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
				SelectWindow(wptr);
				WindowPeek(wptr)^.WindowKind := PicKind;
				WindowPeek(wptr)^.RefCon := ord4(Info);
				TruncateString(name, maxTitle);
				title := name;
				ExtendWindowsMenu(name, PixMapSize, wptr);
				PicNum := nPics;
				PidNum := nextPid;
				nextPid := nextPid - 1;
				osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				OpenCPort(osPort);
				with osPort^ do begin
						with PortPixMap^^ do begin
								BaseAddr := PicBaseAddr;
								bounds := PicRect;
								pixelType := 0;
								if PixelSize > 8 then
									PixelSize := 8;
								cmpCount := 1;
							end;
						PortRect := PicRect;
						RectRgn(visRgn, PicRect);
						PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
					end;
				SetPalette(WindowPtr(osPort), ExplicitPalette, false);
				IndexToRgbForeColor(ForegroundIndex);
				IndexToRgbBackColor(BackgroundIndex);
				SetGDevice(SaveGDevice);
				SetPort(tPort);
				SrcRect := wrect;
				magnification := 1.0;
				RoiShowing := false;
				roiType := NoRoi;
				initwrect := wrect;
				savewrect := wrect;
				SaveSrcRect := SrcRect;
				SaveMagnification := magnification;
				savehloc := wleft;
				savevloc := wtop;
				roiRgn := NewRgn;
				NewPic := true;
				ScaleToFitWindow := false;
				OpPending := false;
				Changes := false;
				WindowState := NormalWindow;
				if (fit = uncalibrated) and InvertPixelValues then
					InvertGrayLevels;
				Revertable := false;
			end;
		WhatToUndo := NothingToUndo;
	end;


	procedure MakeLowerCase (var str: str255);
		var
			i: integer;
			c: char;
	begin
		for i := 1 to length(str) do begin
				c := str[i];
				if (c >= 'A') and (c <= 'Z') then
					str[i] := chr(ord(c) + 32);
			end;
	end;


	function PutMessageWithCancel (str: str255): integer;
	begin
		InitCursor;
		ParamText(str, '', '', '');
		PutMessageWithCancel := Alert(800, nil);
	end;


	function CurrentWindow: integer;
	begin
		CurrentWPtr := FrontWindow;
		if CurrentWPtr <> nil then begin
				CurrentKind := WindowPeek(CurrentWPtr)^.WindowKind;
				if CurrentKind = TextKind then
					TextInfo := TextInfoPtr(WindowPeek(CurrentWPtr)^.RefCon);
				CurrentWindow := CurrentKind;
			end
		else begin
				CurrentWindow := 0;
				CurrentKind := 0;
			end;
	end;


	procedure FindMonitors (NewScreenDepth: integer);
  {Generate a list of 8-bit monitors so we can update their LUTs.}
  {This wouldn't be necessary if we were using the Palette Manager.}
		var
			nextDevice: GDHandle;
	begin
		nMonitors := 0;
		nextDevice := GetDeviceList;
		while nextDevice <> nil do begin
				if TestDeviceAttribute(nextDevice, screenDevice) and TestDeviceAttribute(nextDevice, screenActive) then
					if nextDevice^^.gdPmap^^.PixelSize = 8 then begin
							nMonitors := nMonitors + 1;
							Monitors[nMonitors] := nextDevice;
						end;
				nextDevice := GetNextDevice(nextDevice);
			end; {while}
		if NewScreenDepth < 4 then
			gCopyMode := DitherCopy
		else
			gCopyMode := SrcCopy;
		SaveScreenDepth := NewScreenDepth;
	end;


	function ScreenDepth: integer;
		var
			depth: integer;
	begin
		depth := ScreenPixMap^^.PixelSize;
		if (depth = 8) and LUTFriendlyMode then
			depth := 6;
		if depth <> SaveScreenDepth then
			FindMonitors(depth);
		ScreenDepth := depth;
	end;


	procedure IndexToRgbForeColor(index: integer);{18.11.2002 replaces pmForeColor}
	begin
		RGBForeColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
	end;

	procedure IndexToRgbBackColor(index: integer);{18.11.2002 replaces pmBackColor}
	begin
		RGBBackColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
	end;

	procedure SetFColor (index: integer);
  {Sets the screen foreground color. Use pmForeColor to set the offscreen color.}
	begin
		{if ScreenDepth = 8 then
			pmForeColor(index)
		else  18.11.2002}
			RGBForeColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
	end;

	procedure SetBColor (index: integer);
  {Sets the screen background color.}
	begin
		{if ScreenDepth = 8 then
			IndexToRgbBackColor(index)
		else 18.11.2002}
			RGBBackColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
	end;
	
	function DoubleToReal(d:FakeDouble):extended;
	{Converts an IEEE double to an IEEE float. Will not be needed
	when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
	var
	  s, f, r:extended;
	  e:LongInt;
	  dd:double;
	begin
		{$ifc PowerPC}
		dd:=double(d);
		r:=dd;
		{$elsec PowerPC}
		if band(d[1],$80000000)=0 then
			s:=1
		else
			s:=-1;
		e:=band(d[1],$7ff00000);
		e:=bsr(e,20);
		f:=band(d[1],$fffff);
		f:=f / 1048576.0;
		f:=f + bsr(d[2],24)/268435456.0;
		{ShowMessage(StringOf('s=',s , ' e=', e, ' f=', f));}
		if (e > 0) and (e < 2047) then 
			r:=s * exp((e-1023)*ln(2.0)) * (1.0 + f)
		else if (e = 0) and (f <> 0) then 
			r:=s * f * exp(-1022.0*ln(2.0)) * f
		else if (e = 0) and (e = 0) then
			r:=0.0
		else if (e = 255) and (f = 0) then
			r:=0.0 {inf}
		else {if e=255 and f<>0}
			r:=0.0; {nan}
		{$endc PowerPC}
		DoubleToReal:=r;
	end;


	procedure RealToDouble(rr: extended; var d:FakeDouble);
	{Converts an IEEE float to an IEEE double. Will not be needed
	when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
	var
	  i, s, e, f:LongInt;
	  r:real;
	  dd:double;
	begin
		{$ifc PowerPC}
		dd:=rr;
		d:=FakeDouble(dd);
		{$elsec PowerPC}
		r:=rr;
		i:=LongInt(r);
	  s:=band(i,$80000000);
	  e:=band(i,$7f800000);
		e:=bsr(e, 23);
		if e>255 then
			e:=255;
		e:=e-127+1023;
		e:=bsl(e, 20);
		f:=band(i, $7fffff);
		f:=bsr(f, 3);
		d[1]:=bor(s,bor(e,f));
		d[2]:=0;
		{if r<>0.0 then begin
			ShowMessage(StringOf(' e=', e,' f=', f)); wait(60);
		end;}
		{$endc PowerPC}
	end;
	
	
{$S Utilities2}
{Routines from here to the end of the file go in the Utilities2 segment}

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

	
	procedure SelectSlice (i: integer);
	begin
		with info^, info^.StackInfo^ do
			if i <= nSlices then begin
					hunlock(PicBaseHandle);
					PicBaseHandle := PicBaseH[i];
					hlock(PicBaseHandle);
					{$ifc PowerPC}
					PicBaseAddr := PicBaseHandle^;
					{$elsec}
					PicBaseAddr := StripAddress(PicBaseHandle^);
					{$endc}
					osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
				end;
	end;


	procedure UpdateWindowsMenuItem;
		var
			str: str255;
			picSize: LongInt;
	begin
		with info^ do begin
			PicSize := PixMapSize;
			if StackInfo <> nil then
				PicSize := PicSize * StackInfo^.nSlices;
			if DataH <> nil then
				PicSize := PicSize + PicSize * SizeOf(real);
			NumToString((PicSize + 511) div 1024, str);
			str := concat(title, '  ', str, 'K');
			SetMenuItemText(WindowsMenuH, PicNum + WindowsMenuItems + nTextWindows, str);
		end;
	end;


	function AddSlice (update: boolean): boolean;
		var
			i: integer;
			h: handle;
			isRoi: boolean;
	begin
		with info^, info^.StackInfo^ do begin
				AddSlice := false;
				if nSlices = MaxSlices then
					exit(AddSlice);
				isRoi := RoiShowing;
				if isRoi then
					KillRoi;
				h := GetBigHandle(PixMapSize);
				if h = nil then begin
						PutError('Not enough memory available to add a slice to this stack.');
						AbortMacro;
						exit(AddSlice);
					end;
				for i := nSlices downto CurrentSlice + 1 do
					PicBaseH[i + 1] := PicBaseH[i];
				nSlices := nSlices + 1;
				CurrentSlice := CurrentSlice + 1;
				PicBaseH[CurrentSlice] := h;
				SelectSlice(CurrentSlice);
				if Update then begin
						SelectAll(false);
						DoOperation(EraseOp);
						UpdatePicWindow;
					end;
				if (StackType = rgbStack) and (nSlices <> 3) then
					StackType := VolumeStack;
				UpdateTitleBar;
				if isRoi then
					RestoreRoi;
				WhatToUndo := NothingToUndo;
				AddSlice := true;
				changes := true;
				PictureType := NewPicture;
				UpdateWindowsMenuItem;
			end;
	end;
	
	
	procedure AbortMacro;
	{If a macro is running, abort it.}
	begin
		macro := false;
	end;
	
	
	procedure TruncateString(var str: str255; len: integer);
	begin
{if length(str) > len then
	beep;}
			if length(str) > len then
			delete(str, len + 1, length(str) - len);
	end;
	
			
	procedure CloseVdig;
	{Closes the current video digitizer component and
	its associated offscreen graphics world.}
	var
		err: osErr;
	begin
		if fgPixMap <> nil then begin
			if osGWorld<>nil then
				DisposeGWorld(osGWorld);
			osGWorld := nil;
			GWorldLUT := nil;
			fgPixMap := nil;
		end;
		if vdig <> nil then begin
			err := CloseComponent(vdig);
			vdig := nil;
		end;
		FrameGrabber := noFrameGrabber;
		GrabbingToScreen := false;
	end;


end.