home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / src / Utilities.p < prev   
Encoding:
Text File  |  1997-01-21  |  80.8 KB  |  3,389 lines  |  [TEXT/CWIE]
  1. unit Utilities;
  2.  
  3. {Miscellaneous utility routines used by NIH Image}
  4.  
  5. interface
  6.  
  7.    uses
  8.         Types, Memory, QuickDraw, Packages, Devices, Menus, Events, Fonts, Scrap, TextEdit, ToolUtils, Dialogs,
  9.         Controls, Palettes, ColorPicker, Printing, SegLoad, Processes, QuickDrawText, TextUtils, Windows,
  10.                 OSUtils, QDOffscreen, Components, QuickTimeComponents, globals;
  11.  
  12.  
  13.  
  14.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  15.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  16.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  17.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  18.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  19.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  20.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  21.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  22.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  23.     function StringToReal (str: str255): extended;
  24.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  25.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  26.     procedure DrawReal (Val: extended; width, fwidth: integer);
  27.     procedure DrawJReal (hloc, vloc: integer; Val: extended; fwidth: integer);
  28.     procedure DrawLong (i: LongInt);
  29.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  30.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  31.     function OptionKeyDown: boolean;
  32.     function ShiftKeyDown: boolean;
  33.     function ControlKeyDown: boolean;
  34.     function CommandPeriod: boolean;
  35.     function SpaceBarDown: boolean;
  36.  
  37.     procedure SysResume;
  38.     procedure beep;
  39.     procedure PutMessage (str: str255);
  40.     procedure PutError (str: str255);
  41.     procedure UnprotectLUT;
  42.     procedure LoadLUT (table: MyCSpecArray);
  43.     procedure SetupLutUndo;
  44.     procedure UndoLutChange;
  45.     procedure DisableDensitySlice;
  46.     procedure LoadInputLUT (address: ptr);
  47.     procedure ResetQuickCapture;
  48.     procedure ResetScionLG3;
  49.     procedure ResetScionAG5;
  50.     procedure ResetScionVG5f;
  51.     procedure ResetFrameGrabber;
  52.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  53.     procedure wait (ticks: LongInt);
  54.     function GetScrapCount: integer;
  55.     procedure DisplayText (update: boolean);
  56.     procedure ScreenToOffscreen (var loc: point);
  57.     procedure OffscreenToScreen (var loc: point);
  58.     procedure OffScreenToScreenRect (var r: rect);
  59.     procedure UpdateScreen (MaskRect: rect);
  60.     procedure RestoreRoi;
  61.     procedure Undo;
  62.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  63.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  64.     function GetFontSize (item: integer): integer;
  65.     function MyGetPixel (h, v: LongInt): integer;
  66.     procedure PutPixel (h, v: LongInt; value: integer);
  67.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  68.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  69.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  70.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  71.     procedure Show1Value (rvalue, CalibratedValue: extended);
  72.     procedure Show2PlotValues (x, y: extended);
  73.     procedure Show2Values (current, total: LongInt);
  74.     procedure DrawXDimension (x: extended; digits: integer);
  75.     procedure DrawYDimension (y: extended; digits: integer);
  76.     procedure DrawRGB (index: integer);
  77.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  78.     procedure ShowDxDy (X, Y: extended);
  79.     procedure PutChar (c: char);
  80.     procedure PutTab;
  81.     procedure PutString (str: str255);
  82.     procedure PutReal (n: extended; width, fwidth: integer);
  83.     procedure PutLong (n: LongInt; FieldWidth: integer);
  84.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  85.     procedure ShowWatch;
  86.     procedure ShowAnimatedWatch;
  87.     procedure UpdatePicWindow;
  88.     procedure DoOperation (Operation: OpType);
  89.     procedure SaveRoi;
  90.     procedure KillRoi;
  91.     procedure ShowRoi;
  92.     procedure SetupUndo;
  93.     procedure SetupUndoFromClip;
  94.     procedure GetLoi (var x1, y1, x2, y2: extended);
  95.     function NotRectangular: boolean;
  96.     function NotInBounds: boolean;
  97.     function NoSelection: boolean;
  98.     function NoUndo: boolean;
  99.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  100.     function NewPicWindow (name: str255; width, height: integer): boolean;
  101.     function GetAngle (dx, dy: extended):extended;
  102.     procedure MakeRegion;
  103.     procedure SelectAll (visible: boolean);
  104.     procedure EraseScreen;
  105.     procedure RestoreScreen;
  106.     procedure UpdateTitleBar;
  107.     procedure Unzoom;
  108.     procedure DrawBString (str: string);
  109.     procedure DrawMyGrowIcon (w: WindowPtr);
  110.     procedure PutMemoryAlert;
  111.     function GetBigHandle (NeededSize: LongInt): handle;
  112.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  113.     procedure UpdateAnalysisMenu;
  114.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  115.     procedure MakeNewWindow (name: str255);
  116.     function long2str (num: LongInt): str255;
  117.     procedure PutWarning;
  118.     procedure ScaleToFit;
  119.     procedure SetupRoiRect;
  120.     procedure SetForegroundColor (color: integer);
  121.     procedure SetBackgroundColor (color: integer);
  122.     procedure GetForegroundColor (event: EventRecord);
  123.     procedure GetBackgroundColor (event: EventRecord);
  124.     procedure GenerateValues;
  125.     procedure KillOperation;
  126.     procedure ScaleImageWindow (var trect: rect);
  127.     procedure InvertGrayLevels;
  128.     function TooWide: boolean;
  129.     procedure DrawTextString (str: str255; loc: point; just: integer);
  130.     procedure IncrementCounter;
  131.     procedure ClearResults (i: integer);
  132.     procedure UpdateFitEllipse;
  133.     procedure UpdateTextItems;
  134.     procedure MakeLowerCase (var str: str255);
  135.     function PutMessageWithCancel (str: str255): integer;
  136.     function CurrentWindow: integer;
  137.     procedure FindMonitors (NewScreenDepth: integer);
  138.     function ScreenDepth: integer;
  139.     procedure SetFColor (index: integer);
  140.     procedure SetBColor (index: integer);
  141.     function DoubleToReal(d:FakeDouble):extended; {68k-bug}
  142.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  143.     function MakeStackFromWindow: boolean;
  144.     procedure SelectSlice (i: integer);
  145.     procedure UpdateWindowsMenuItem;
  146.     function AddSlice (update: boolean): boolean;
  147.     procedure AbortMacro;
  148.     procedure TruncateString(var str: str255; length: integer);
  149.     procedure RemovePath(var str: str255);
  150.     procedure CloseVdig;
  151.     
  152.  
  153. implementation
  154.  
  155.  
  156.     type
  157.         KeyPtrType = ^KeyMap;
  158.  
  159.  
  160.  
  161.     {procedure MacsBug (str: str255);
  162.     inline
  163.         $abff;}
  164.  
  165.  
  166.     procedure ShowMessage (str: str255);
  167.         var
  168.             vloc, hloc: integer;
  169.             tPort: GrafPtr;
  170.             trect: rect;
  171.             SaveGDevice: GDHandle;
  172.     begin
  173.         SaveGDevice := GetGDevice;
  174.         SetGDevice(GetMainDevice);
  175.       InfoMessage := str;
  176.         GetPort(tPort);
  177.         vloc := 35;
  178.         hloc := 4;
  179.         SetPort(InfoWindow);
  180.         TextFont(Geneva);
  181.         TextSize(9);
  182.         Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  183.         TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft);
  184.         SetPort(tPort);
  185.         SetGDevice(SaveGDevice);
  186.         wait(120);
  187.     end;
  188.  
  189.  
  190.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  191.         var
  192.             ItemType: integer;
  193.             ItemBox: rect;
  194.             ItemHdl: handle;
  195.     begin
  196.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  197.         SetControlValue(ControlHandle(ItemHdl),value)
  198.     end;
  199.  
  200.  
  201.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  202.   {Draws a border around a button. 16 is the normal}
  203.   {corner radius for small buttons }
  204.         var
  205.             itemType: Integer;
  206.             itemBox: Rect;
  207.             itemHdl: Handle;
  208.             tempPort: GrafPtr;
  209.     begin
  210.         GetPort(tempPort);
  211.         SetPort(GrafPtr(theDialog));
  212.         GetDialogItem(theDialog, itemNo, itemType, itemHdl, itemBox);
  213.         PenSize(3, 3);
  214.         InSetRect(itemBox, -4, -4);
  215.         FrameRoundRect(itemBox, cornerRad, cornerRad);
  216.         PenSize(1, 1);
  217.         SetPort(tempPort);
  218.     end;
  219.  
  220.  
  221.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  222.         var
  223.             ItemType: integer;
  224.             ItemBox: rect;
  225.             ItemHdl: handle;
  226.             str: str255;
  227.             n: LongInt;
  228.     begin
  229.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  230.         GetDialogItemText(ItemHdl, str);
  231.         StringToNum(str, n);
  232.         GetDNum := n;
  233.     end;
  234.  
  235.  
  236.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  237.         var
  238.             ItemType: integer;
  239.             ItemBox: rect;
  240.             ItemHdl: handle;
  241.             str: str255;
  242.     begin
  243.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  244.         GetDialogItemText(ItemHdl, str);
  245.         GetDString := str;
  246.     end;
  247.  
  248.  
  249.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  250.         var
  251.             ItemType: integer;
  252.             ItemBox: rect;
  253.             ItemHdl: handle;
  254.             str: str255;
  255.     begin
  256.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  257.         NumToString(n, str);
  258.         SetDialogItemText(ItemHdl, str)
  259.     end;
  260.  
  261.  
  262.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  263.   {Returns global coordinates of specified window.}
  264.     begin
  265.         if w <> nil then
  266.             wrect := WindowPeek(w)^.contRgn^^.rgnBBox
  267.         else
  268.             SetRect(wrect, 0, 0, 0, 0);
  269.     end;
  270.  
  271.  
  272.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  273.         var
  274.             ItemType: integer;
  275.             ItemBox: rect;
  276.             ItemHdl: handle;
  277.             str: str255;
  278.     begin
  279.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  280.         RealToString(n, 1, fwidth, str);
  281.         SetDialogItemText(ItemHdl, str)
  282.     end;
  283.  
  284.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  285.         var
  286.             ItemType: integer;
  287.             ItemBox: rect;
  288.             ItemHdl: handle;
  289.     begin
  290.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  291.         SetDialogItemText(ItemHdl, str)
  292.     end;
  293.  
  294.  
  295.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  296.         var
  297.             str: str255;
  298.     begin
  299.         str := GetDString(TheDialog, item);
  300.         GetDReal := StringToReal(str);
  301.     end;
  302.  
  303.  
  304.     procedure DrawLong (i: LongInt);
  305.         var
  306.             str: str255;
  307.     begin
  308.         NumToString(i, str);
  309.         DrawString(str);
  310.     end;
  311.  
  312.  
  313.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  314.   {Does number to string conversion equivalent to write(val:width:fwidth).}
  315.   var
  316.       i:integer;
  317.     begin
  318.         if width<1 then width:=1;
  319.         if (fwidth<0) or (fwidth>8) then fwidth:=0;
  320.         str:=StringOf(val:width:fwidth);
  321.     end;
  322.  
  323.  
  324.     procedure DrawReal (Val: extended; width, fwidth: integer);
  325.   {Displays a real(or integer) number at the current location in}
  326.   {a form equivalent to write(val:width:fwidth) }
  327.         var
  328.             str: str255;
  329.     begin
  330.         RealToString(val, width, fwidth, str);
  331.         DrawString(str);
  332.     end;
  333.  
  334.  
  335.     procedure DrawJReal (hloc, vloc: integer; val: extended; fwidth: integer);
  336.   {Draws right justified real number.}
  337.         var
  338.             str: str255;
  339.     begin
  340.         if (val >= 1000.0) or (val <= -1000.0) then
  341.             fwidth := 0;
  342.         RealToString(val, 1, fwidth, str);
  343.         MoveTo(hloc - StringWidth(str) - 2, vloc);
  344.         DrawString(str);
  345.     end;
  346.  
  347.  
  348.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  349.         const
  350.             NumberID = 3;
  351.         var
  352.             mylog: DialogPtr;
  353.             item: integer;
  354.             temp: LongInt;
  355.     begin
  356.         ParamText(message, '', '', '');
  357.         mylog := GetNewDialog(3000, nil, pointer(-1));
  358.         SetDNum(MyLog, NumberID, default);
  359.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  360.         OutlineButton(MyLog, ok, 16);
  361.         repeat
  362.             ModalDialog(nil, item);
  363.         until (item = ok) or (item = cancel);
  364.         if item = ok then begin
  365.                 Canceled := false;
  366.                 temp := GetDNum(MyLog, NumberID);
  367.                 if (temp > -MaxInt) and (temp <= MaxInt) then
  368.                     GetInt := temp
  369.                 else begin
  370.                         beep;
  371.                         GetInt := default
  372.                     end;
  373.             end {item=ok}
  374.         else begin
  375.                 Canceled := true;
  376.                 GetInt := default;
  377.             end;
  378.         DisposeDialog(mylog);
  379.     end;
  380.  
  381.  
  382.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  383.         const
  384.             NumberID = 3;
  385.         var
  386.             mylog: DialogPtr;
  387.             item: integer;
  388.     begin
  389.         InitCursor;
  390.         ParamText(message, '', '', '');
  391.         mylog := GetNewDialog(3000, nil, pointer(-1));
  392.         SetDReal(MyLog, NumberID, default, precision);
  393.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  394.         OutlineButton(MyLog, ok, 16);
  395.         repeat
  396.             ModalDialog(nil, item);
  397.         until (item = ok) or (item = cancel);
  398.         if item = ok then begin
  399.                 GetReal := GetDReal(MyLog, NumberID);
  400.                 Canceled := false;
  401.             end
  402.         else begin
  403.                 GetReal := default;
  404.                 Canceled := true;
  405.             end;
  406.         DisposeDialog(mylog);
  407.     end;
  408.  
  409.  
  410.     function OptionKeyDown: boolean;
  411.         var
  412.             KeyPtr: KeyPtrType;
  413.             keys: array[0..3] of LongInt;
  414.     begin
  415.         KeyPtr := KeyPtrType(@keys);
  416.         GetKeys(KeyPtr^);
  417.         OptionKeyDown := (BAND(keys[1], 4)) <> 0;
  418.     end;
  419.  
  420.  
  421.     function ShiftKeyDown: boolean;
  422.         var
  423.             KeyPtr: KeyPtrType;
  424.             keys: array[0..3] of LongInt;
  425.     begin
  426.         KeyPtr := KeyPtrType(@keys);
  427.         GetKeys(KeyPtr^);
  428.         ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
  429.     end;
  430.  
  431.  
  432.     function ControlKeyDown: boolean;
  433.         type
  434.             KeyPtrType = ^KeyMap;
  435.         var
  436.             KeyPtr: KeyPtrType;
  437.             keys: array[0..3] of LongInt;
  438.     begin
  439.         KeyPtr := KeyPtrType(@keys);
  440.         GetKeys(KeyPtr^);
  441.         ControlKeyDown := (BAND(keys[1], 8)) <> 0;
  442.     end;
  443.  
  444.  
  445.     function CommandPeriod: boolean;
  446.         type
  447.             KeyPtrType = ^KeyMap;
  448.         var
  449.             KeyPtr: KeyPtrType;
  450.             keys: array[0..3] of LongInt;
  451.     begin
  452.         KeyPtr := KeyPtrType(@keys);
  453.         GetKeys(KeyPtr^);
  454.         CommandPeriod := (BAND(keys[1], $808000)) = $808000;
  455.     end;
  456.  
  457.  
  458.     function SpaceBarDown: boolean;
  459.         var
  460.             KeyPtr: KeyPtrType;
  461.             keys: array[0..3] of LongInt;
  462.     begin
  463.         KeyPtr := KeyPtrType(@keys);
  464.         GetKeys(KeyPtr^);
  465.         SpaceBarDown := (BAND(keys[1], 512)) <> 0;
  466.     end;
  467.  
  468.  
  469.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  470.  {Draw a string item in a dialog box.}
  471.         var
  472.             r: rect;
  473.             iType: integer;
  474.             ignore: handle;
  475.     begin
  476.         GetDialogItem(d, ItemNum, iType, ignore, r);
  477.         TextFont(fontrqst);
  478.         TextSize(sizerqst);
  479.         TETextBox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
  480.     end;
  481.  
  482.  
  483.     procedure SysResume;
  484.     begin
  485.         FlushEvents(EveryEvent, 0);
  486.         ExitToShell;
  487.     end;
  488.  
  489.  
  490.     procedure beep;
  491.     {Sets the current gdevice to the screen because SysBeep flashes
  492.   the menu bar if the sound level is zero and this is reported to sometimes
  493.     cause a crash on older Macs when using an offscreen gdevice.} 
  494.         var
  495.             SaveGDevice: GDHandle;
  496.     begin
  497.         SaveGDevice := GetGDevice;
  498.         SetGDevice(GetMainDevice);
  499.         SysBeep(1);
  500.         SetGDevice(SaveGDevice);
  501.     end;
  502.  
  503.  
  504.     procedure PutMessage (str: str255);
  505.         var
  506.             ignore: integer;
  507.             SaveGDevice: GDHandle;
  508.     begin
  509.         SaveGDevice := GetGDevice;
  510.         SetGDevice(GetMainDevice);
  511.         InitCursor;
  512.         ParamText(str, '', '', '');
  513.         Ignore := Alert(300, nil);
  514.         SetGDevice(SaveGDevice);
  515.     end;
  516.     
  517.  
  518.     procedure PutError (str: str255);
  519.         var
  520.             ignore: integer;
  521.             SaveGDevice: GDHandle;
  522.     begin
  523.         SaveGDevice := GetGDevice;
  524.         SetGDevice(GetMainDevice);
  525.         InitCursor;
  526.         ParamText(str, '', '', '');
  527.         Ignore := Alert(310, nil);
  528.         SetGDevice(SaveGDevice);
  529.     end;
  530.  
  531.  
  532.     function GetFontSize (item: integer): integer;
  533.         var
  534.             TempSize: integer;
  535.             Canceled: boolean;
  536.     begin
  537.         case item of
  538.             1: 
  539.                 GetFontSize := 9;
  540.             2: 
  541.                 GetFontSize := 10;
  542.             3: 
  543.                 GetFontSize := 12;
  544.             4: 
  545.                 GetFontSize := 14;
  546.             5: 
  547.                 GetFontSize := 18;
  548.             6: 
  549.                 GetFontSize := 24;
  550.             7: 
  551.                 GetFontSize := 36;
  552.             8: 
  553.                 GetFontSize := 48;
  554.             9: 
  555.                 GetFontSize := 56;
  556.             10: 
  557.                 GetFontSize := 72;
  558.             12:  begin
  559.                     TempSize := GetInt('Font Size:', CurrentSize, Canceled);
  560.                     if TempSize < 1 then
  561.                         TempSize := 1;
  562.                     if TempSize > 1000 then
  563.                         TempSize := 1000;
  564.                     if not canceled then
  565.                         GetFontSize := TempSize
  566.                     else
  567.                         GetFontSize := CurrentSize;
  568.                 end;
  569.         end;
  570.     end;
  571.  
  572.  
  573.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  574. {Enable or disable menuh's itemnum. }
  575.     begin
  576.         if on then
  577.             EnableItem(menuh, itemnum)
  578.         else
  579.             DisableItem(menuh, itemnum);
  580.         if ItemNum = 0 then
  581.             DrawMenuBar;
  582.     end;
  583.  
  584.  
  585.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  586.         var
  587.             i: integer;
  588.     begin
  589.         for i := fst to lst do
  590.             if i = item then
  591.                 CheckItem(MenuH, i, true)
  592.             else
  593.                 CheckItem(MenuH, i, false);
  594.     end;
  595.  
  596.  
  597.     procedure UpdateTextItems;
  598.         var
  599.             size, i, MenuItem, FontID, item: integer;
  600.             FontName: str255;
  601.             FontFound, FoundIt: boolean;
  602.             str: str255;
  603.     begin
  604.         FontFound := false;
  605.         for item := 1 to NumFontItems do begin
  606.                 GetMenuItemText(FontMenuH, Item, FontName);
  607.                 GetFNum(FontName, FontID);
  608.                 if FontID = CurrentFontID then begin
  609.                         FontFound := true;
  610.                         CheckItem(FontMenuH, Item, True)
  611.                     end
  612.                 else
  613.                     CheckItem(FontMenuH, Item, false);
  614.             end;
  615.         if not FontFound then begin
  616.                 FoundIt := False;
  617.                 Item := 1;
  618.                 repeat
  619.                     GetMenuItemText(FontMenuH, Item, FontName);
  620.                     GetFNum(FontName, FontID);
  621.                     if FontID = Geneva then begin
  622.                             CheckItem(FontMenuH, Item, True);
  623.                             CurrentFontID := FontID;
  624.                             FoundIt := true;
  625.                         end;
  626.                     Item := Item + 1;
  627.                 until (Item > NumFontItems) or FoundIt;
  628.             end;
  629.  
  630.         for i := 1 to 10 do begin
  631.                 size := GetFontSize(i);
  632.                 if RealFont(CurrentFontID, size) then
  633.                     SetItemStyle(SizeMenuH, i, [outline])
  634.                 else
  635.                     SetItemStyle(SizeMenuH, i, [])
  636.             end;
  637.         NumToString(CurrentSize, str);
  638.         str := concat('Other[', str, ']…');
  639.         SetMenuItemText(SizeMenuH, 12, str);
  640.  
  641.         for i := TxPlain to TxShadow do
  642.             CheckItem(StyleMenuH, i, false);
  643.         if CurrentStyle = [] then
  644.             CheckItem(StyleMenuH, TxPlain, true)
  645.         else begin
  646.                 if Bold in CurrentStyle then
  647.                     CheckItem(StyleMenuH, TxBold, true);
  648.                 if Italic in CurrentStyle then
  649.                     CheckItem(StyleMenuH, TxItalic, true);
  650.                 if Underline in CurrentStyle then
  651.                     CheckItem(StyleMenuH, TxUnderline, true);
  652.                 if Outline in CurrentStyle then
  653.                     CheckItem(StyleMenuH, TxOutline, true);
  654.                 if Shadow in CurrentStyle then
  655.                     CheckItem(StyleMenuH, Txshadow, true);
  656.             end;
  657.  
  658.         case CurrentSize of
  659.             9: 
  660.                 MenuItem := 1;
  661.             10: 
  662.                 MenuItem := 2;
  663.             12: 
  664.                 MenuItem := 3;
  665.             14: 
  666.                 MenuItem := 4;
  667.             18: 
  668.                 MenuItem := 5;
  669.             24: 
  670.                 MenuItem := 6;
  671.             36: 
  672.                 MenuItem := 7;
  673.             48: 
  674.                 MenuItem := 8;
  675.             56: 
  676.                 MenuItem := 9;
  677.             72: 
  678.                 MenuItem := 10;
  679.             otherwise
  680.                 MenuItem := 12;
  681.         end;
  682.         CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);
  683.  
  684.         case TextJust of
  685.             teJustLeft: 
  686.                 MenuItem := LeftItem;
  687.             teJustCenter: 
  688.                 MenuItem := CenterItem;
  689.             teJustRight: 
  690.                 MenuItem := RightItem;
  691.         end;
  692.         CheckOnOffItem(StyleMenuH, MenuItem, LeftItem, RightItem);
  693.  
  694.         if TextBack = NoBack then
  695.             MenuItem := NoBackgroundItem
  696.         else
  697.             MenuItem := WithBackgroundItem;
  698.         CheckOnOffItem(StyleMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
  699.     end;
  700.  
  701.  
  702.     procedure LoadLUT (table: MyCSpecArray);
  703.         var
  704.             i, entry, screen: integer;
  705.             cPtr: ^cSpecArray;
  706.             SaveDevice: GDHandle;
  707.     begin
  708.         if nExtraColors > 0 then begin
  709.                 entry := FirstExtraColorsEntry;
  710.                 for i := 1 to nExtraColors do begin
  711.                         table[entry].rgb := ExtraColors[i];
  712.                         entry := entry + 1;
  713.                     end;
  714.             end;
  715.         if HighLightMode then begin
  716.                 table[1].rgb := Highlight1;
  717.                 table[254].rgb := Highlight254;
  718.             end;
  719.         for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
  720.             with table[i].rgb do
  721.                 if (red = 0) and (green = 0) and (blue = 0) then begin
  722.                         red := 256;
  723.                         green := 256;
  724.                         blue := 256;
  725.                     end;
  726.         cPtr := @table[1];
  727.         if ScreenDepth = 8 then begin
  728.             SaveDevice := GetGDevice;
  729.             for screen := 1 to nMonitors do begin
  730.                     SetGDevice(Monitors[screen]);
  731.                     for i := 1 to 254 do begin
  732.                             ProtectEntry(i, false);
  733.                             ReserveEntry(i, false);
  734.                         end;
  735.                     SetEntries(1, 253, cPtr^);
  736.                 end;
  737.             SetGDevice(SaveDevice);
  738.         end;
  739.         table[0].rgb := WhiteRGB;
  740.         table[255].rgb := BlackRGB;
  741.         BlockMove(@table, @osGDevice^^.gdPMap^^.pmTable^^.ctTable, SizeOf(table));
  742.         with osGDevice^^.gdPMap^^.pmTable^^ do
  743.             if ScreenDepth = 8 then
  744.                 ctSeed := ScreenPixMap^^.pmTable^^.ctSeed
  745.             else
  746.                 ctSeed := GetCtSeed;
  747.     end;
  748.  
  749.  
  750.     procedure SetupLutUndo;
  751.     begin
  752.         with info^ do begin
  753.                 UndoInfo^.RedLut := RedLut;
  754.                 UndoInfo^.GreenLut := GreenLut;
  755.                 UndoInfo^.BlueLut := BlueLut;
  756.                 UndoInfo^.nColors := nColors;
  757.                 UndoInfo^.ColorStart := ColorStart;
  758.                 UndoInfo^.ColorEnd := ColorEnd;
  759.                 UndoInfo^.FillColor1 := FillColor1;
  760.                 UndoInfo^.FillColor2 := FillColor2;
  761.                 UndoInfo^.LutMode := LutMode;
  762.                 UndoInfo^.ColorTable := ColorTable;
  763.                 UndoInfo^.IdentityFunction := IdentityFunction;
  764.                 UndoInfo^.cTable := cTable;
  765.                 WhatToUndo := UndoLUT;
  766.             end;
  767.     end;
  768.  
  769.  
  770.     procedure UndoLutChange;
  771.     begin
  772.         with info^ do begin
  773.                 RedLut := UndoInfo^.RedLut;
  774.                 GreenLut := UndoInfo^.GreenLut;
  775.                 BlueLut := UndoInfo^.BlueLut;
  776.                 nColors := UndoInfo^.nColors;
  777.                 ColorStart := UndoInfo^.ColorStart;
  778.                 ColorEnd := UndoInfo^.ColorEnd;
  779.                 FillColor1 := UndoInfo^.FillColor1;
  780.                 FillColor2 := UndoInfo^.FillColor2;
  781.                 LutMode := UndoInfo^.LutMode;
  782.                 LutMode := UndoInfo^.LutMode;
  783.                 ColorTable := UndoInfo^.ColorTable;
  784.                 cTable := UndoInfo^.cTable;
  785.                 LoadLut(cTable);
  786.                 Thresholding := false;
  787.                 WhatToUndo := NothingToUndo;
  788.             end;
  789.     end;
  790.  
  791.  
  792.     procedure UpdatePicWindow;
  793.         var
  794.             tPort: GrafPtr;
  795.             SaveGDevice: GDHandle;
  796.     begin
  797.         if (info <> NoInfo) and (info^.wptr <> nil) then
  798.             with Info^ do begin
  799.                     SaveGDevice := GetGDevice;
  800.                     SetGDevice(GetMainDevice);
  801.                     getPort(tPort);
  802.                     SetPort(wptr);
  803.                     SetFColor(BlackIndex);
  804.                     SetBColor(WhiteIndex);
  805.                     CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, nil);
  806.                     SetPort(tPort);
  807.                     SetGDevice(SaveGDevice);
  808.                     RoiUpdateTime := 0;
  809.                 end;
  810.     end;
  811.  
  812.  
  813.     procedure DisableDensitySlice;
  814.         var
  815.             tPort: GrafPtr;
  816.     begin
  817.         if DensitySlicing then begin
  818.                 DensitySlicing := false;
  819.                 UndoLutChange;
  820.                 if ScreenDepth <> 8 then begin
  821.                         UpdatePicWindow;
  822.                         GetPort(tPort);
  823.                         SetPort(LUTWindow);
  824.                         InvalRect(LutWindow^.PortRect);
  825.                         SetPort(tPort);
  826.                     end;
  827.             end;
  828.     end;
  829.  
  830.  
  831.     procedure LoadInputLUT (address: ptr);
  832.         type
  833.             ilutType = packed array[0..1023] of byte;
  834.             ilutPtr = ^ilutType;
  835.         var
  836.             ilut: ilutPtr;
  837.             i: integer;
  838.     begin
  839.         ilut := ilutPtr(address);
  840.         if InvertVideo then begin
  841.                 for i := 0 to 255 do
  842.                     ilut^[i * 4] := i;
  843.                 ilut^[0] := 1;
  844.                 ilut^[255 * 4] := 254
  845.             end
  846.         else begin
  847.                 for i := 0 to 255 do
  848.                     ilut^[i * 4] := 255 - i;
  849.                 ilut^[0] := 254;
  850.                 ilut^[255 * 4] := 1
  851.             end;
  852.     end;
  853.  
  854.  
  855.     procedure ResetQuickCapture;
  856.         const
  857.             ilutOffset = $90000;
  858.     begin
  859.         ControlReg^ := 1; {reset}
  860.         while BitAnd(ControlReg^, $80) = $80 do
  861.             ;
  862.         ChannelReg^ := VideoChannel * 64;
  863.         while BitAnd(ControlReg^, $80) = $80 do
  864.             ;
  865.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  866.     end;
  867.  
  868.  
  869.     procedure ResetScionLG3;
  870.         const
  871.             ilutOffset = $80000;
  872.         var
  873.             SyncChannel, t: integer;
  874.     begin
  875.         ControlReg^ := 0;
  876.         BufferReg^ := 0;
  877.         if SyncMode = SeparateSync then
  878.             SyncChannel := 3
  879.         else
  880.             SyncChannel := VideoChannel;
  881.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  882.         ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  883.         DacHighReg^ := DacHigh;
  884.         DacLowReg^ := DacLow;
  885.         DacAReg^ := LG3DacA;
  886.         DacBReg^ := LG3DacB;
  887.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  888.     end;
  889.  
  890.  
  891.     procedure ResetScionAG5;
  892.         const
  893.             ilutOffset = $E0000;
  894.         var
  895.             SyncChannel: integer;
  896.     begin
  897.         ControlReg^ := 0;
  898.         if SyncMode = SeparateSync then
  899.             SyncChannel := 3
  900.         else
  901.             SyncChannel := VideoChannel;
  902.         ChannelReg^ := bor(ord(AG5BufferMode), bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  903.         DacHighReg^ := DacHigh;
  904.         DacLowReg^ := DacLow;
  905.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  906.     end;
  907.  
  908.  
  909.     procedure ResetScionVG5f;
  910.         const
  911.             ilutOffset = $80000;
  912.         var
  913.             SyncChannel, t: integer;
  914.     begin
  915.         ControlReg^ := 0;
  916.         if SyncMode = SeparateSync then
  917.             SyncChannel := 3
  918.         else
  919.             SyncChannel := VideoChannel;
  920.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  921.         ChannelReg^ := bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  922.         DacHighReg^ := DacHigh;
  923.         DacLowReg^ := DacLow;
  924.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  925.     end;
  926.  
  927.  
  928.     procedure ResetFrameGrabber;
  929.     begin
  930.         case FrameGrabber of
  931.             QuickCapture: 
  932.                 ResetQuickCapture;
  933.             ScionLG3: 
  934.                 ResetScionLG3;
  935.             ScionAG5: 
  936.                 ResetScionAG5;
  937.             ScionVG5f:
  938.                 ResetScionVG5f;
  939.             otherwise
  940.                 ;
  941.         end;
  942.     end;
  943.  
  944.  
  945.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  946.         var
  947.             SaveGDevice: GDHandle;
  948.     begin
  949.         SaveGDevice := GetGDevice;
  950.         SetGDevice(osGDevice);
  951.         pmForeColor(BlackIndex);
  952.         pmBackColor(WhiteIndex);
  953.         CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(dst)^^, sRect, dRect, DitherCopy, nil);
  954.         pmForeColor(ForegroundIndex);
  955.         pmBackColor(BackgroundIndex);
  956.         SetGDevice(SaveGDevice);
  957.     end;
  958.  
  959.  
  960.     procedure wait (ticks: LongInt);
  961.         var
  962.             SaveTicks: LongInt;
  963.     begin
  964.         SaveTicks := TickCount + ticks;
  965.         repeat
  966.         until TickCount > SaveTicks;
  967.     end;
  968.  
  969.  
  970.     function GetScrapCount: integer;
  971.         var
  972.             ScrapInfo: ScrapStuffPtr;
  973.     begin
  974.         ScrapInfo := InfoScrap;
  975.         GetScrapCount := ScrapInfo^.ScrapCount;
  976.     end;
  977.  
  978.  
  979.     procedure DisplayText (update: boolean);
  980.         var
  981.             tPort: GrafPtr;
  982.             i, hstart, width, ff: integer;
  983.             MaskRect: rect;
  984.             p1, p2: point;
  985.             SaveGDevice: GDHandle;
  986.     begin
  987.         if (info = NoInfo) or (not IsInsertionPoint) then
  988.             exit(DisplayText);
  989.         if update then
  990.             Undo;
  991.         SaveGDevice := GetGDevice;
  992.         SetGDevice(osGDevice);
  993.         GetPort(tPort);
  994.         SetPort(GrafPtr(Info^.osPort));
  995.         pmForeColor(ForegroundIndex);
  996.         pmBackColor(BackgroundIndex);
  997.         TextFont(CurrentFontID);
  998.         TextFace(CurrentStyle);
  999.         TextSize(CurrentSize);
  1000.         if TextBack = NoBack then
  1001.             TextMode(SrcOr)
  1002.         else
  1003.             TextMode(SrcCopy);
  1004.         width := StringWidth(TextStr);
  1005.         case TextJust of
  1006.             teJustLeft: 
  1007.                 hstart := TextStart.h;
  1008.             teJustCenter: 
  1009.                 hstart := TextStart.h - width div 2;
  1010.             teJustRight: 
  1011.                 hstart := TextStart.h - width;
  1012.         end;
  1013.         if hstart < 0 then
  1014.             hstart := 0;
  1015.         MoveTo(hstart, TextStart.v);
  1016.         DrawString(TextStr);
  1017.         GetPen(InsertionPoint);
  1018.         ff := CurrentSize * 2;
  1019.         p1.h := hstart - ff;
  1020.         p1.v := TextStart.v - CurrentSize;
  1021.         p2.h := TextStart.h + width + ff;
  1022.         p2.v := TextStart.v + CurrentSize div 3;
  1023.         Pt2Rect(p1, p2, MaskRect);
  1024.         UpdateScreen(MaskRect);
  1025.         SetPort(tPort);
  1026.         SetGDevice(SaveGDevice);
  1027.         Info^.changes := true;
  1028.     end;
  1029.  
  1030.  
  1031.     procedure OffScreenToScreenRect (var r: rect);
  1032.         var
  1033.             p1, p2: point;
  1034.     begin
  1035.         with r do begin
  1036.                 p1.h := left;
  1037.                 p1.v := top;
  1038.                 p2.h := right;
  1039.                 p2.v := bottom;
  1040.                 OffScreenToScreen(p1);
  1041.                 OffScreenToScreen(p2);
  1042.                 Pt2Rect(p1, p2, r);
  1043.             end;
  1044.     end;
  1045.  
  1046.  
  1047.     procedure ScreenToOffscreen (var loc: point);
  1048.     begin
  1049.         with loc, Info^ do begin
  1050.                 h := SrcRect.left + trunc(h / magnification);
  1051.                 v := SrcRect.top + trunc(v / magnification);
  1052.             end;
  1053.     end;
  1054.  
  1055.  
  1056.     procedure OffscreenToScreen (var loc: point);
  1057.     begin
  1058.         with loc, Info^ do begin
  1059.                 h := trunc((h - SrcRect.left) * magnification);
  1060.                 v := trunc((v - SrcRect.top) * magnification);
  1061.             end;
  1062.     end;
  1063.  
  1064.  
  1065.  
  1066.     procedure UpdateScreen (MaskRect: rect);
  1067.  {Refreshes the portion of the screen defined by}
  1068.   {MaskRect, where MaskRect is defined in offscreen coordinates.}
  1069.         var
  1070.             tPort: GrafPtr;
  1071.             imag: integer;
  1072.             SaveGDevice: GDHandle;
  1073.     begin
  1074.         OffScreenToScreenRect(MaskRect);
  1075.         with Info^ do
  1076.             if info <> NoInfo then begin
  1077.                     SaveGDevice := GetGDevice;
  1078.                     SetGDevice(GetMainDevice);
  1079.                     getPort(tPort);
  1080.                     SetPort(wptr);
  1081.                     SetFColor(BlackIndex);
  1082.                     SetBColor(WhiteIndex);
  1083.                     imag := trunc(magnification);
  1084.                     InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
  1085.                     InsetRect(MaskRect, 0, 0);
  1086.                     RectRgn(MaskRgn, MaskRect);
  1087.                     CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
  1088.                     SetPort(tPort);
  1089.                     SetGDevice(SaveGDevice);
  1090.                 end;
  1091.     end;
  1092.  
  1093.  
  1094.     procedure RestoreRoi;
  1095.     begin
  1096.         with Info^ do begin
  1097.                 SetupUndo;
  1098.                 if RoiShowing then
  1099.                     UpdateScreen(RoiRect);
  1100.                 roiType := NoInfo^.roiType;
  1101.                 RoiRect := NoInfo^.RoiRect;
  1102.                 CopyRgn(NoInfo^.roiRgn, roiRgn);
  1103.                 LX1 := NoInfo^.LX1;
  1104.                 LY1 := NoInfo^.LY1;
  1105.                 LX2 := NoInfo^.LX2;
  1106.                 LY2 := NoInfo^.LY2;
  1107.                 LAngle := NoInfo^.LAngle;
  1108.                 RoiShowing := true;
  1109.                 measuring := false;
  1110.             end;
  1111.     end;
  1112.  
  1113.  
  1114.     procedure Undo;
  1115.         var
  1116.             SrcPtr: ptr;
  1117.             line: integer;
  1118.     begin
  1119.         if info^.PixMapSize <> CurrentUndoSize then
  1120.             exit(Undo);
  1121.         if UndoFromClip then begin
  1122.                 if info^.PixMapSize > ClipBufSize then
  1123.                     exit(Undo);
  1124.                 SrcPtr := ClipBuf;
  1125.             end
  1126.         else
  1127.             SrcPtr := UndoBuf;
  1128.         with info^ do
  1129.             BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
  1130.         if UndoFromClip and RestoreUndoBuf then
  1131.             with info^ do
  1132.                 BlockMove(SrcPtr, UndoBuf, PixMapSize);
  1133.         if RedoSelection then
  1134.             RestoreRoi;
  1135.     end;
  1136.  
  1137.  
  1138.     function MyGetPixel (h, v: LongInt): integer;
  1139.     begin
  1140.         MyGetPixel := BackgroundIndex;
  1141.         with Info^ do
  1142.             if h >= 0 then
  1143.                 if v >= 0 then
  1144.                     if h < PixelsPerLine then
  1145.                         if v < nlines then
  1146.                             MyGetPixel := ImageP(PicBaseAddr)^[v * BytesPerRow + h];
  1147.                {MyGetPixel := band(ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h)^, 255);}
  1148.     end;
  1149.  
  1150.  
  1151.     procedure PutPixel (h, v: LongInt; value: integer);
  1152.         var
  1153.             addr: Ptr;
  1154.     begin
  1155.         with Info^ do
  1156.             if h >= 0 then
  1157.                 if v >= 0 then
  1158.                     if h < PixelsPerLine then
  1159.                         if v < nlines then begin
  1160.                                 addr := Ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h);
  1161.                                 addr^ := value;
  1162.                             end;
  1163.     end;
  1164.  
  1165.  
  1166.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  1167.         var
  1168.             offset: LongInt;
  1169.             p: ptr;
  1170.             i: integer;
  1171.     begin
  1172.         if count > MaxLine then
  1173.             count := MaxLine;
  1174.         with Info^ do begin
  1175.                 if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
  1176.                         for i := 0 to count - 1 do
  1177.                             line[i] := MyGetPixel(h + i, v);
  1178.                         exit(GetLine);
  1179.                     end;
  1180.                 offset := v * BytesPerRow + h;
  1181.                 p := ptr(ord4(PicBaseAddr) + offset);
  1182.                 BlockMove(p, @line, count);
  1183.             end;
  1184.     end;
  1185.  
  1186.  
  1187.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  1188.         var
  1189.             col, pic, bpr: LongInt;
  1190.             i: integer;
  1191.     begin
  1192.         if count > MaxLine then
  1193.             count := MaxLine;
  1194.         with Info^ do begin
  1195.                 if (h < 0) or (v < 0) or (h >= PixelsPerLine) or ((v + count) > nlines) then begin
  1196.                         for i := 0 to count - 1 do
  1197.                             data[i] := MyGetPixel(h, v + i);
  1198.                         exit(GetColumn);
  1199.                     end;
  1200.                 col := Ord4(@data);
  1201.                 bpr := BytesPerRow;
  1202.                 pic := Ord4(PicBaseAddr) + v * bpr + h;
  1203.                 while count > 0 do begin
  1204.                         Ptr(col)^ := Ptr(pic)^;
  1205.                         pic := pic + bpr;
  1206.                         col := col + 1;
  1207.                         count := count - 1;
  1208.                     end;
  1209.             end;
  1210.     end;
  1211.  
  1212.  
  1213.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  1214.         var
  1215.             col, pic, bpr: LongInt;
  1216.     begin
  1217.         col := Ord4(@data);
  1218.         with Info^ do begin
  1219.                 bpr := BytesPerRow;
  1220.                 if count > 0 then
  1221.                     if hstart >= 0 then
  1222.                         if vstart >= 0 then
  1223.                             if hstart < PixelsPerLine then begin
  1224.                                     if vstart > nlines - count then
  1225.                                         count := nlines - vstart;
  1226.                                     pic := Ord4(PicBaseAddr) + vstart * bpr + hstart;
  1227.                                     while count > 0 do begin
  1228.                                             Ptr(pic)^ := Ptr(col)^;
  1229.                                             pic := pic + bpr;
  1230.                                             col := col + 1;
  1231.                                             count := count - 1;
  1232.                                         end;
  1233.                                 end;
  1234.             end;
  1235.     end;
  1236.  
  1237.  
  1238.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  1239.         var
  1240.             offset: LongInt;
  1241.             p: ptr;
  1242.     begin
  1243.         with Info^ do begin
  1244.                 if (h < 0) or (v < 0) or (v >= nlines) then
  1245.                     exit(PutLine);
  1246.                 if (h + count) > PixelsPerLine then
  1247.                     count := PixelsPerLine - h;
  1248.                 offset := v * BytesPerRow + h;
  1249.                 p := ptr(ord4(PicBaseAddr) + offset);
  1250.                 BlocKMove(@line, p, count);
  1251.             end;
  1252.     end;
  1253.  
  1254.  
  1255.     procedure Show1Value (rvalue, CalibratedValue: extended);
  1256.         var
  1257.             tPort: GrafPtr;
  1258.             hstart, vstart, ivalue: integer;
  1259.     begin
  1260.         hstart := InfoHStart;
  1261.         vstart := InfoVStart;
  1262.         GetPort(tPort);
  1263.         SetPort(InfoWindow);
  1264.         TextSize(9);
  1265.         TextFont(Monaco);
  1266.         TextMode(SrcCopy);
  1267.         MoveTo(xValueLoc, vstart);
  1268.         if CalibratedValue <> NoValue then begin
  1269.                 DrawReal(CalibratedValue, 5, 2);
  1270.                 DrawString(' (');
  1271.                 DrawReal(rvalue, 3, 0);
  1272.                 DrawString(')');
  1273.             end
  1274.         else
  1275.             DrawReal(rvalue, 6, 2);
  1276.         DrawString('    ');
  1277.         SetPort(tPort);
  1278.     end;
  1279.  
  1280.  
  1281.     procedure Show2PlotValues (x, y: extended);
  1282.         var
  1283.             tPort: GrafPtr;
  1284.             hstart, vstart, ivalue: integer;
  1285.     begin
  1286.         with info^ do begin
  1287.                 hstart := InfoHStart;
  1288.                 vstart := InfoVStart;
  1289.                 GetPort(tPort);
  1290.                 SetPort(InfoWindow);
  1291.                 TextSize(9);
  1292.                 TextFont(Monaco);
  1293.                 TextMode(SrcCopy);
  1294.                 MoveTo(xValueLoc, vstart);
  1295.                 DrawXDimension(round(x), 0);
  1296.                 MoveTo(yValueLoc, vstart + 10);
  1297.                 DrawReal(y, 6, 2);
  1298.                 SetPort(tPort);
  1299.             end;
  1300.     end;
  1301.  
  1302.  
  1303.     procedure Show2Values (current, total: LongInt);
  1304.         var
  1305.             tPort: GrafPtr;
  1306.             hstart, vstart, ivalue: integer;
  1307.     begin
  1308.         hstart := InfoHStart;
  1309.         vstart := InfoVStart;
  1310.         GetPort(tPort);
  1311.         SetPort(InfoWindow);
  1312.         TextSize(9);
  1313.         TextFont(Monaco);
  1314.         TextMode(SrcCopy);
  1315.         MoveTo(xValueLoc, vstart);
  1316.         DrawLong(current);
  1317.         DrawString('     ');
  1318.         MoveTo(yValueLoc, vstart + 10);
  1319.         DrawLong(total);
  1320.         DrawString('     ');
  1321.         SetPort(tPort);
  1322.     end;
  1323.  
  1324.  
  1325.     procedure DrawXDimension (x: extended; digits: integer);
  1326.     begin
  1327.         with info^ do begin
  1328.                 if SpatiallyCalibrated then begin
  1329.                         DrawReal(x / xScale, 5, 2);
  1330.                         DrawChar(xUnit[1]);
  1331.                         DrawChar(xUnit[2]);
  1332.                         DrawString(' (');
  1333.                         DrawReal(x, 3, digits);
  1334.                         DrawString(')')
  1335.                     end
  1336.                 else
  1337.                     DrawReal(x, 1, digits);
  1338.                 DrawString('      ');
  1339.             end;
  1340.     end;
  1341.  
  1342.  
  1343.     procedure DrawYDimension (y: extended; digits: integer);
  1344.     begin
  1345.         with info^ do begin
  1346.                 if SpatiallyCalibrated then begin
  1347.                         DrawReal(y / yScale, 5, 2);
  1348.                         DrawChar(xUnit[1]);
  1349.                         DrawChar(xUnit[2]);
  1350.                         DrawString(' (');
  1351.                         DrawReal(y, 3, digits);
  1352.                         DrawString(')')
  1353.                     end
  1354.                 else
  1355.                     DrawReal(y, 1, digits);
  1356.                 DrawString('      ');
  1357.             end;
  1358.     end;
  1359.  
  1360.  
  1361.     procedure DrawRGB (index: integer);
  1362.         var
  1363.             rStr, gStr, bStr: str255;
  1364.             TempRGB: rgbColor;
  1365.             i, entry: integer;
  1366.  
  1367.         procedure Convert (n: integer; var str: str255);
  1368.             var
  1369.                 i: integer;
  1370.         begin
  1371.             RealToString(n, 3, 0, str);
  1372.             for i := 1 to 3 do
  1373.                 if str[i] = ' ' then
  1374.                     str[i] := '0';
  1375.         end;
  1376.  
  1377.     begin
  1378.         if ScreenDepth = 8 then
  1379.             TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb
  1380.         else
  1381.             TempRGB := info^.cTable[index].rgb;
  1382.         with TempRGB do begin
  1383.                 Convert(band(bsr(red, 8), 255), rStr);
  1384.                 Convert(band(bsr(green, 8), 255), gStr);
  1385.                 Convert(band(bsr(blue, 8), 255), bStr);
  1386.                 DrawString(concat(rStr, ' ', gStr, ' ', bStr));
  1387.             end;
  1388.     end;
  1389.  
  1390.  
  1391.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  1392.         var
  1393.             tPort: GrafPtr;
  1394.             hstart, vstart: integer;
  1395.     begin
  1396.         with info^ do begin
  1397.                 hstart := InfoHStart;
  1398.                 vstart := InfoVStart;
  1399.                 GetPort(tPort);
  1400.                 SetPort(InfoWindow);
  1401.                 TextSize(9);
  1402.                 TextFont(Monaco);
  1403.                 TextMode(SrcCopy);
  1404.                 if hloc < 0 then
  1405.                     hloc := -hloc;
  1406.                 MoveTo(xValueLoc, vstart);
  1407.                 DrawXDimension(hloc, 0);
  1408.                 if InvertYCoordinates and (ivalue >= 0) then
  1409.                     vloc := PicRect.bottom - vloc - 1;
  1410.                 if vloc < 0 then
  1411.                     vloc := -vloc;
  1412.                 MoveTo(yValueLoc, vstart + 10);
  1413.                 DrawYDimension(vloc, 0);
  1414.                 DrawString('    ');
  1415.                 if ivalue >= 0 then begin
  1416.                         MoveTo(zValueLoc, vstart + 20);
  1417.                         if (fit <> uncalibrated) or (CurrentTool = PickerTool) then begin
  1418.                                 if CurrentTool = PickerTool then
  1419.                                     DrawRGB(ivalue)
  1420.                                 else
  1421.                                     DrawReal(cvalue[ivalue], 5, precision);
  1422.                                 DrawString(' (');
  1423.                                 DrawLong(ivalue);
  1424.                                 DrawString(')');
  1425.                             end
  1426.                         else
  1427.                             DrawLong(ivalue);
  1428.                     end;
  1429.                 DrawString('    ');
  1430.                 SetPort(tPort);
  1431.             end;
  1432.     end;
  1433.  
  1434.  
  1435.     procedure ShowDxDy (X, Y: extended);
  1436.         var
  1437.             tPort: GrafPtr;
  1438.             hstart, vstart, ivalue: integer;
  1439.     begin
  1440.         with info^ do begin
  1441.                 hstart := InfoHStart;
  1442.                 vstart := InfoVStart;
  1443.                 GetPort(tPort);
  1444.                 SetPort(InfoWindow);
  1445.                 TextSize(9);
  1446.                 TextFont(Monaco);
  1447.                 TextMode(SrcCopy);
  1448.                 MoveTo(xValueLoc, vstart);
  1449.                 DrawXDimension(x, 2);
  1450.                 MoveTo(yValueLoc, vstart + 10);
  1451.                 DrawYDimension(y, 2);
  1452.                 MoveTo(zValueLoc, vstart + 20);
  1453.                 if SpatiallyCalibrated then begin
  1454.                         DrawReal(sqrt(sqr(x / xScale) + sqr(y / yScale)), 5, 2);
  1455.                         DrawChar(xUnit[1]);
  1456.                         DrawChar(xUnit[2]);
  1457.                         DrawString(' (');
  1458.                         DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1459.                         DrawString(')')
  1460.                     end
  1461.                 else
  1462.                     DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1463.                 DrawString('    ');
  1464.                 SetPort(tPort);
  1465.             end;
  1466.     end;
  1467.  
  1468.  
  1469.     procedure PutChar (c: char);
  1470.     begin
  1471.         if TextBufSize < MaxTextBufSize then begin
  1472.                 TextBufSize := TextBufSize + 1;
  1473.                 TextBufP^[TextBufSize] := c;
  1474.                 if c = cr then begin
  1475.                         TextBufColumn := 0;
  1476.                         TextBufLineCount := TextBufLineCount + 1
  1477.                     end
  1478.                 else
  1479.                     TextBufColumn := TextBufColumn + 1;
  1480.             end;
  1481.     end;
  1482.  
  1483.  
  1484.     procedure PutTab;
  1485.     begin
  1486.         if not printing then
  1487.             PutChar(tab)
  1488.     end;
  1489.  
  1490.  
  1491.     procedure PutString (str: str255);
  1492.         var
  1493.             i: integer;
  1494.     begin
  1495.         for i := 1 to length(str) do begin
  1496.                 if TextBufSize < MaxTextBufSize then
  1497.                     TextBufSize := TextBufSize + 1;
  1498.                 TextBufP^[TextBufSize] := str[i];
  1499.                 TextBufColumn := TextBufColumn + 1;
  1500.             end;
  1501.     end;
  1502.  
  1503.  
  1504.     procedure PutFString (str: str255; FieldWidth: integer);
  1505.         var
  1506.             LeadingSpaces: integer;
  1507.     begin
  1508.         LeadingSpaces := FieldWidth - length(str);
  1509.         if LeadingSpaces > 0 then
  1510.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1511.         PutString(str);
  1512.     end;
  1513.  
  1514.  
  1515.     procedure PutReal (n: extended; width, fwidth: integer);
  1516.         var
  1517.             str: str255;
  1518.     begin
  1519.         RealToString(n, width, fwidth, str);
  1520.         PutString(str);
  1521.     end;
  1522.  
  1523.  
  1524.     procedure PutLong (n: LongInt; FieldWidth: integer);
  1525.         var
  1526.             str: str255;
  1527.             LeadingSpaces: integer;
  1528.     begin
  1529.         NumToString(n, str);
  1530.         LeadingSpaces := FieldWidth - length(str);
  1531.         if LeadingSpaces > 0 then
  1532.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1533.         PutString(str);
  1534.     end;
  1535.  
  1536.  
  1537.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  1538.         var
  1539.             i, column, fwidth: integer;
  1540.             m: MeasurementTypes;
  1541.  
  1542.         procedure PutSequenceNumber;
  1543.         begin
  1544.             PutLong(i, 4);
  1545.             PutChar('.');
  1546.             PutTab;
  1547.         end;
  1548.  
  1549.         procedure PutUnits;
  1550.         begin
  1551.             if info^.SpatiallyCalibrated then begin
  1552.                     PutString('  (');
  1553.                     DrawChar(info^.xUnit[1]);
  1554.                     DrawChar(info^.xUnit[2]);
  1555.                     PutString(')')
  1556.                 end
  1557.             else
  1558.                 PutString('(Pixels)');
  1559.             PutChar(cr);
  1560.             PutChar(cr);
  1561.         end;
  1562.  
  1563.         procedure PutTabDelimeter;
  1564.         begin
  1565.             Column := Column + 1;
  1566.             if Column <> nListColumns then
  1567.                 PutTab;
  1568.         end;
  1569.  
  1570.     begin
  1571.         if mCount < 1 then begin
  1572.                 TextBufSize := 0;
  1573.                 TextBufLineCount := 0;
  1574.                 exit(CopyResultsToBuffer);
  1575.             end;
  1576.         ShowWatch;
  1577.         Headings := Headings or OptionKeyWasDown;
  1578.         TextBufSize := 0;
  1579.         TextBufColumn := 0;
  1580.         TextBufLineCount := 0;
  1581.         nListColumns := 0;
  1582.         for m := AreaM to StdDevM do
  1583.             if m in Measurements then
  1584.                 nListColumns := nListColumns + 1;
  1585.         if (xyLocM in measurements) or (nPoints > 0) then
  1586.             nListColumns := nListColumns + 2;
  1587.         if ModeM in measurements then
  1588.             nListColumns := nListColumns + 1;
  1589.         if (LengthM in measurements) or (nLengths > 0) then
  1590.             nListColumns := nListColumns + 1;
  1591.         if MajorAxisM in measurements then
  1592.             nListColumns := nListColumns + 1;
  1593.         if MinorAxisM in measurements then
  1594.             nListColumns := nListColumns + 1;
  1595.         if (AngleM in measurements) or (nAngles > 0) then
  1596.             nListColumns := nListColumns + 1;
  1597.         if IntDenM in measurements then
  1598.             nListColumns := nListColumns + 2;
  1599.         if MinMaxM in measurements then
  1600.             nListColumns := nListColumns + 2;
  1601.         if User1M in measurements then
  1602.             nListColumns := nListColumns + 1;
  1603.         if User2M in measurements then
  1604.             nListColumns := nListColumns + 1;
  1605.         with info^ do begin
  1606.                 fwidth := FieldWidth;
  1607.                 if Headings and (FirstCount = 1) then begin
  1608.                         PutFString(' ', 5);
  1609.                         PutTabDelimeter;
  1610.                         if AreaM in measurements then begin
  1611.                                 PutFString('Area', fwidth);
  1612.                                 PutTabDelimeter;
  1613.                             end;
  1614.                         if MeanM in measurements then begin
  1615.                                 PutFString('Mean', fwidth);
  1616.                                 PutTabDelimeter;
  1617.                             end;
  1618.                         if StdDevM in measurements then begin
  1619.                                 PutFString('S.D.', fwidth);
  1620.                                 PutTabDelimeter;
  1621.                             end;
  1622.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1623.                                 PutFString('X', fwidth);
  1624.                                 PutTabDelimeter;
  1625.                                 PutFString('Y', fwidth);
  1626.                                 PutTabDelimeter;
  1627.                             end;
  1628.                         if ModeM in measurements then begin
  1629.                                 PutFString('Mode', fwidth);
  1630.                                 PutTabDelimeter;
  1631.                             end;
  1632.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1633.                                 PutFString('Length', fwidth);
  1634.                                 PutTabDelimeter;
  1635.                             end;
  1636.                         if MajorAxisM in measurements then begin
  1637.                                 PutFString(MajorLabel, fwidth);
  1638.                                 PutTabDelimeter;
  1639.                             end;
  1640.                         if MinorAxisM in measurements then begin
  1641.                                 PutFString(MinorLabel, fwidth);
  1642.                                 PutTabDelimeter;
  1643.                             end;
  1644.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1645.                                 PutFString('Angle', fwidth);
  1646.                                 PutTabDelimeter;
  1647.                             end;
  1648.                         if IntDenM in measurements then begin
  1649.                                 PutFString('Int.Den.', fwidth + 2);
  1650.                                 PutTabDelimeter;
  1651.                                 PutFString('Back.', fwidth);
  1652.                                 PutTabDelimeter;
  1653.                             end;
  1654.                         if MinMaxM in measurements then begin
  1655.                                 PutFString('Min', fwidth);
  1656.                                 PutTabDelimeter;
  1657.                                 PutFString('Max', fwidth);
  1658.                                 PutTabDelimeter;
  1659.                             end;
  1660.                         if User1M in measurements then begin
  1661.                                 PutFString(User1Label, fwidth);
  1662.                                 PutTabDelimeter;
  1663.                             end;
  1664.                         if User2M in measurements then begin
  1665.                                 PutFString(User2Label, fwidth);
  1666.                                 PutTabDelimeter;
  1667.                             end;
  1668.                         PutChar(cr);
  1669.                         PutChar(cr);
  1670.                     end;
  1671.                 for i := FirstCount to LastCount do begin
  1672.                         column := 0;
  1673.                         if Headings then
  1674.                             PutSequenceNumber;
  1675.                         if AreaM in measurements then begin
  1676.                                 PutReal(mArea^[i], fwidth, precision);
  1677.                                 PutTabDelimeter;
  1678.                             end;
  1679.                         if MeanM in measurements then begin
  1680.                                 PutReal(mean^[i], fwidth, precision);
  1681.                                 PutTabDelimeter;
  1682.                             end;
  1683.                         if StdDevM in measurements then begin
  1684.                                 PutReal(sd^[i], fwidth, precision);
  1685.                                 PutTabDelimeter;
  1686.                             end;
  1687.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1688.                                 PutReal(xcenter^[i], fwidth, precision);
  1689.                                 PutTab;
  1690.                                 PutReal(ycenter^[i], fwidth, precision);
  1691.                                 PutTabDelimeter;
  1692.                             end;
  1693.                         if ModeM in measurements then begin
  1694.                                 PutReal(mode^[i], fwidth, precision);
  1695.                                 PutTabDelimeter;
  1696.                             end;
  1697.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1698.                                 PutReal(plength^[i], fwidth, precision);
  1699.                                 PutTabDelimeter;
  1700.                             end;
  1701.                         if MajorAxisM in measurements then begin
  1702.                                 PutReal(MajorAxis^[i], fwidth, precision);
  1703.                                 PutTabDelimeter;
  1704.                             end;
  1705.                         if MinorAxisM in measurements then begin
  1706.                                 PutReal(MinorAxis^[i], fwidth, precision);
  1707.                                 PutTabDelimeter;
  1708.                             end;
  1709.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1710.                                 PutReal(orientation^[i], fwidth, precision);
  1711.                                 PutTabDelimeter;
  1712.                             end;
  1713.                         if IntDenM in measurements then begin
  1714.                                 PutReal(IntegratedDensity^[i], fwidth + 2, precision);
  1715.                                 PutTabDelimeter;
  1716.                                 PutReal(idBackground^[i], fwidth, precision);
  1717.                                 PutTabDelimeter;
  1718.                             end;
  1719.                         if MinMaxM in measurements then begin
  1720.                                 PutReal(mMin^[i], fwidth, precision);
  1721.                                 PutTabDelimeter;
  1722.                                 PutReal(mMax^[i], fwidth, precision);
  1723.                                 PutTabDelimeter;
  1724.                             end;
  1725.                         if User1M in measurements then begin
  1726.                                 PutReal(User1^[i], fwidth, precision);
  1727.                                 PutTabDelimeter;
  1728.                             end;
  1729.                         if User2M in measurements then begin
  1730.                                 PutReal(User2^[i], fwidth, precision);
  1731.                                 PutTabDelimeter;
  1732.                             end;
  1733.                         PutChar(cr);
  1734.                     end; {for}
  1735.             end; {with}
  1736.     end;
  1737.  
  1738.  
  1739.     procedure ShowWatch;
  1740.     begin
  1741.         SetCursor(watch);
  1742.     end;
  1743.  
  1744.  
  1745.     procedure ShowAnimatedWatch;
  1746.     begin
  1747.         SetCursor(AnimatedWatch[WatchIndex]);
  1748.         WatchIndex := WatchIndex + 1;
  1749.         if WatchIndex > 8 then
  1750.             WatchIndex := 1;
  1751.     end;
  1752.  
  1753.  
  1754.     procedure CaptureImage;
  1755.         var
  1756.             Timeout: LongInt;
  1757.             vdigErr: ComponentResult;
  1758.     begin
  1759.         case FrameGrabber of
  1760.             QuickCapture:  begin
  1761.                     ControlReg^ := BitAnd($80, 255); {Start frame capture}
  1762.                     while BitAnd(ControlReg^, $80) = $80 do
  1763.                         ;       {Wait for it to complete}
  1764.                 end;
  1765.             ScionLG3, ScionAG5, ScionVG5f:  begin
  1766.                     TimeOut := TickCount + 30;  {1/2sec. timeout}
  1767.                     ControlReg^ := $80; {Start frame capture}
  1768.                     while BitAnd(ControlReg^, $80) = $00 do begin    {Wait for it to complete}
  1769.                             if TickCount > TimeOut then begin
  1770.                                     ControlReg^ := $00;
  1771.                                     leave
  1772.                                 end;
  1773.                         end;
  1774.                     ControlReg^ := $00;
  1775.                 end;
  1776.             QTvdig:
  1777.                 if vdig <> nil then
  1778.                     vdigErr := VDGrabOneFrame(vdig);
  1779.         end; {case}
  1780.     end;
  1781.  
  1782.  
  1783.     procedure Paste;
  1784.         var
  1785.             srcPixMap: PixMapHandle;
  1786.             PCILivePaste: boolean;
  1787.     begin
  1788.         if info = NoInfo then begin
  1789.                 beep;
  1790.                 exit(Paste)
  1791.             end;
  1792.         with Info^ do begin
  1793.                 if not RoiShowing then
  1794.                     exit(Paste);
  1795.                 if PasteTransferMode = SrcCopy then begin
  1796.                         pmForeColor(BlackIndex);
  1797.                         pmBackColor(WhiteIndex);
  1798.                     end;
  1799.                 srcPixMap := ClipBufInfo^.osPort^.PortPixMap;
  1800.                 PCILivePaste := false;
  1801.                 if LivePasteMode then
  1802.                     if ((WhatsOnClip = CameraPic) or (WhatsOnClip = LivePic)) and (PictureType <> FrameGrabberType) then begin
  1803.                             if PCIFrameGrabber then
  1804.                                 with fgPort^.PortPixMap^^ do begin
  1805.                                     BaseAddr := ptr(fgSlotBase);
  1806.                                     PCILivePaste := true;
  1807.                                 end;
  1808.                             CaptureImage;
  1809.                             srcPixMap := fgPixMap;
  1810.                         end;
  1811.                 CopyBits(BitMapHandle(srcPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
  1812.                 if PCILivePaste then
  1813.                     with fgPort^.PortPixMap^^ do
  1814.                         BaseAddr := ptr(fgSuperSlotBase0);
  1815.                 if PasteTransferMode = SrcCopy then begin
  1816.                         pmForeColor(ForegroundIndex);
  1817.                         pmBackColor(BackgroundIndex);
  1818.                     end;
  1819.             end;
  1820.     end;
  1821.  
  1822.  
  1823.     procedure DoOperation (Operation: OpType);
  1824.         var
  1825.             tPort: GrafPtr;
  1826.             loc: point;
  1827.             width, height, SaveWidth: integer;
  1828.             tRect: rect;
  1829.             SaveGDevice: GDHandle;
  1830.     begin
  1831.         SaveGDevice := GetGDevice;
  1832.         GetPort(tPort);
  1833.         with Info^ do begin
  1834.                 changes := true;
  1835.                 SetGDevice(osGDevice);
  1836.                 SetPort(GrafPtr(osPort));
  1837.                 pmForeColor(ForegroundIndex);
  1838.                 pmBackColor(BackgroundIndex);
  1839.                 PenNormal;
  1840.                 case Operation of
  1841.                     InvertOp: 
  1842.                         InvertRgn(roiRgn);
  1843.                     PaintOp: 
  1844.                         PaintRgn(roiRgn);
  1845.                     FrameOp:  begin
  1846.                             if (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiTYpe = SegLineRoi) then
  1847.                                 PenSize(1, 1)
  1848.                             else
  1849.                                 PenSize(LineWidth, LineWidth);
  1850.                             FrameRgn(roiRgn);
  1851.                         end;
  1852.                     EraseOp:begin 
  1853.                             EraseRgn(roiRgn);
  1854.                         end;
  1855.                     PasteOp: 
  1856.                         Paste;
  1857.                     otherwise
  1858.                 end;
  1859.                 if not RoiShowing then begin
  1860.                     UpdateScreen(RoiRect);
  1861.                     end;
  1862.                 if PixMapSize > UndoBufSize then
  1863.                     OpPending := false;
  1864.             end;
  1865.         SetPort(tPort);
  1866.         SetGDevice(SaveGDevice);
  1867.     end;
  1868.  
  1869.  
  1870.     procedure SaveRoi;
  1871.     begin
  1872.         with info^ do
  1873.             if RoiType <> noRoi then begin
  1874.                     NoInfo^.roiType := roiType;
  1875.                     NoInfo^.RoiRect := RoiRect;
  1876.                     CopyRgn(roiRgn, NoInfo^.roiRgn);
  1877.                     NoInfo^.LX1 := LX1;
  1878.                     NoInfo^.LY1 := LY1;
  1879.                     NoInfo^.LX2 := LX2;
  1880.                     NoInfo^.LY2 := LY2;
  1881.                     NoInfo^.LAngle := LAngle;
  1882.                 end;
  1883.     end;
  1884.  
  1885.  
  1886.     procedure KillRoi;
  1887.         var
  1888.             trect: rect;
  1889.     begin
  1890.         with info^ do begin
  1891.                 if RoiShowing then begin
  1892.                         if OpPending then begin
  1893.                                 OpPending := false;
  1894.                                 DoOperation(CurrentOp);
  1895.                             end;
  1896.                         SaveRoi;
  1897.                         RoiShowing := false;
  1898.                         trect := RoiRect;
  1899.                         if RoiType = LineRoi then
  1900.                             InsetRect(trect, -RoiHandleSize, -RoiHandleSize);
  1901.                         UpdateScreen(trect);
  1902.                     end;
  1903.                 RoiType := NoRoi;
  1904.                 RoiUpdateTime := 0;
  1905.             end;
  1906.     end;
  1907.  
  1908.  
  1909.     procedure ShowRoi;
  1910.     begin
  1911.         with info^ do
  1912.             if RoiType <> NoRoi then begin
  1913.                     SetupUndo;
  1914.                     RoiShowing := true;
  1915.                 end;
  1916.     end;
  1917.  
  1918.  
  1919.     procedure SetupUndo;
  1920.         var
  1921.             line: integer;
  1922.     begin
  1923.         WhatToUndo := NothingToUndo;
  1924.         if info = NoInfo then begin
  1925.                 CurrentUndoSize := 0;
  1926.                 exit(SetupUndo)
  1927.             end;
  1928.         with info^ do begin
  1929.                 if PixMapSize > UndoBufSize then begin
  1930.                         CurrentUndoSize := 0;
  1931.                         exit(SetupUndo)
  1932.                     end;
  1933.                 if OpPending then begin
  1934.                         DoOperation(CurrentOp);
  1935.                         OpPending := false;
  1936.                     end;
  1937.                 CurrentUndoSize := PixMapSize;
  1938.                 BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
  1939.                 UndoFromClip := false;
  1940.                 RedoSelection := false;
  1941.             end;
  1942.     end;
  1943.  
  1944.  
  1945.     procedure SetupUndoFromClip;
  1946.         var
  1947.             line: integer;
  1948.     begin
  1949.         WhatToUndo := NothingToUndo;
  1950.         if info = NoInfo then begin
  1951.                 CurrentUndoSize := 0;
  1952.                 exit(SetupUndoFromClip)
  1953.             end;
  1954.         with info^ do begin
  1955.                 if PixMapSize > ClipBufSize then begin
  1956.                         CurrentUndoSize := 0;
  1957.                         exit(SetupUndoFromClip)
  1958.                     end;
  1959.                 if OpPending then begin
  1960.                         DoOperation(CurrentOp);
  1961.                         OpPending := false;
  1962.                     end;
  1963.                 CurrentUndoSize := PixMapSize;
  1964.                 BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
  1965.             end;
  1966.         WhatsOnClip := NothingOnClip;
  1967.         UndofromClip := true;
  1968.         RedoSelection := false;
  1969.     end;
  1970.  
  1971.  
  1972.     function NoSelection: boolean;
  1973.     begin
  1974.         if Info = NoInfo then begin
  1975.                 beep;
  1976.                 NoSelection := true;
  1977.                 exit(NoSelection);
  1978.             end;
  1979.         if not Info^.RoiShowing then begin
  1980.                 PutError('Please use a selection tool to make a selection or use the Select All command.');
  1981.                 AbortMacro;
  1982.             end;
  1983.         NoSelection := not Info^.RoiShowing;
  1984.     end;
  1985.  
  1986.  
  1987.     function NotRectangular;{:boolean}
  1988.     begin
  1989.         with info^ do
  1990.             if RoiShowing and (RoiType <> RectRoi) then begin
  1991.                     PutError('This operation requires a rectangular selection.');
  1992.                     NotRectangular := true;
  1993.                     AbortMacro;
  1994.                 end
  1995.             else
  1996.                 NotRectangular := false;
  1997.     end;
  1998.  
  1999.  
  2000.     procedure GetLoi (var x1, y1, x2, y2: extended);
  2001.     begin
  2002.         with info^, info^.RoiRect do begin
  2003.                 x1 := left + LX1;
  2004.                 y1 := top + LY1;
  2005.                 x2 := left + LX2;
  2006.                 y2 := top + LY2;
  2007.             end;
  2008.     end;
  2009.  
  2010.  
  2011.     function NotInBounds: boolean;
  2012.         var
  2013.             x1, y1, x2, y2: extended;
  2014.     begin
  2015.         NotInBounds := false;
  2016.         with info^, info^.RoiRect do
  2017.             if RoiShowing then begin
  2018.                     if RoiType = LineRoi then begin
  2019.                             GetLoi(x1, y1, x2, y2);
  2020.                             if (x1 >= 0.0) and (y1 >= 0.0) and (x2 <= right) and (y2 <= bottom) then
  2021.                                 exit(NotInBounds);
  2022.                         end;
  2023.                     if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
  2024.                             PutError('This operation requires the selection to be entirely within the image.');
  2025.                             NotInBounds := true;
  2026.                             AbortMacro;
  2027.                         end;
  2028.                 end;
  2029.     end;
  2030.  
  2031.  
  2032.     function NoUndo: boolean;
  2033.         var
  2034.             ImageTooLarge: boolean;
  2035.     begin
  2036.         with info^ do
  2037.             ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
  2038.         if ImageTooLarge then
  2039.             PutError('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
  2040.         NoUndo := ImageTooLarge;
  2041.     end;
  2042.  
  2043.  
  2044.  
  2045.     procedure PutMemoryAlert;
  2046.     begin
  2047.         if not OpeningFinderFiles then
  2048.             PutError('There is not enough free memory to open this image. Try closing some windows or allocating more memory to NIH Image.');
  2049.         AbortMacro;
  2050.     end;
  2051.  
  2052.  
  2053.     procedure CompactMemory;
  2054.         var
  2055.             size: LongInt;
  2056.             TempInfo: InfoPtr;
  2057.             i: integer;
  2058.     begin
  2059.         for i := 1 to nPics do begin
  2060.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2061.                 hunlock(TempInfo^.PicBaseHandle)
  2062.             end;
  2063.         size := MaxSize;
  2064.         size := MaxMem(size);
  2065.         for i := 1 to nPics do begin
  2066.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2067.                 with TempInfo^ do begin
  2068.                         hlock(PicBaseHandle);
  2069.                         {$ifc PowerPC}
  2070.                         PicBaseAddr := PicBaseHandle^;
  2071.                         {$elsec}
  2072.                         PicBaseAddr := StripAddress(PicBaseHandle^);
  2073.                         {$endc}
  2074.                         osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  2075.                     end;
  2076.             end;
  2077.     end;
  2078.  
  2079.  
  2080.  
  2081.     function GetBigHandle (NeededSize: LongInt): handle;
  2082. {Allocates a handle and guarantees MinFree contiguous free bytes after allocation . }
  2083. {Does NOT arrange for the new handle to be unlocked during CompactMemory. }
  2084. {GetBigHandle returns nil if CompactMemory fails to obtain enough contiguous free space . }
  2085.         var
  2086.             h: handle;
  2087.             FreeMem: LongInt;
  2088.     begin
  2089.         h := NewHandle(NeededSize);
  2090.         FreeMem := MaxBlock;
  2091.         if (h = nil) or (FreeMem < MinFree) then begin
  2092.                 if h <> nil then
  2093.                     DisposeHandle(h);
  2094.                 if FreeMem > 0 then {Why does FreeMem get set to 0 sometimes and MaxMem}
  2095.                     CompactMemory       {crash, but only when using the Modern Memory Manager?}
  2096.                 else
  2097.                     beep;
  2098.                 h := NewHandle(NeededSize);
  2099.                 FreeMem := MaxBlock;
  2100.             end;
  2101.         if (h = nil) or (FreeMem < MinFree) then begin
  2102.                 if h <> nil then
  2103.                     DisposeHandle(h);
  2104.                 h := nil;
  2105.             end;
  2106.         GetBigHandle := h;
  2107.     end;
  2108.  
  2109.  
  2110.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  2111. {Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
  2112. {A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
  2113.         var
  2114.             h: handle;
  2115.             NeededSize: LongInt;
  2116.     begin
  2117.         with info^ do begin
  2118.                 if odd(PixelsPerLine) then
  2119.                     BytesPerRow := PixelsPerLine + 1
  2120.                 else
  2121.                     BytesPerRow := PixelsPerLine;
  2122.                 PixMapSize := nlines * BytesPerRow;
  2123.                 ImageSize := nlines * PixelsPerLine;
  2124.                 NeededSize := PixMapSize;
  2125.             end;
  2126.         h := GetBigHandle(NeededSize);
  2127.         if h = nil then begin
  2128.                 DisposePtr(pointer(Info));
  2129.                 PutMemoryAlert;
  2130.                 Info := SaveInfo;
  2131.                 GetImageMemory := nil;
  2132.                 exit(GetImageMemory);
  2133.             end;
  2134.         with info^ do begin
  2135.                 PicBaseHandle := h;
  2136.                 hlock(PicBaseHandle);
  2137.                 {$ifc PowerPC}
  2138.                 GetImageMemory := PicBaseHandle^;
  2139.                 {$elsec}
  2140.                 GetImageMemory := StripAddress(PicBaseHandle^);
  2141.                 {$endc}
  2142.             end;
  2143.     end;
  2144.  
  2145.  
  2146.     procedure UpdateAnalysisMenu;
  2147.         var
  2148.             ShowItems: boolean;
  2149.             i: integer;
  2150.     begin
  2151.         ShowItems := Info <> NoInfo;
  2152.         SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
  2153.         SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
  2154.         SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
  2155.         SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
  2156.         SetMenuItem(AnalyzemenuH, PlotSurfaceItem, ShowItems);
  2157.         SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
  2158.         SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
  2159.         SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
  2160.         SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
  2161.         SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
  2162.         SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
  2163.     end;
  2164.  
  2165.  
  2166.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  2167.         var
  2168.             str, SizeStr: str255;
  2169.     begin
  2170.         if nPics < MaxPics then begin
  2171.                 nPics := nPics + 1;
  2172.                 PicWindow[nPics] := wptr;
  2173.                 NumToString((size + 511) div 1024, SizeStr);
  2174.                 str := concat(fname, '  ', SizeStr, 'K');
  2175.                 AppendMenu(WindowsMenuH, ' ');
  2176.                 SetMenuItemText(WindowsMenuH, nPics + WindowsMenuItems + nTextWindows, str);
  2177.                 InsertMenu(WindowsMenuH, 0);
  2178.             end;
  2179.     end;
  2180.  
  2181.  
  2182.     procedure InvertGrayLevels;
  2183.     begin
  2184.         with info^ do begin
  2185.                 fit := StraightLine;
  2186.                 nCoefficients := 2;
  2187.                 Coefficient[1] := 255.0;
  2188.                 Coefficient[2] := -1.0;
  2189.                 ZeroClip := false;
  2190.                 UnitOfMeasure := '';
  2191.                 nKnownValues := 0;
  2192.                 NoInfo^.fit := StraightLine;
  2193.                 NoInfo^.nCoefficients := 2;
  2194.                 NoInfo^.Coefficient := Coefficient;
  2195.                 NoInfo^.ZeroClip := false;
  2196.                 NoInfo^.UnitOfMeasure := '';
  2197.                 GenerateValues;
  2198.                 UpdateTitleBar;
  2199.             end;
  2200.     end;
  2201.  
  2202.  
  2203.     function GetAngle (dx, dy: extended):extended;
  2204.         var
  2205.             angle:extended;
  2206.             quadrant: (q1, q2orq3, q4);
  2207.     begin
  2208.         if dx <> 0.0 then
  2209.             angle := arctan(dy / dx)
  2210.         else begin
  2211.                 if dy >= 0.0 then
  2212.                     angle := pi / 2.0
  2213.                 else
  2214.                     angle := -pi / 2.0
  2215.             end;
  2216.         angle := (180.0 / pi) * angle;
  2217.         if (dx >= 0.0) and (dy >= 0.0) then
  2218.             quadrant := q1
  2219.         else if dx < 0.0 then
  2220.             quadrant := q2orq3
  2221.         else
  2222.             quadrant := q4;
  2223.         case quadrant of
  2224.             q1: 
  2225.                 ;
  2226.             q2orq3: 
  2227.                 angle := angle + 180.0;
  2228.             q4: 
  2229.                 angle := angle + 360.0;
  2230.         end;
  2231.         GetAngle:=angle; {ppc-bug}
  2232.     end;
  2233.  
  2234.  
  2235.     procedure MakeRegion;
  2236.         var
  2237.             deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
  2238.             dx, dy, pAngle: extended;
  2239.             add: boolean;
  2240.             tPort: GrafPtr;
  2241.     begin
  2242.         with info^ do begin
  2243.                 GetPort(tPort);
  2244.                 SetPort(wptr);
  2245.                 OpenRgn;
  2246.                 case RoiType of
  2247.                     LineRoi:  begin
  2248.                             LAngle:=GetAngle(LX2 - LX1, LY1 - LY2);
  2249.                             x1 := round(LX1);
  2250.                             y1 := round(LY1);
  2251.                             x2 := round(LX2);
  2252.                             y2 := round(LY2);
  2253.                             if (x1 = x2) and (y1 = y2) then begin
  2254.                                     MoveTo(x1, y1);
  2255.                                     LineTo(x1 + 1, y1);
  2256.                                     LineTo(x1 + 1, y1 + 1);
  2257.                                     LineTo(x1, y1 + 1);
  2258.                                     LineTo(x1, y1);
  2259.                                 end
  2260.                             else begin
  2261.                                     add := (LAngle > 90.0) and (LAngle <= 270.0);
  2262.                                     pAngle := (LAngle / 180.0) * pi;
  2263.                                     if add then
  2264.                                         pAngle := pAngle + pi / 2.0
  2265.                                     else
  2266.                                         pAngle := pAngle - pi / 2.0;
  2267.                                     dx := cos(pAngle) * LineWidth;
  2268.                                     dy := -sin(pAngle) * LineWidth;
  2269.                                     MoveTo(x1, y1);
  2270.                                     LineTo(round(x1 + dx), round(y1 + dy));
  2271.                                     LineTo(round(x2 + dx), round(y2 + dy));
  2272.                                     LineTo(x2, y2);
  2273.                                     LineTo(x1, y1);
  2274.                                 end;
  2275.                         end;
  2276.                     OvalRoi: 
  2277.                         FrameOval(RoiRect);
  2278.                     RectRoi: 
  2279.                         FrameRect(RoiRect);
  2280.                     otherwise
  2281.                 end;
  2282.                 CloseRgn(roiRgn);
  2283.                 if RoiType = LineRoi then begin
  2284.                         RoiRect := roiRgn^^.rgnBBox;
  2285.                         with RoiRect do begin
  2286.                                 LX1 := LX1 - left;
  2287.                                 LY1 := LY1 - top;
  2288.                                 LX2 := LX2 - left;
  2289.                                 LY2 := LY2 - top;
  2290.                             end;
  2291.                     end;
  2292.             end;
  2293.         SetPort(tPort);
  2294.     end;
  2295.  
  2296.  
  2297.     procedure SelectAll (visible: boolean);
  2298.         var
  2299.             loc: point;
  2300.             tPort: GrafPtr;
  2301.     begin
  2302.         if info <> NoInfo then
  2303.             with Info^ do begin
  2304.                     KillRoi;
  2305.                     RoiType := RectRoi;
  2306.                     RoiRect := PicRect;
  2307.                     MakeRegion;
  2308.                     if visible then begin
  2309.                             SetupUndo;
  2310.                             RoiShowing := true;
  2311.                             if (magnification > 1.0) and not ScaleToFitWindow then
  2312.                                 Unzoom;
  2313.                             if not macro then begin
  2314.                                     PreviousTool := CurrentTool;
  2315.                                     CurrentTool := SelectionTool;
  2316.                                     isSelectionTool := true;
  2317.                                     GetPort(tPort);
  2318.                                     SetPort(ToolWindow);
  2319.                                     EraseRect(ToolRect[PreviousTool]);
  2320.                                     EraseRect(ToolRect[CurrentTool]);
  2321.                                     InvalRect(ToolRect[PreviousTool]);
  2322.                                     InvalRect(ToolRect[CurrentTool]);
  2323.                                     SetPort(tPort);
  2324.                                 end;
  2325.                         end;
  2326.                     IsInsertionPoint := false;
  2327.                     measuring := false;
  2328.                 end; {with}
  2329.     end;
  2330.  
  2331.  
  2332.     procedure KillOperation;
  2333.     begin
  2334.         if OpPending then
  2335.             with info^ do
  2336.                 if info <> NoInfo then begin
  2337.                         DoOperation(CurrentOp);
  2338.                         RoiShowing := false;
  2339.                         UpdateScreen(RoiRect);
  2340.                         OpPending := false;
  2341.                     end;
  2342.     end;
  2343.  
  2344.  
  2345.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  2346.     begin
  2347.         NewInfo := OldInfo;
  2348.         with NewInfo do begin
  2349.                 PicBaseAddr := nil;
  2350.                 PicBaseHandle := nil;
  2351.                 osPort := nil;
  2352.                 roiRgn := nil;
  2353.                 RoiType := NoRoi;
  2354.                 RoiShowing := false;
  2355.                 Magnification := 1.0;
  2356.                 vref := 0;
  2357.                 wPtr := nil;
  2358.                 ScaleToFitWindow := false;
  2359.                 WindowState := NormalWindow;
  2360.                 StackInfo := nil;
  2361.                 fileVersion := 0;
  2362.                 PictureType := NewPicture;
  2363.                 DataType := EightBits;
  2364.                 changes := false;
  2365.                 DataH := nil;
  2366.                 LittleEndian := false;
  2367.                 InvertedImage := false;
  2368.                 if OldInfo.DataH <> nil then {real image}
  2369.                     fit := uncalibrated;
  2370.                 if (not SpatiallyCalibrated and (fit=uncalibrated)) or (nPics=0) then begin
  2371.                     if NoInfo^.SpatiallyCalibrated then begin
  2372.                         SpatiallyCalibrated:=true;
  2373.                         xUnit := NoInfo^.xUnit;
  2374.                         xScale := NoInfo^.xScale;
  2375.                         PixelAspectRatio := NoInfo^.PixelAspectRatio;
  2376.                         yScale := xScale / PixelAspectRatio;
  2377.                     end;
  2378.                     if NoInfo^.fit<>uncalibrated then begin
  2379.                         fit := NoInfo^.fit;
  2380.                         nCoefficients := NoInfo^.nCoefficients;
  2381.                         Coefficient := NoInfo^.Coefficient;
  2382.                         ZeroClip := NoInfo^.ZeroClip;
  2383.                         UnitOfMeasure := NoInfo^.UnitOfMeasure;
  2384.                     end;
  2385.                 end;
  2386.             end;
  2387.     end;
  2388.  
  2389.  
  2390.     function NewPicWindow (name: str255; width, height: integer): boolean;
  2391.         var
  2392.             iptr, p: ptr;
  2393.             lptr: ^LongInt;
  2394.             SaveInfo: InfoPtr;
  2395.             NeededSize: LongInt;
  2396.             trect: rect;
  2397.     begin
  2398.         NewPicWindow := false;
  2399.         PicLeft := PicLeftBase;
  2400.         PicTop := PicTopBase;
  2401.         if (info <> noInfo) then begin
  2402.                 with info^ do begin
  2403.                         GetWindowRect(wptr, trect);
  2404.                         if trect.left = PicLeftBase then
  2405.                             if pos('Camera', name) = 0 then begin
  2406.                                     PicLeft := trect.left + hPicOffset;
  2407.                                     PicTop := trect.top + vPicOffset;
  2408.                                 end;
  2409.                     end;
  2410.             end;
  2411.         if nPics = MaxPics then
  2412.             exit(NewPicWindow);
  2413.         KillOperation;
  2414.         DisableDensitySlice;
  2415.         SaveInfo := Info;
  2416.         iptr := NewPtr(SizeOf(PicInfo));
  2417.         if iptr = nil then begin
  2418.                 PutMemoryAlert;
  2419.                 AbortMacro;
  2420.                 exit(NewPicWindow);
  2421.             end;
  2422.         Info := pointer(iptr);
  2423.         CloneInfo(SaveInfo^, Info^);
  2424.         with Info^ do begin
  2425.                 nlines := height;
  2426.                 PixelsPerLine := width;
  2427.                 p := GetImageMemory(SaveInfo);
  2428.                 if p = nil then
  2429.                     exit(NewPicWindow);
  2430.                 PicBaseAddr := p;
  2431.                 MakeNewWindow(name);
  2432.                 SelectAll(false);
  2433.                 if not OptionKeyDown then DoOperation(EraseOp);
  2434.                 KillRoi;
  2435.                 Changes := false;
  2436.                 BinaryPic := false;
  2437.             end;
  2438.         UpdateTitleBar;
  2439.         NewPicWindow := true;
  2440.     end;
  2441.  
  2442.  
  2443.     procedure EraseScreen;
  2444.     begin
  2445.         SetPort(GrafPtr(CScreenPort));
  2446.         with CScreenPort^ do begin
  2447.                 HideCursor;
  2448.                 pmBackColor(BackgroundIndex);
  2449.                 EraseRect(portPixMap^^.Bounds);
  2450.                 pmBackColor(WhiteIndex);
  2451.             end;
  2452.     end;
  2453.  
  2454.  
  2455.     procedure RestoreScreen;
  2456.         var
  2457.             GrayRgn: RgnHandle;
  2458.             rptr: rhptr;
  2459.             wp: ^WindowPtr;
  2460.     begin
  2461.         rptr := rhptr(GrayRgnGlobal);
  2462.         GrayRgn := rptr^;
  2463.         wp := pointer(GhostWindow);
  2464.         wp^ := WindowPtr(nil);
  2465.         PaintBehind(WindowRef(FrontWindow), GrayRgn);
  2466.         wp^ := PasteControl;
  2467.         DrawMenuBar;
  2468.         InitCursor;
  2469.     end;
  2470.  
  2471.  
  2472.     procedure UpdateTitleBar;
  2473.     {Updates the window title bar to show the current magnification or the current frame within a stack.}
  2474.         var
  2475.             str, str2, str3: str255;
  2476.             SaveGDevice: GDHandle;
  2477.     begin
  2478.         if info = NoInfo then
  2479.             exit(UpdateTitleBar);
  2480.         with info^ do begin
  2481.                 str := title;
  2482.                 if info^.DataH <> nil then
  2483.                     str := concat('<<',str, '>>');
  2484.                 if SpatiallyCalibrated then
  2485.                     str := concat(str, chr($13)); {Black Diamond}
  2486.                 if fit <> uncalibrated then
  2487.                     str := concat(str, '◊');
  2488.                 if StackInfo <> nil then
  2489.                     with StackInfo^ do
  2490.                         if (nSlices = 3) and (StackType = rgbStack) then begin
  2491.                                 case CurrentSlice of
  2492.                                     1: str2 := 'Red';
  2493.                                     2: str2 := 'Green';
  2494.                                     3: str2 := 'Blue';
  2495.                                 end;
  2496.                                 str := concat(str, ' (', str2, ')');
  2497.                         end else begin
  2498.                                 NumToString(CurrentSlice, str2);
  2499.                                 NumToString(nSlices, str3);
  2500.                                 str := concat(str, ' (', str2, '/', str3, ')');
  2501.                         end
  2502.                 else if (magnification <> 1.0) or ScaleToFitWindow then begin
  2503.                         if ScaleToFitWindow then begin
  2504.                                 RealToString(magnification, 1, 2, str2);
  2505.                                 str := concat(str, ' (', str2, ')');
  2506.                             end
  2507.                         else begin
  2508.                                 RealToString(magnification, 1, 0, str2);
  2509.                                 str := concat(str, ' (', str2, ':1)');
  2510.                             end;
  2511.                     end;
  2512.                 if Digitizing then begin
  2513.                         if ExternalTrigger then
  2514.                             str := concat(str, ' (Waiting for Trigger)')
  2515.                         else
  2516.                             str := concat(str, ' (Live)');
  2517.                     end;
  2518.                 if wptr <> nil then begin
  2519.                     SaveGDevice := GetGDevice;
  2520.                     SetGDevice(GetMainDevice);
  2521.                     SetWTitle(wptr, str);
  2522.                     SetGDevice(SaveGDevice);
  2523.                     end;
  2524.             end; {with}
  2525.     end;
  2526.  
  2527.  
  2528.     procedure ScaleToFit;
  2529.         var
  2530.             trect: rect;
  2531.     begin
  2532.         if digitizing then
  2533.             exit(ScaleToFit);
  2534.         if info <> NoInfo then
  2535.             with info^ do begin
  2536.                     ScaleToFitWindow := not ScaleToFitWindow;
  2537.                     KillRoi;
  2538.                     if ScaleToFitWindow then begin
  2539.                             savewrect := wrect;
  2540.                             SaveSrcRect := SrcRect;
  2541.                             SaveMagnification := magnification;
  2542.                             GetWindowRect(wptr, trect);
  2543.                             savehloc := trect.left;
  2544.                             savevloc := trect.top;
  2545.                             wrect := wptr^.PortRect;
  2546.                             SrcRect := PicRect;
  2547.                             ScaleImageWindow(wrect);
  2548.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2549.                         end
  2550.                     else begin
  2551.                             if WindowState = TiledBigScaled then begin
  2552.                                     wrect := initwrect;
  2553.                                     SrcRect := wrect;
  2554.                                     magnification := 1.0;
  2555.                                     WindowState := NormalWindow;
  2556.                                 end
  2557.                             else begin
  2558.                                     wrect := savewrect;
  2559.                                     SrcRect := SaveSrcRect;
  2560.                                     magnification := SaveMagnification;
  2561.                                 end;
  2562.                             HideWindow(wptr);
  2563.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2564.                             MoveWindow(wptr, savehloc, savevloc, true);
  2565.                             ShowWindow(wptr);
  2566.                             UpdateTitleBar;
  2567.                         end;
  2568.                     SetPort(wptr);
  2569.                     InvalRect(wrect);
  2570.                     WindowState := NormalWindow;
  2571.                 end;
  2572.     end;
  2573.  
  2574.  
  2575.     procedure DrawMyGrowIcon (w: WindowPtr);
  2576.         var
  2577.             tPort: GrafPtr;
  2578.             tRect: rect;
  2579.     begin
  2580.         GetPort(tPort);
  2581.         SetPort(w);
  2582.         PenNormal;
  2583.         with w^.PortRect do begin
  2584.                 SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
  2585.                 FrameRect(tRect);
  2586.                 MoveTo(right - 6, bottom - 10);
  2587.                 LineTo(right - 2, bottom - 10);
  2588.                 LineTo(right - 2, bottom - 2);
  2589.                 LineTo(right - 10, bottom - 2);
  2590.                 LineTo(right - 10, bottom - 6);
  2591.             end;
  2592.         SetPort(tPort);
  2593.     end;
  2594.  
  2595.  
  2596.     procedure Unzoom;
  2597.     begin
  2598.         if Info <> NoInfo then
  2599.             with Info^ do begin
  2600.                     ScaleToFitWindow:=false;
  2601.                     wrect := initwrect;
  2602.                     SrcRect := wrect;
  2603.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2604.                     LoadLUT(info^.cTable);
  2605.                     UpdatePicWindow;
  2606.                     magnification := 1.0;
  2607.                     DrawMyGrowIcon(wptr);
  2608.                     UpdateTitleBar;
  2609.                     WindowState:=NormalWindow;
  2610.                     if WhatToUndo = UndoZoom then
  2611.                         WhatToUndo := NothingToUndo;
  2612.                     ShowRoi;
  2613.                 end;
  2614.     end;
  2615.  
  2616.  
  2617.     procedure DrawBString(str:string);
  2618.     var
  2619.         s:style;
  2620.     begin
  2621.         TextFace([bold]);
  2622.         DrawString(str);
  2623.         s:=[];  {ppc-bug}
  2624.         TextFace(s);
  2625.     end;
  2626.  
  2627.  
  2628.     function long2str (num: LongInt): str255;
  2629.         var
  2630.             str: str255;
  2631.     begin
  2632.         NumToString(num, str);
  2633.         long2str := str;
  2634.     end;
  2635.  
  2636.  
  2637.     procedure PutWarning;
  2638.     begin
  2639.         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.'));
  2640.     end;
  2641.  
  2642.  
  2643.     procedure SetupRoiRect;
  2644. {Copies the current image to Undo buffer so it can be used for drawing}
  2645. {the "marching ants". The copy of the previous image in the Clipboard buffer}
  2646. { buffer will be used for Undo.}
  2647.         var
  2648.             SaveWhatToUndo: WhatToUndoType;
  2649.     begin
  2650.         SaveWhatToUndo := WhatToUndo;
  2651.         SetupUndo;
  2652.         UndoFromClip := true;
  2653.         info^.RoiShowing := true;
  2654.         WhatToUndo := SaveWhatToUndo;
  2655.     end;
  2656.  
  2657.  
  2658.     procedure SetForegroundColor (color: integer);
  2659.         var
  2660.             tPort: GrafPtr;
  2661.             SaveGDevice: GDHandle;
  2662.     begin
  2663.         if (color >= 0) and (color <= 255) then
  2664.             with info^ do begin
  2665.                     ForegroundIndex := color;
  2666.                     GetPort(tPort);
  2667.                     SetPort(ToolWindow);
  2668.                     InvalRect(ToolRect[brush]);
  2669.                     SaveGDevice := GetGDevice;
  2670.                     SetGDevice(osGDevice);
  2671.                     if osPort <> nil then begin
  2672.                             SetPort(GrafPtr(osPort));
  2673.                             pmForeColor(ForegroundIndex);
  2674.                         end;
  2675.                     SetPort(tPort);
  2676.                     SetGDevice(SaveGDevice);
  2677.                     if isInsertionPoint then
  2678.                         DisplayText(true);
  2679.                 end;
  2680.     end;
  2681.  
  2682.  
  2683.     procedure SetBackgroundColor (color: integer);
  2684.         var
  2685.             tPort: GrafPtr;
  2686.             SaveGDevice: GDHandle;
  2687.     begin
  2688.         if (color >= 0) and (color <= 255) then
  2689.             with info^ do begin
  2690.                     BackgroundIndex := color;
  2691.                     GetPort(tPort);
  2692.                     SetPort(ToolWindow);
  2693.                     InvalRect(ToolRect[eraser]);
  2694.                     SaveGDevice := GetGDevice;
  2695.                     SetGDevice(osGDevice);
  2696.                     if osPort <> nil then begin
  2697.                             SetPort(GrafPtr(osPort));
  2698.                             pmBackColor(BackgroundIndex);
  2699.                         end;
  2700.                     SetPort(tPort);
  2701.                     SetGDevice(SaveGDevice);
  2702.                     if isInsertionPoint then
  2703.                         DisplayText(true);
  2704.                 end;
  2705.     end;
  2706.  
  2707.  
  2708.     procedure GetForegroundColor (event: EventRecord);
  2709.         var
  2710.             loc: point;
  2711.             color: integer;
  2712.     begin
  2713.         loc := event.where;
  2714.         ScreenToOffScreen(loc);
  2715.         Color := MyGetPixel(loc.h, loc.v);
  2716.         SetForegroundColor(color);
  2717.     end;
  2718.  
  2719.  
  2720.     procedure GetBackgroundColor; {(event: EventRecord)}
  2721.         var
  2722.             loc: point;
  2723.             color: integer;
  2724.     begin
  2725.         loc := event.where;
  2726.         ScreenToOffScreen(loc);
  2727.         Color := MyGetPixel(loc.h, loc.v);
  2728.         SetBackgroundColor(color);
  2729.     end;
  2730.  
  2731.  
  2732. procedure GenerateValues;
  2733.         var
  2734.             a, b, c, d, e, f, x, y: extended;
  2735.             i: integer;
  2736.     begin
  2737.         with info^ do begin
  2738.                 if fit = uncalibrated then begin
  2739.                         for i := 0 to 255 do
  2740.                             cvalue[i] := i;
  2741.                         minCValue := 0.0;
  2742.                         maxCValue := 255.0;
  2743.                         exit(GenerateValues);
  2744.                     end;
  2745.                 a := Coefficient[1];
  2746.                 b := Coefficient[2];
  2747.                 c := Coefficient[3];
  2748.                 d := Coefficient[4];
  2749.                 e := Coefficient[5];
  2750.                 f := Coefficient[6];
  2751.                 minCValue := 10e+12;
  2752.                 maxCValue := -minCValue;
  2753.                 for i := 0 to 255 do begin
  2754.                         x := i;
  2755.                         case fit of
  2756.                             StraightLine: 
  2757.                                 y := a + b * x;
  2758.                             Poly2: 
  2759.                                 y := a + b * x + c * x * x;
  2760.                             Poly3: 
  2761.                                 y := a + b * x + c * x * x + d * x * x * x;
  2762.                             Poly4: 
  2763.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
  2764.                             Poly5: 
  2765.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
  2766.                             ExpoFit: 
  2767.                                 y := a * exp(b * x);
  2768.                             PowerFit: 
  2769.                                 if x = 0.0 then
  2770.                                     y := 0.0
  2771.                                 else
  2772.                                     y := a * exp(b * ln(x)); {y=ax^b}
  2773.                             LogFit:  begin
  2774.                                     if x = 0.0 then
  2775.                                         x := 0.5;
  2776.                                     y := a * ln(b * x)
  2777.                                 end;
  2778.                             RodbardFit:  begin
  2779.                                     if x <= a then
  2780.                                         y := 0
  2781.                                     else begin
  2782.                                             y := (a - x) / (x - d);
  2783.                                             y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
  2784.                                             y := y * c;
  2785.                                         end;
  2786.                                 end;
  2787.                             UncalibratedOD:  begin
  2788.                                     if x = 255.0 then
  2789.                                         x := 254.5;
  2790.                                     y := 0.434294481 * ln(255.0 / (255.0 - x))  {log10}
  2791.                                 end;
  2792.                             otherwise
  2793.                                 y := x;
  2794.                         end; {case}
  2795.                         cvalue[i] := y;
  2796.                         if y > maxCValue then
  2797.                             maxCValue := y;
  2798.                         if y < minCValue then
  2799.                             minCValue := y;
  2800.                     end; {for}
  2801.                 if minCValue >= 0.0 then
  2802.                     ZeroClip := false;
  2803.                 if ZeroClip then begin
  2804.                         for i := 0 to 255 do
  2805.                             if cvalue[i] < 0.0 then
  2806.                                 cvalue[i] := 0.0;
  2807.                         minCValue := 0.0;
  2808.                     end;
  2809.             end;
  2810.     end;
  2811.  
  2812.  
  2813.     procedure ScaleImageWindow (var trect: rect);
  2814.         var
  2815.             WindowLeft, WindowTop: integer;
  2816.             PicAspectRatio, TempMagnification: extended;
  2817.     begin
  2818.         with info^ do begin
  2819.                 SrcRect := PicRect;
  2820.                 with CGrafPtr(wptr)^.PortPixMap^^.bounds do begin
  2821.                         WindowLeft := -left;
  2822.                         WindowTop := -top;
  2823.                     end;
  2824.     with PicRect do
  2825.                     PicAspectRatio := right / bottom;
  2826.                 with trect do begin
  2827.                         if (WindowLeft + right) > (ScreenWidth - 5) then
  2828.                             right := ScreenWidth - 5 - WindowLeft;
  2829.                         bottom := round(right / PicAspectRatio);
  2830.                         if (WindowTop + bottom) > (ScreenHeight - 5) then
  2831.                             bottom := ScreenHeight - 5 - WindowTop;
  2832.                         right := round(bottom * PicAspectRatio);
  2833.                         magnification := right / PicRect.right;
  2834.                     end;
  2835.                 UpdateTitleBar;
  2836.             end; {with}
  2837.     end;
  2838.  
  2839.  
  2840.     function TooWide: boolean;
  2841.         var
  2842.             SelectionTooWide: boolean;
  2843.             MaxWidth: str255;
  2844.     begin
  2845.         with info^.RoiRect do
  2846.             SelectionTooWide := (right - left) > MaxLine;
  2847.         if SelectionTooWide then begin
  2848.                 NumToString(MaxLine, MaxWidth);
  2849.                 PutError(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
  2850.                 AbortMacro;
  2851.             end;
  2852.         TooWide := SelectionTooWide;
  2853.     end;
  2854.  
  2855.  
  2856.     procedure DrawTextString (str: str255; loc: point; just: integer);
  2857.         var
  2858.             SaveJust: integer;
  2859.     begin
  2860.         TextStr := str;
  2861.         IsInsertionPoint := true;
  2862.         TextStart := loc;
  2863.         SaveJust := TextJust;
  2864.         TextJust := just;
  2865.         DisplayText(false);
  2866.         TextJust := SaveJust;
  2867.         IsInsertionPoint := false;
  2868.     end;
  2869.  
  2870.  
  2871.     procedure IncrementCounter;
  2872.     begin
  2873.         if mCount < MaxMeasurements then begin
  2874.                 mCount := mCount + 1;
  2875.                 UnsavedResults := true;
  2876.             end
  2877.         else
  2878.             beep;
  2879.     end;
  2880.  
  2881.  
  2882.     procedure ClearResults (i: integer);
  2883.     begin
  2884.         mean^[i] := 0.0;
  2885.         sd^[i] := 0.0;
  2886.         PixelCount^[i] := 0;
  2887.         mArea^[i] := 0.0;
  2888.         mode^[i] := 0.0;
  2889.         IntegratedDensity^[i] := 0.0;
  2890.         idBackground^[i] := 0.0;
  2891.         xcenter^[i] := 0.0;
  2892.         ycenter^[i] := 0.0;
  2893.         MajorAxis^[i] := 0.0;
  2894.         MinorAxis^[i] := 0.0;
  2895.         orientation^[i] := 0.0;
  2896.         mMin^[i] := 0.0;
  2897.         mMax^[i] := 0.0;
  2898.         plength^[i] := 0.0;
  2899.     end;
  2900.  
  2901.     procedure UpdateFitEllipse;
  2902.     begin
  2903.         FitEllipse :=(xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
  2904.     end;
  2905.  
  2906.  
  2907.  
  2908.     function StringToReal (str: str255): extended;
  2909.         var
  2910.             i, ndigits, StringLength: integer;
  2911.             c: char;
  2912.             n, m: extended;
  2913.             negative, LeftOfPoint, NegExp: boolean;
  2914.             exponent: LongInt;
  2915.     begin
  2916.         negative := false;
  2917.         n := 0.0;
  2918.         LeftOfPoint := true;
  2919.         m := 0.1;
  2920.         ndigits := 0;
  2921.         StringLength := length(str);
  2922.         i := 0;
  2923.         repeat
  2924.             i := i + 1;
  2925.         until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
  2926.         c := str[i];
  2927.         repeat
  2928.             if c = '-' then
  2929.                 negative := true
  2930.             else if c = '.' then
  2931.                 LeftOfPoint := false
  2932.             else if (c >= '0') and (c <= '9') then begin
  2933.                     ndigits := ndigits + 1;
  2934.                     if LeftOfPoint then
  2935.                         n := n * 10.0 + ord(c) - ord('0')
  2936.                     else begin
  2937.                             n := n + (ord(c) - ord('0')) * m;
  2938.                             m := m * 0.1;
  2939.                         end;
  2940.                 end;
  2941.             i := i + 1;
  2942.             if i <= StringLength then
  2943.                 c := str[i];
  2944.         until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
  2945.         if (c = 'e') or (c = 'E') then begin
  2946.                 NegExp := false;
  2947.                 exponent := 0;
  2948.                 i := i + 1;
  2949.                 if i <= StringLength then
  2950.                     c := str[i];
  2951.                 if (c = '+') or (c = '-') then begin
  2952.                         if c = '-' then
  2953.                             NegExp := true;
  2954.                         i := i + 1;
  2955.                         if i <= StringLength then
  2956.                             c := str[i];
  2957.                     end;
  2958.                 repeat
  2959.                     if (c >= '0') and (c <= '9') then
  2960.                         exponent := exponent * 10 + ord(c) - ord('0');
  2961.                     i := i + 1;
  2962.                     if i <= StringLength then
  2963.                         c := str[i];
  2964.                 until not (c in ['0'..'9']) or (i > StringLength);
  2965.                 if negExp then
  2966.                     exponent := -exponent;
  2967.                 if exponent <> 0 then
  2968.                     n := n * exp(exponent * ln(10));
  2969.             end; {if c='e'}
  2970.         if ndigits = 0 then
  2971.             n := BadReal
  2972.         else if negative then
  2973.             n := -n;
  2974.         StringToReal := n;
  2975.     end;
  2976.  
  2977.  
  2978.     procedure RemovePath(var str: str255);
  2979.     var
  2980.         loc: integer;
  2981.     begin
  2982.         repeat
  2983.             loc := pos(':', str);
  2984.             if loc > 0 then
  2985.                 delete(str, 1, loc);
  2986.         until loc = 0;
  2987.     end;
  2988.  
  2989.  
  2990.     procedure MakeNewWindow (name: str255);
  2991.         var
  2992.             wwidth, wheight, wleft, wtop, i: integer;
  2993.             tPort: GrafPtr;
  2994.             rgb: RGBColor;
  2995.             err: OSErr;
  2996.             str: str255;
  2997.             SaveGDevice: GDHandle;
  2998.     begin
  2999.         with Info^ do begin
  3000.                 RemovePath(name);
  3001.                 wleft := PicLeft;
  3002.                 wtop := PicTop;
  3003.                 PicLeft := PicLeft + hPicOffset;
  3004.                 PicTop := PicTop + vPicOffset;
  3005.                 if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
  3006.                         PicLeft := PicLeftBase;
  3007.                         PicTop := PicTopBase;
  3008.                     end;
  3009.                 wwidth := PixelsPerLine;
  3010.                 if (wleft + wwidth) > ScreenWidth then
  3011.                     wwidth := ScreenWidth - wleft - 4;
  3012.                 wheight := nlines;
  3013.                 if (wtop + wheight) > ScreenHeight then
  3014.                     wheight := ScreenHeight - wtop - 4;
  3015.                 if OpeningPlugInWindow then
  3016.                     SetRect(wrect, -10000, wtop, -10000 + wwidth, wtop + wheight)
  3017.                 else
  3018.                     SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
  3019.                 str := name;
  3020.                 if SpatiallyCalibrated then
  3021.                     str := concat(str, chr($13)); {Black Diamond}
  3022.                 if fit <> uncalibrated then
  3023.                     str := concat(str, '◊');
  3024.                 wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
  3025.                 GetPort(tPort);
  3026.                 SetPort(wptr);
  3027.                 SetPalette(wptr, ExplicitPalette, false);
  3028.                 pmForeColor(BlackIndex);
  3029.                 pmBackColor(WhiteIndex);
  3030.                 SetRect(wrect, 0, 0, wwidth, wheight);
  3031.                 SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
  3032.                 SelectWindow(wptr);
  3033.                 WindowPeek(wptr)^.WindowKind := PicKind;
  3034.                 WindowPeek(wptr)^.RefCon := ord4(Info);
  3035.                 TruncateString(name, maxTitle);
  3036.                 title := name;
  3037.                 ExtendWindowsMenu(name, PixMapSize, wptr);
  3038.                 PicNum := nPics;
  3039.                 PidNum := nextPid;
  3040.                 nextPid := nextPid - 1;
  3041.                 osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  3042.                 SaveGDevice := GetGDevice;
  3043.                 SetGDevice(osGDevice);
  3044.                 OpenCPort(osPort);
  3045.                 with osPort^ do begin
  3046.                         with PortPixMap^^ do begin
  3047.                                 BaseAddr := PicBaseAddr;
  3048.                                 bounds := PicRect;
  3049.                                 pixelType := 0;
  3050.                                 if PixelSize > 8 then
  3051.                                     PixelSize := 8;
  3052.                                 cmpCount := 1;
  3053.                             end;
  3054.                         PortRect := PicRect;
  3055.                         RectRgn(visRgn, PicRect);
  3056.                         PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
  3057.                     end;
  3058.                 SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  3059.                 pmForeColor(ForegroundIndex);
  3060.                 pmBackColor(BackgroundIndex);
  3061.                 SetGDevice(SaveGDevice);
  3062.                 SetPort(tPort);
  3063.                 SrcRect := wrect;
  3064.                 magnification := 1.0;
  3065.                 RoiShowing := false;
  3066.                 roiType := NoRoi;
  3067.                 initwrect := wrect;
  3068.                 savewrect := wrect;
  3069.                 SaveSrcRect := SrcRect;
  3070.                 SaveMagnification := magnification;
  3071.                 savehloc := wleft;
  3072.                 savevloc := wtop;
  3073.                 roiRgn := NewRgn;
  3074.                 NewPic := true;
  3075.                 ScaleToFitWindow := false;
  3076.                 OpPending := false;
  3077.                 Changes := false;
  3078.                 WindowState := NormalWindow;
  3079.                 if (fit = uncalibrated) and InvertPixelValues then
  3080.                     InvertGrayLevels;
  3081.                 Revertable := false;
  3082.             end;
  3083.         WhatToUndo := NothingToUndo;
  3084.     end;
  3085.  
  3086.  
  3087.     procedure MakeLowerCase (var str: str255);
  3088.         var
  3089.             i: integer;
  3090.             c: char;
  3091.     begin
  3092.         for i := 1 to length(str) do begin
  3093.                 c := str[i];
  3094.                 if (c >= 'A') and (c <= 'Z') then
  3095.                     str[i] := chr(ord(c) + 32);
  3096.             end;
  3097.     end;
  3098.  
  3099.  
  3100.     function PutMessageWithCancel (str: str255): integer;
  3101.     begin
  3102.         InitCursor;
  3103.         ParamText(str, '', '', '');
  3104.         PutMessageWithCancel := Alert(800, nil);
  3105.     end;
  3106.  
  3107.  
  3108.     function CurrentWindow: integer;
  3109.     begin
  3110.         CurrentWPtr := FrontWindow;
  3111.         if CurrentWPtr <> nil then begin
  3112.                 CurrentKind := WindowPeek(CurrentWPtr)^.WindowKind;
  3113.                 if CurrentKind = TextKind then
  3114.                     TextInfo := TextInfoPtr(WindowPeek(CurrentWPtr)^.RefCon);
  3115.                 CurrentWindow := CurrentKind;
  3116.             end
  3117.         else begin
  3118.                 CurrentWindow := 0;
  3119.                 CurrentKind := 0;
  3120.             end;
  3121.     end;
  3122.  
  3123.  
  3124.     procedure FindMonitors (NewScreenDepth: integer);
  3125.   {Generate a list of 8-bit monitors so we can update their LUTs.}
  3126.   {This wouldn't be necessary if we were using the Palette Manager.}
  3127.         var
  3128.             nextDevice: GDHandle;
  3129.     begin
  3130.         nMonitors := 0;
  3131.         nextDevice := GetDeviceList;
  3132.         while nextDevice <> nil do begin
  3133.                 if TestDeviceAttribute(nextDevice, screenDevice) and TestDeviceAttribute(nextDevice, screenActive) then
  3134.                     if nextDevice^^.gdPmap^^.PixelSize = 8 then begin
  3135.                             nMonitors := nMonitors + 1;
  3136.                             Monitors[nMonitors] := nextDevice;
  3137.                         end;
  3138.                 nextDevice := GetNextDevice(nextDevice);
  3139.             end; {while}
  3140.         if NewScreenDepth < 4 then
  3141.             gCopyMode := DitherCopy
  3142.         else
  3143.             gCopyMode := SrcCopy;
  3144.         SaveScreenDepth := NewScreenDepth;
  3145.     end;
  3146.  
  3147.  
  3148.     function ScreenDepth: integer;
  3149.         var
  3150.             depth: integer;
  3151.     begin
  3152.         depth := ScreenPixMap^^.PixelSize;
  3153.         if (depth = 8) and LUTFriendlyMode then
  3154.             depth := 6;
  3155.         if depth <> SaveScreenDepth then
  3156.             FindMonitors(depth);
  3157.         ScreenDepth := depth;
  3158.     end;
  3159.  
  3160.  
  3161.     procedure SetFColor (index: integer);
  3162.   {Sets the screen foreground color. Use pmForeColor to set the offscreen color.}
  3163.     begin
  3164.         if ScreenDepth = 8 then
  3165.             pmForeColor(index)
  3166.         else
  3167.             RGBForeColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3168.     end;
  3169.  
  3170.     procedure SetBColor (index: integer);
  3171.   {Sets the screen background color.}
  3172.     begin
  3173.         if ScreenDepth = 8 then
  3174.             pmBackColor(index)
  3175.         else
  3176.             RGBBackColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3177.     end;
  3178.     
  3179.     
  3180.     function DoubleToReal(d:FakeDouble):extended;
  3181.     {Converts an IEEE double to an IEEE float. Will not be needed
  3182.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3183.     var
  3184.       s, f, r:extended;
  3185.       e:LongInt;
  3186.       dd:double;
  3187.     begin
  3188.         {$ifc PowerPC}
  3189.         dd:=double(d);
  3190.         r:=dd;
  3191.         {$elsec PowerPC}
  3192.         if band(d[1],$80000000)=0 then
  3193.             s:=1
  3194.         else
  3195.             s:=-1;
  3196.         e:=band(d[1],$7ff00000);
  3197.         e:=bsr(e,20);
  3198.         f:=band(d[1],$fffff);
  3199.         f:=f / 1048576.0;
  3200.         f:=f + bsr(d[2],24)/268435456.0;
  3201.         {ShowMessage(StringOf('s=',s , ' e=', e, ' f=', f));}
  3202.         if (e > 0) and (e < 2047) then 
  3203.             r:=s * exp((e-1023)*ln(2.0)) * (1.0 + f)
  3204.         else if (e = 0) and (f <> 0) then 
  3205.             r:=s * f * exp(-1022.0*ln(2.0)) * f
  3206.         else if (e = 0) and (e = 0) then
  3207.             r:=0.0
  3208.         else if (e = 255) and (f = 0) then
  3209.             r:=0.0 {inf}
  3210.         else {if e=255 and f<>0}
  3211.             r:=0.0; {nan}
  3212.         {$endc PowerPC}
  3213.         DoubleToReal:=r;
  3214.     end;
  3215.  
  3216.  
  3217.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  3218.     {Converts an IEEE float to an IEEE double. Will not be needed
  3219.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3220.     var
  3221.       i, s, e, f:LongInt;
  3222.       r:real;
  3223.       dd:double;
  3224.     begin
  3225.         {$ifc PowerPC}
  3226.         dd:=rr;
  3227.         d:=FakeDouble(dd);
  3228.         {$elsec PowerPC}
  3229.         r:=rr;
  3230.         i:=LongInt(r);
  3231.       s:=band(i,$80000000);
  3232.       e:=band(i,$7f800000);
  3233.         e:=bsr(e, 23);
  3234.         if e>255 then
  3235.             e:=255;
  3236.         e:=e-127+1023;
  3237.         e:=bsl(e, 20);
  3238.         f:=band(i, $7fffff);
  3239.         f:=bsr(f, 3);
  3240.         d[1]:=bor(s,bor(e,f));
  3241.         d[2]:=0;
  3242.         {if r<>0.0 then begin
  3243.             ShowMessage(StringOf(' e=', e,' f=', f)); wait(60);
  3244.         end;}
  3245.         {$endc PowerPC}
  3246.     end;
  3247.     
  3248.     
  3249. {$S Utilities2}
  3250. {Routines from here to the end of the file go in the Utilities2 segment}
  3251.  
  3252.     function MakeStackFromWindow: boolean;
  3253.     begin
  3254.         with info^ do begin
  3255.                 StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
  3256.                 if StackInfo = nil then begin
  3257.                         MakeStackFromWindow := false;
  3258.                         exit(MakeStackFromWindow);
  3259.                     end;
  3260.                 with StackInfo^ do begin
  3261.                         nSlices := 1;
  3262.                         CurrentSlice := 1;
  3263.                         PicBaseH[1] := PicBaseHandle;
  3264.                         SliceSpacing := 0.0;
  3265.                         FrameInterval := 0.0;
  3266.                         StackType := VolumeStack;
  3267.                     end;
  3268.                 PictureType := NewPicture;
  3269.                 MakeStackFromWindow := true;
  3270.             end;
  3271.     end;
  3272.  
  3273.     
  3274.     procedure SelectSlice (i: integer);
  3275.     begin
  3276.         with info^, info^.StackInfo^ do
  3277.             if i <= nSlices then begin
  3278.                     hunlock(PicBaseHandle);
  3279.                     PicBaseHandle := PicBaseH[i];
  3280.                     hlock(PicBaseHandle);
  3281.                     {$ifc PowerPC}
  3282.                     PicBaseAddr := PicBaseHandle^;
  3283.                     {$elsec}
  3284.                     PicBaseAddr := StripAddress(PicBaseHandle^);
  3285.                     {$endc}
  3286.                     osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  3287.                 end;
  3288.     end;
  3289.  
  3290.  
  3291.     procedure UpdateWindowsMenuItem;
  3292.         var
  3293.             str: str255;
  3294.             picSize: LongInt;
  3295.     begin
  3296.         with info^ do begin
  3297.             PicSize := PixMapSize;
  3298.             if StackInfo <> nil then
  3299.                 PicSize := PicSize * StackInfo^.nSlices;
  3300.             if DataH <> nil then
  3301.                 PicSize := PicSize + PicSize * SizeOf(real);
  3302.             NumToString((PicSize + 511) div 1024, str);
  3303.             str := concat(title, '  ', str, 'K');
  3304.             SetMenuItemText(WindowsMenuH, PicNum + WindowsMenuItems + nTextWindows, str);
  3305.         end;
  3306.     end;
  3307.  
  3308.  
  3309.     function AddSlice (update: boolean): boolean;
  3310.         var
  3311.             i: integer;
  3312.             h: handle;
  3313.             isRoi: boolean;
  3314.     begin
  3315.         with info^, info^.StackInfo^ do begin
  3316.                 AddSlice := false;
  3317.                 if nSlices = MaxSlices then
  3318.                     exit(AddSlice);
  3319.                 isRoi := RoiShowing;
  3320.                 if isRoi then
  3321.                     KillRoi;
  3322.                 h := GetBigHandle(PixMapSize);
  3323.                 if h = nil then begin
  3324.                         PutError('Not enough memory available to add a slice to this stack.');
  3325.                         AbortMacro;
  3326.                         exit(AddSlice);
  3327.                     end;
  3328.                 for i := nSlices downto CurrentSlice + 1 do
  3329.                     PicBaseH[i + 1] := PicBaseH[i];
  3330.                 nSlices := nSlices + 1;
  3331.                 CurrentSlice := CurrentSlice + 1;
  3332.                 PicBaseH[CurrentSlice] := h;
  3333.                 SelectSlice(CurrentSlice);
  3334.                 if Update then begin
  3335.                         SelectAll(false);
  3336.                         DoOperation(EraseOp);
  3337.                         UpdatePicWindow;
  3338.                     end;
  3339.                 if (StackType = rgbStack) and (nSlices <> 3) then
  3340.                     StackType := VolumeStack;
  3341.                 UpdateTitleBar;
  3342.                 if isRoi then
  3343.                     RestoreRoi;
  3344.                 WhatToUndo := NothingToUndo;
  3345.                 AddSlice := true;
  3346.                 changes := true;
  3347.                 PictureType := NewPicture;
  3348.                 UpdateWindowsMenuItem;
  3349.             end;
  3350.     end;
  3351.     
  3352.     
  3353.     procedure AbortMacro;
  3354.     {If a macro is running, abort it.}
  3355.     begin
  3356.         macro := false;
  3357.     end;
  3358.     
  3359.     
  3360.     procedure TruncateString(var str: str255; len: integer);
  3361.     begin
  3362. {if length(str) > len then
  3363.     beep;}
  3364.             if length(str) > len then
  3365.             delete(str, len + 1, length(str) - len);
  3366.     end;
  3367.     
  3368.             
  3369.     procedure CloseVdig;
  3370.     {Closes the current video digitizer component and
  3371.     its associated offscreen graphics world.}
  3372.     var
  3373.         err: osErr;
  3374.     begin
  3375.         if fgPixMap <> nil then begin
  3376.             DisposeGWorld(osGWorld);
  3377.             osGWorld := nil;
  3378.             GWorldLUT := nil;
  3379.             fgPixMap := nil;
  3380.         end;
  3381.         if vdig <> nil then begin
  3382.             err := CloseComponent(vdig);
  3383.             vdig := nil;
  3384.         end;
  3385.         FrameGrabber := noFrameGrabber;
  3386.     end;
  3387.  
  3388.  
  3389. end.