unit Edit;
{Editing routines used by NIH Image}
interface
uses
Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, globals, Utilities, Graphics, Camera, analysis, file1, filters, stacks, Lut, Text, math;
procedure FlipOrRotate (DoWhat: FlipRotateType);
procedure RotateToNewWindow (DoWhat: FlipRotateType);
procedure Rotate (DoWhat: FlipRotateType);
procedure DoCopy;
procedure DoCut;
procedure DoPaste;
procedure DoClear;
procedure ShowClipboard;
procedure DoObject (obj: ObjectType; event: EventRecord);
procedure DoSprayCan;
procedure DoBrush (event: EventRecord);
procedure DoText (loc: point);
procedure SetSprayCanSize;
procedure SetBrushSize;
procedure SetLineWidth;
procedure UpdateEditMenu;
procedure ConvertClipboard;
procedure ZoomOut;
procedure ZoomIn (event: EventRecord);
procedure Scroll (event: EventRecord);
procedure DoFill (event: EventRecord);
procedure DoGrow (WhichWindow: WindowPtr; event: EventRecord);
procedure DrawCharacter (ch: char);
procedure ConvertSystemClipboard;
procedure SetupOperation (item: integer);
procedure PastePicture;
procedure DoUndo;
procedure FindWhatToCopy;
procedure CopyResults;
{ AE - RMD 2/10/95 }
function CopyImage: boolean;
procedure CopyWindow;
implementation
procedure PivotSelection (var SelectionRect: rect; WindowRect: rect);
var
OldWidth, NewWidth, OldHeight, NewHeight, hCenter, vCenter, NewLeft, NewTop: integer;
begin
with SelectionRect do begin
OldWidth := right - left;
OldHeight := bottom - top;
hCenter := left + OldWidth div 2;
vCenter := top + OldHeight div 2;
end;
NewWidth := OldHeight;
NewHeight := OldWidth;
NewLeft := hCenter - NewWidth div 2;
NewTop := vCenter - NewHeight div 2;
with WindowRect do begin
if (NewLeft + NewWidth) > right then
NewLeft := right - NewWidth;
if (NewTop + NewHeight) > bottom then
NewTop := bottom - NewHeight;
if NewLeft < 0 then
NewLeft := 0;
if NewTop < 0 then
NewTop := 0;
end;
with SelectionRect do begin
left := NewLeft;
top := NewTop;
right := NewLeft + NewWidth;
bottom := NewTop + NewHeight;
end;
end;
procedure FlipLine (var LineBuf: LineType; width: integer);
var
TempLine: LineType;
i, WidthLessOne: integer;
begin
TempLine := LineBuf;
WidthLessOne := width - 1;
for i := 0 to width - 1 do
LineBuf[i] := TempLine[WidthLessOne - i];
end;
procedure ScreenToOffscreenRect (var r: rect);
var
p1, p2: point;
begin
with r do begin
p1.h := left;
p1.v := top;
p2.h := right;
p2.v := bottom;
ScreenToOffscreen(p1);
ScreenToOffscreen(p2);
Pt2Rect(p1, p2, r);
end;
end;
procedure FlipOrRotate (DoWhat: FlipRotateType);
var
SaveInfo: InfoPtr;
width, height, hDst, vSrc, vDst, hSrc, i, inc: integer;
LineBuf: LineType;
srect, drect, MaskRect: rect;
AutoSelectAll: boolean;
SaveRow:integer;
NextUpdate: LongInt;
begin
if NotRectangular or NotInBounds or NoUndo then
exit(FlipOrRotate);
AutoSelectAll := not Info^.RoiShowing;
if AutoSelectAll then
SelectAll(true);
if TooWide then
exit(FlipOrRotate);
ShowWatch;
SetupUndoFromClip;
SetupUndo;
if (DoWhat = RotateLeft) or (DoWhat = RotateRight) then
WhatToUndo := UndoRotate
else
WhatToUndo := UndoFlip;
SetupUndoInfoRec;
SaveInfo := Info;
srect := info^.RoiRect;
case DoWhat of
RotateLeft, RotateRight:
with srect do begin
if OptionKeyWasDown then
DoOperation(EraseOp);
drect := srect;
with info^ do begin
PivotSelection(drect, PicRect);
MaskRect := drect;
RoiRect := drect;
RectRgn(roiRgn, RoiRect);
end;
width := right - left;
if DoWhat = RotateLeft then begin
hDst := drect.left;
inc := 1
end
else begin
hDst := drect.right - 1;
inc := -1
end;
SaveRow:=top;
NextUpdate:=TickCount+6; {10/sec}
for vSrc := top to bottom - 1 do begin
Info := UndoInfo;
GetLine(left, vSrc, width, LineBuf);
if DoWhat = RotateLeft then
FlipLine(LineBuf, width);
Info := SaveInfo;
PutColumn(hDst, drect.top, width, LineBuf);
hDst := hDst + inc;
if TickCount>=NextUpdate then begin
SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1);
UpdateScreen(MaskRect);
SaveRow:=vSrc+1;
NextUpdate:=TickCount+6;
ShowAnimatedWatch;
end;
end;
SetRect(MaskRect, left, SaveRow, left+width, bottom);
UpdateScreen(MaskRect);
end;
FlipVertical:
with srect do begin
width := right - left;
vDst := bottom;
for vSrc := top to bottom - 1 do begin
Info := UndoInfo;
GetLine(left, vSrc, width, LineBuf);
Info := SaveInfo;
vDst := vDst - 1;
PutLine(left, vDst, width, LineBuf);
end;
end;
FlipHorizontal:
with srect do begin
width := right - left;
SaveRow:=top;
NextUpdate:=TickCount+6; {10/sec}
for vSrc := top to bottom - 1 do begin
Info := UndoInfo;
GetLine(left, vSrc, width, LineBuf);
FlipLine(LineBuf, width);
Info := SaveInfo;
PutLine(left, vSrc, width, LineBuf);
if TickCount>=NextUpdate then begin
SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1);
UpdateScreen(MaskRect);
SaveRow:=vSrc+1;
NextUpdate:=TickCount+6;
ShowAnimatedWatch;
end;
end;
SetRect(MaskRect, left, SaveRow, left+width, bottom);
UpdateScreen(MaskRect);
end;
end; {case}
Info := SaveInfo;
Info^.changes := true;
SetupRoiRect;
if AutoSelectAll then
KillRoi;
end;
procedure RotateToNewWindow (DoWhat: FlipRotateType);
var
SrcInfo, DstInfo: InfoPtr;
Srcwidth, DstWidth, DstHeight, hDst, vSrc, vDst, hSrc, i, inc, ignore: integer;
LineBuf: LineType;
SourceRect, DstRect, MaskRect: rect;
AutoSelectAll, isStack: boolean;
SaveCol:integer;
NextUpdate: LongInt;
begin
if NotRectangular or NotInBounds then
exit(RotateToNewWindow);
AutoSelectAll := not Info^.RoiShowing;
isStack := info^.StackInfo <> nil;
if AutoSelectAll then
SelectAll(true);
if TooWide then
exit(RotateToNewWindow);
ShowWatch;
SrcInfo := info;
with info^, info^.RoiRect do begin
SourceRect := RoiRect;
SrcWidth := right - left;
DstWidth := bottom - top;
DstHeight := right - left;
if not NewPicWindow(title, DstWidth, DstHeight) then begin
KillRoi;
AbortMacro;
exit(RotateToNewWindow)
end;
DstInfo := info;
DstRect := info^.PicRect;
end;
if DoWhat = RotateLeft then begin
hDst := 0;
inc := 1
end
else begin
hDst := DstWidth - 1;
inc := -1
end;
with SourceRect do begin
SaveCol:=hDst;
NextUpdate:=TickCount+6; {10/sec}
for vSrc := top to bottom - 1 do begin
Info := SrcInfo;
GetLine(left, vSrc, SrcWidth, LineBuf);
if DoWhat = RotateLeft then
FlipLine(LineBuf, SrcWidth);
Info := DstInfo;
PutColumn(hDst, 0, SrcWidth, LineBuf);
if TickCount>=NextUpdate then begin
if DoWhat=RotateLeft
then SetRect(MaskRect, SaveCol, 0, hDst+1, SrcWidth)
else SetRect(MaskRect, hDst, 0, SaveCol+1, SrcWidth);
UpdateScreen(MaskRect);
SaveCol:=hDst+1;
NextUpdate:=TickCount+6;
ShowAnimatedWatch;
end;
hDst := hDst + inc;
end; {for}
if DoWhat=RotateLeft
then SetRect(MaskRect, SaveCol, 0, dstWidth, SrcWidth)
else SetRect(MaskRect, 0, 0, SaveCol+1, SrcWidth);
UpdateScreen(MaskRect);
end; {with}
info^.changes := true;
if AutoSelectAll and not isStack then
with SrcInfo^ do begin
Changes := false;
ignore := CloseAWindow(wptr);
info := DstInfo;
end;
end;
procedure Rotate; {(DoWhat: FlipRotateType)}
const
NewWindowID = 3;
var
mylog: DialogPtr;
item: integer;
NewWindow: boolean;
begin
with info^, info^.RoiRect do
if RoiShowing then
NewWindow := ((right - left) > PicRect.bottom) or ((bottom - top) > PicRect.right)
else begin
RotateToNewWindow(DoWhat);
exit(Rotate);
end;
if ForceToFront <> noErr then exit(Rotate); { AE - RMD 1/10/95 }
InitCursor;
mylog := GetNewDialog(120, nil, pointer(-1));
SetDlogItem(mylog, NewWindowID, ord(NewWindow));
OutlineButton(MyLog, ok, 16);
repeat
if item = NewWindowID then begin
NewWindow := not NewWindow;
SetDlogItem(mylog, NewWindowID, ord(NewWindow));
end;
ModalDialog(nil, item);
until (item = ok) or (item = cancel);
DisposeDialog(mylog);
if item = cancel then
exit(Rotate);
if NewWindow then
RotateToNewWindow(DoWhat)
else
FlipOrRotate(DoWhat);
end;
function CopyImage: boolean;
var
err, width, EvenWidth, height, size: LongInt;
line: integer;
ClipXOffset, ClipYOffset: integer;
SavePort: GrafPtr;
SaveGDevice: GDHandle;
begin
with info^.RoiRect do begin
width := right - left;
if odd(width) then
EvenWidth := width + 1
else
EvenWidth := width;
height := bottom - top;
size := EvenWidth * height;
if size > ClipBufSize then begin
PutError(StringOf('This ',size div 1024:1,'K selection is larger than the ',ClipBufSize div 1024:1,'K Clipboard buffer.'));
WhatsOnClip := NothingOnClip;
AbortMacro;
CopyImage := false;
exit(CopyImage)
end;
end;
with ClipBufInfo^ do begin
PixelsPerLine := width;
BytesPerRow := EvenWidth;
nLines := height;
ClipXOffset := info^.RoiRect.left;
ClipYOffset := info^.RoiRect.top;
RoiRect := info^.RoiRect;
OffsetRect(RoiRect, -ClipXOffset, -ClipYOffset);
roiType := Info^.roiType;
PicRect := RoiRect;
with osPort^.portPixMap^^ do begin
RowBytes := BitOr(BytesPerRow, $8000);
bounds := PicRect;
end;
with osPort^ do begin
PortRect := PicRect;
RectRgn(visRgn, PicRect);
end;
if RoiType = RectRoi then begin
if info^.PictureType = FrameGrabberType then
WhatsOnClip := CameraPic
else
WhatsOnClip := RectPic
end else
WhatsOnClip := NonRectPic;
SaveGDevice := GetGDevice;
SetGDevice(osGDevice);
GetPort(SavePort);
SetPort(GrafPtr(osPort));
CopyRgn(info^.roiRgn, roiRgn);
OffsetRgn(roiRgn, -ClipXOffset, -ClipYOffset);
ctable := info^.ctable;
pmForeColor(BlackIndex);
pmBackColor(WhiteIndex);
CopyBits(BitMapHandle(Info^.osPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, Info^.RoiRect, RoiRect, SrcCopy, nil);
pmForeColor(ForegroundIndex);
pmBackColor(BackgroundIndex);
SetPort(SavePort);
SetGDevice(SaveGDevice);
end; {with}
CopyImage := true;
end;
procedure CopyWindow;
var
tPort: GrafPtr;
WindowSize: LongInt;
WindowRect: rect;
WhichWindow: WindowPtr;
kind, ignore: integer;
HidingPasteControl: boolean;
SaveGDevice: GDHandle;i:integer;
begin
if AEisActive then WhichWindow := CurrentWptr { AE - RMD 5/10/95 Allow AE to specify current window }
else WhichWindow := FrontWindow;
if WhichWindow = nil then
exit(CopyWindow);
WindowRect := WhichWindow^.PortRect;
kind := WindowPeek(WhichWindow)^.WindowKind;
HidingPasteControl := false;
with WindowRect do begin
WindowSize := right;
WindowSize := WindowSize * bottom;
end;
if kind = LUTKind then
WindowRect.bottom := 256;
case kind of
ProfilePlotKind: begin
ConvertPlotToText;
ClipTextInBuffer := true;
end;
CalibrationPlotKind: begin
ConvertCalibrationCurveToText;
ClipTextInBuffer := true;
end;
HistoKind, LUTKind, MapKind, ToolKind: begin
if PasteControl <> nil then begin
ignore := CloseAWindow(PasteControl);
HidingPasteControl := true;
end;
case kind of
HistoKind: begin
ConvertHistoToText;
ClipTextInBuffer := true;
DrawHistogram;
end;
MapKind:
DrawMap;
LUTKind:
DrawLUT;
ToolKind:
DrawTools;
end; {case}
end;
otherwise
end; {case}
if NoUndo then begin
WhatsOnClip := NothingOnClip;
exit(CopyWindow)
end;
ClipboardConverted := false;
with ClipBufInfo^ do begin
RoiType := RectRoi;
RoiRect := WindowRect;
RectRgn(roiRgn, RoiRect);
PicRect := WindowRect;
PixelsPerLine := WindowRect.right;
BytesPerRow := PixelsPerLine;
if odd(BytesPerRow) then
BytesPerRow := BytesPerRow + 1;
nLines := WindowRect.bottom;
with osPort^.portPixMap^^ do begin
RowBytes := BitOr(BytesPerRow, $8000);
bounds := WindowRect;
end;
with osPort^ do begin
PortRect := PicRect;
RectRgn(visRgn, PicRect);
SetRectRgn(ClipRgn, 0, 0, 30000, 30000);
end;
WhatsOnClip := RectPic;
SaveGDevice := GetGDevice;
SetGDevice(osGDevice);
GetPort(tPort);
SetPort(GrafPtr(osPort));
RGBForeColor(BlackRGB);
RGBBackColor(WhiteRGB);
if (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) then begin
EraseRect(osPort^.portRect);
DrawPlot
end
else
CopyBits(WhichWindow^.PortBits, BitMapHandle(osPort^.portPixMap)^^, WindowRect, WindowRect, SrcCopy, nil);
SetPort(tPort);
SetGDevice(SaveGDevice);
end; {with}
if HidingPasteControl then
ShowPasteControl;
end;
procedure CopyResults;
var
err: OSErr;
begin
CopyResultsToBuffer(1, mCount, ShowHeadings);
UnsavedResults := false;
err := ZeroScrap;
if err = NoErr then begin
err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP));
WhatsOnClip := NothingOnClip; {The text is on the System Scrap}
end;
end;
procedure DoCopy;
var
err: OSErr;
begin
err := ZeroScrap;
OldScrapCount := GetScrapCount;
case WhatToCopy of
CopyColor:
DoCopyColor;
CopySelection: begin
if not CopyImage then exit(DoCopy);
ClipTextInBuffer := false;
ClipboardConverted := false;
end;
CopyHistogram, CopyPlot, CopyCalibrationPlot, CopyCLUT, CopyGrayMap, CopyTools:
CopyWindow;
CopyMeasurements:
CopyResults;
CopyText:
DoTextCopy;
otherwise
beep;
end;
end;
procedure DoCut;
begin
DoCopy;
DoClear;
end;
procedure CenterRect (inRect, outRect: rect; var ResultRect: rect);
{Creates a new rectangle(ResultsRect) that is the same size as inRect, but centered within outRect.}
var
width, height, hcenter, vcenter: integer;
begin
with inRect do begin
width := right - left;
height := bottom - top;
end;
with outRect do begin
hcenter := left + (right - left) div 2;
vcenter := top + (bottom - top) div 2;
end;
with ResultRect do begin
left := hcenter - width div 2;
top := vcenter - height div 2;
right := left + width;
bottom := top + height;
end;
end;
procedure PastePicture;
var
loc: point;
SrcWidth, SrcHeight, DstHeight, DstWidth, dh, dv: integer;
DestRect: rect;
WindowNotResized: boolean;
begin
if LivePasteMode or (PasteTransferMode <> SrcCopy) then begin
LivePasteMode := false;
PasteTransferMode := SrcCopy;
if PasteControl <> nil then
DrawPasteControl
end;
with info^ do begin
SetupUndo;
WhatToUndo := UndoPaste;
if RoiShowing then
with RoiRect do {Pasting back into selection of same size?}
if ((right - left) = (ClipBufInfo^.RoiRect.right - ClipBufInfo^.RoiRect.left)) and ((bottom - top) = (ClipBufInfo^.RoiRect.bottom - ClipBufInfo^.RoiRect.top)) and (ClipBufInfo^.RoiType = RoiType) then begin
OpPending := true;
CurrentOp := PasteOp;
exit(PastePicture)
end;
with ClipBufInfo^.RoiRect do {Pasting into same size window?}
if (PicRect.right = right - left) and (PicRect.bottom = (bottom - top)) and (ClipBufInfo^.RoiType = RectRoi) then begin
SelectAll(true);
WhatToUndo := UndoPaste;
OpPending := true;
CurrentOp := PasteOp;
exit(PastePicture)
end;
if RoiShowing or (roiType <> NoRoi) then
KillRoi;
with ClipBufInfo^.RoiRect do begin
SrcWidth := right - left;
SrcHeight := bottom - top;
end;
with SrcRect do begin
DstWidth := right - left;
DstHeight := bottom - top;
end;
with initwrect do
WindowNotResized := (DstWidth = (right - left)) and (DstHeight = (bottom - top));
if ((SrcWidth > DstWidth) or (SrcHeight > DstHeight)) and WindowNotResized then
DestRect := PicRect
else
DestRect := SrcRect;
CenterRect(ClipBufInfo^.RoiRect, DestRect, RoiRect);
roiType := ClipBufInfo^.roiType;
CopyRgn(ClipBufInfo^.roiRgn, roiRgn);
dh := RoiRect.left - roiRgn^^.rgnbbox.left;
dv := RoiRect.top - roiRgn^^.rgnbbox.top;
OffsetRgn(roiRgn, dh, dv);
RoiShowing := true;
OpPending := true;
CurrentOp := PasteOp;
BinaryPic := false;
end;{with}
end;
procedure ConvertSystemClipboard;
{Converts system-wide clipboard to local clipboard.}
var
phandle: handle;
offset, length, size, EvenWidth: LongInt;
pframe: rect;
width, height: LongInt;
tPort: GrafPtr;
ScrapInfo: PScrapStuff;
SaveGDevice: GDHandle;
begin
ScrapInfo := InfoScrap;
if ScrapInfo^.ScrapSize <= 0 then
exit(ConvertSystemClipboard);
phandle := NewHandle(0);
length := GetScrap(phandle, 'PICT', offset);
if length > 0 then begin
ShowWatch;
pframe := PicHandle(phandle)^^.PicFrame;
with pframe do begin
width := right - left;
if odd(width) then
EvenWidth := width + 1
else
EvenWidth := width;
height := bottom - top;
size := EvenWidth * height;
if size > ClipBufSize then begin
PutError(StringOf('The ', size div 1024:1,'K image on the system clipboard is too large to paste.'));
DisposeHandle(phandle);
exit(ConvertSystemClipboard)
end;
end;
with ClipBufInfo^ do begin
PixelsPerLine := width;
nlines := height;
SetRect(PicRect, 0, 0, width, height);
RoiRect := PicRect;
RoiType := RectRoi;
SaveGDevice := GetGDevice;
SetGDevice(osGDevice);
GetPort(tPort);
SetPort(GrafPtr(osPort));
RectRgn(roiRgn, RoiRect);
BytesPerRow := EvenWidth;
with osPort^.portPixMap^^ do begin
RowBytes := BitOr(BytesPerRow, $8000);
bounds := PicRect;
end;
with CGrafPtr(osPort)^ do begin
PortRect := PicRect;
RectRgn(visRgn, PicRect);
SetRectRgn(ClipRgn, 0, 0, 30000, 30000);
end;
RGBForecolor(WhiteRGB);
PaintRect(PicRect);
DrawPicture(PicHandle(phandle), PicRect);
SetPort(tPort);
SetGDevice(SaveGDevice);
end; {with}
WhatsOnClip := ImportedPic;
end else begin
length := GetScrap(phandle, 'TEXT', offset);
if (length > 0) and (length < MaxTextBufSize) then begin
BlockMove(phandle^, ptr(TextBufP), length);
TextBufSize := length;
WhatsOnClip := TextOnClip;
end;
end;
DisposeHandle(phandle);
end;
procedure PasteText;
var
nTextLines, LineWidth, MaxLineWidth, MaxRectWidth, MaxRectHeight: integer;
LineStart, LineEnd, height, kind: integer;
fwptr: WindowPtr;
SaveGDevice: GDHandle;
okay: boolean;
begin
if AEisActive then fwptr := CurrentWptr { AE - RMD 5/10/95 Allow AE to specify current window }
else fwptr := FrontWindow;
if fwptr = nil then
exit(PasteText);
kind := WindowPeek(fwptr)^.WindowKind;
if Kind = TextKind then begin
DoTextPaste;
exit(PasteText);
end;
if TextBufSize > 5000 then begin
PutError('The maximum number of characters that can be pasted is 5000.');
exit(PasteText);
end;
if (Info = NoInfo) or NoUndo then
exit(PasteText);
with ClipBufInfo^ do begin
SaveGDevice := GetGDevice;
SetGDevice(osGDevice);
SetPort(GrafPtr(osPort));
RGBForeColor(BlackRGB);
RGBBackColor(WhiteRGB);
TextFont(CurrentFontID);
TextFace(CurrentStyle);
TextSize(CurrentSize);
end;
with info^ do if (not RoiShowing) or (RoiShowing and (RoiType <> RectRoi)) then begin
KillRoi;
nTextLines := 1;
MaxLineWidth := 10;
LineStart := 1;
LineEnd := 0;
repeat
LineEnd := LineEnd + 1;
if TextBufP^[LineEnd] = cr then begin
nTextLines := nTextLines + 1;
LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart);
if LineWidth > MaxLineWidth then
MaxLineWidth := LineWidth;
LineStart := LineEnd;
end;
until LineEnd >= TextBufSize;
if LineEnd > LineStart then begin
LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart);
if LineWidth > MaxLineWidth then
MaxLineWidth := LineWidth;
end;
height := nTextLines * CurrentSize + CurrentSize div 4;
MaxRectHeight := (PicRect.bottom * 2) div 3;
if height > MaxRectHeight then
height := MaxRectHeight;
MaxLineWidth := MaxLineWidth + CurrentSize div 2;
MaxRectWidth := (PicRect.right * 2) div 3;
if MaxLineWidth > MaxRectWidth then begin
MaxLineWidth := MaxRectWidth;
height := MaxRectHeight;
end;
with RoiRect do begin
left := 0;
top := 0;
right := MaxLineWidth;
bottom := height;
end;
RoiType := RectRoi;
MakeRegion;
end;
okay := CopyImage;
if okay then begin
WhatsOnClip := TextOnClip;
SetRectRgn(ClipBufInfo^.osPort^.ClipRgn, 0, 0, 30000, 30000); {Why is this needed?}
TETextBox(ptr(TextBufP), TextBufSize, ClipBufInfo^.RoiRect, TextJust);
PastePicture;
end;
SetGDevice(SaveGDevice);
end;
procedure DoPaste;
var
NewScrapCount: integer;
begin
if ((info = NoInfo) and (WhatsOnClip in [RectPic, NonRectPic, ImportedPic, CameraPic])) then begin
if CurrentWindow <> TextKind then begin
PutError('You must have an image window open to paste.');
exit(DoPaste);
end
else
WhatsOnClip := NothingOnClip;
end;
RoiUpdateTime := 0;
NewScrapCount := GetScrapCount;
if NewScrapCount <> OldScrapCount then begin
WhatsOnClip := NothingOnClip;
OldScrapCount := NewScrapCount;
end;
case WhatsOnClip of
aColor:
PasteColor;
RectPic, NonRectPic, ImportedPic, CameraPic:
PastePicture;
TextOnClip:
PasteText;
LivePic:
WhatsOnClip := NothingOnClip;
NothingOnClip: begin
ConvertSystemClipboard;
if (WhatsOnClip = ImportedPic) and (info <> NoInfo) then
PastePicture
else if WhatsOnClip = textOnClip then
PasteText
else
beep;
end;
end;
end;
procedure DoClear;
var
fwptr: WindowPtr;
kind: integer;
begin
if AEisActive then fwptr := CurrentWptr { AE - RMD 5/10/95 Allow AE to specify current window }
else fwptr := FrontWindow;
if fwptr = nil then
exit(DoClear);
kind := WindowPeek(fwptr)^.WindowKind;
if Kind = TextKind then begin
DoTextClear;
exit(DoClear);
end;
if not NoSelection then begin
SetupUndo;
WhatToUndo := UndoClear;
CurrentOp := EraseOp;
OpPending := true;
RoiUpdateTime := 0;
end;
end;
procedure ShowClipboard;
var
width, height, hstart, vstart, i, NewScrapCount: integer;
okay:boolean;
begin
NewScrapCount := GetScrapCount;
if NewScrapCount <> OldScrapCount then begin
WhatsOnClip := NothingOnClip;
OldScrapCount := NewScrapCount;
end;
if WhatsOnClip = NothingOnClip then
ConvertSystemClipboard;
if (WhatsOnClip = RectPic) or (WhatsOnClip = NonRectPic) or (WhatsOnClip = ImportedPic) or (WhatsOnClip = CameraPic) then
with ClipBufinfo^.RoiRect do begin
width := right - left;
height := bottom - top;
if NewPicWindow('Clipboard', width, height) then begin
PastePicture;
KillRoi;
SetupUndo;
info^.changes := false;
end;
end;
if WhatsOnClip = TextOnClip then begin
if MakeNewTextWindow('Clipboard', 400, 350) then
DoTextPaste;
end;
end;
function ScreenToPixmapH (hloc: integer): extended;
begin
with info^ do
ScreenToPixmapH := SrcRect.left + hloc / magnification;
end;
function ScreenToPixmapV (vloc: integer): extended;
begin
with info^ do
ScreenToPixmapV := SrcRect.top + vloc / magnification;
end;
procedure DoSelection (obj: ObjectType; start, finish: point);
var
tRect: rect;
temp, StartH, StartV, FinishH, FinishV: integer;
TempRgn: RgnHandle;
begin
WhatToUndo := NothingToUndo;
Info^.RoiShowing := false;
RoiUpdateTime := 0;
if (start.h = finish.h) or (start.v = finish.v) then
exit(DoSelection);
if start.h > finish.h then begin
temp := start.h;
start.h := finish.h;
finish.h := temp;
end;
if start.v > finish.v then begin
temp := start.v;
start.v := finish.v;
finish.v := temp;
end;
StartH := round(ScreenToPixmapH(start.h));
StartV := round(ScreenToPixmapV(start.v));
FinishH := round(ScreenToPixmapH(finish.h));
FinishV := round(ScreenToPixmapV(finish.v));
SetRect(tRect, StartH, StartV, FinishH, FinishV);
with info^ do begin
RoiShowing := true;
if SelectionMode <> NewSelection then
TempRgn := NewRgn;
OpenRgn;
case obj of
SelectionOval: begin
FrameOval(tRect);
roiType := OvalRoi;
end;
SelectionRect: begin
FrameRect(tRect);
roiType := RectRoi;
end;
end;
if SelectionMode = NewSelection then
CloseRgn(roiRgn)
else begin
CloseRgn(TempRgn);
if RgnNotTooBig(roiRgn, TempRgn) then begin
if SelectionMode = AddSelection then
UnionRgn(roiRgn, TempRgn, roiRgn)
else begin
DiffRgn(roiRgn, TempRgn, roiRgn);
UpdatePicWindow;
end;
end;
DisposeRgn(TempRgn);
if GetHandleSize(handle(roiRgn)) = 10 then
roiType := RectRoi
else
roiType := FreehandRoi;
nCoordinates := 0;
end;
RoiRect := roiRgn^^.rgnBBox;
end;{with}
measuring := false;
end;
procedure DoObject; {(obj: ObjectType; event: EventRecord)}
var
Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point;
r: rect;
DeltaX, DeltaY, switch: integer;
Constrain: boolean;
StartH, StartV: extended;
begin
SetPort(info^.wptr);
if obj = LineObj then
DrawLabels('DX:', 'DY:', 'Length:')
else
DrawLabels('Width:', 'Height:', '');
start := event.where;
StartH := ScreenToPixmapH(start.h);
StartV := ScreenToPixmapV(start.v);
osStart := start;
ScreenToOffscreen(osStart);
finish := start;
osFinish := finish;
ScreenToOffscreen(osFinish);
PenNormal;
PenMode(PatXor);
PenSize(1, 1);
while button do begin
GetMouse(finish);
with finish, Info^ do begin
if h > wrect.right then
h := wrect.right;
if v > wrect.bottom then
v := wrect.bottom;
if h < 0 then
h := 0;
if v < 0 then
v := 0;
end;
if ShiftKeyDown then begin
DeltaX := finish.h - start.h;
DeltaY := finish.v - start.v;
if obj = lineObj then begin
if abs(DeltaX) > abs(DeltaY) then
finish.v := start.v
else
finish.h := start.h
end
else begin
if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then
switch := -1
else
switch := 1;
if abs(DeltaX) > abs(DeltaY) then
finish.h := start.h + switch * DeltaY
else
finish.v := start.v + switch * DeltaX;
end;
end;
osFinish := finish;
ScreenToOffscreen(osfinish);
case obj of
LineObj: begin
MoveTo(start.h, start.v);
LineTo(finish.h, finish.v);
ShowDxDy(abs(ScreenToPixMapH(finish.h) - StartH), abs(ScreenToPixMapV(finish.v) - StartV));
MoveTo(start.h, start.v);
LineTo(finish.h, finish.v);
end;
Rectangle, SelectionRect: begin
if obj = SelectionRect then begin
PatIndex := (PatIndex + 1) mod 8;
PenPat(AntPattern[PatIndex]);
end;
Pt2Rect(start, finish, r);
FrameRect(r);
Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1);
Pt2Rect(start, finish, r);
FrameRect(r);
end;
SelectionOval: begin
PatIndex := (PatIndex + 1) mod 8;
PenPat(AntPattern[PatIndex]);
Pt2Rect(start, finish, r);
FrameOval(r);
Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1);
Pt2Rect(start, finish, r);
FrameOval(r);
end;
end; {case}
end; {while button}
if (obj = SelectionRect) or (obj = SelectionOval) then begin
DoSelection(obj, start, finish);
exit(DoObject);
end;
if (obj = LineObj) and ((CurrentTool = LineTool) or (CurrentTool = PlotTool)) then begin
MoveTo(start.h, start.v);
LineTo(finish.h, finish.v);
with info^ do begin
LX1 := StartH;
LY1 := StartV;
LX2 := ScreenToPixmapH(finish.h);
LY2 := ScreenToPixmapV(finish.v);
if LX1 > (PicRect.right - 1) then
LX1 := PicRect.right - 1;
if LY1 > (PicRect.bottom - 1) then
LY1 := PicRect.bottom - 1;
if LX1 < 0 then
LX1 := 0;
if LY1 < 0 then
LY1 := 0;
if LX2 > (PicRect.right - 1) then
LX2 := PicRect.right - 1;
if LY2 > (PicRect.bottom - 1) then
LY2 := PicRect.bottom - 1;
if LX2 < 0 then
LX2 := 0;
if LY2 < 0 then
LY2 := 0;
end;
exit(DoObject);
end;
DrawObject(obj, start, finish);
end;
procedure DrawSprayCan (xcenter, ycenter: integer);
var
i, xoffset, yoffset, nDots: LongInt;
begin
nDots := SprayCanDiameter div 4;
if nDots < 15 then
nDots := 15;
for i := 1 to nDots do begin
repeat
xoffset := random mod SprayCanRadius;
yoffset := random mod SprayCanRadius;
until xoffset * xoffset + yoffset * yoffset <= SprayCanRadius2;
PutPixel(xcenter + xoffset, ycenter + yoffset, ForegroundIndex);
end;
end;
procedure DoSprayCan;
{Reference: "Spaying and Smudging", Dick Pountain, Byte, November 1987}
var
xcenter, ycenter, off: integer;
MaskRect: rect;
pt: point;
SaveTicks:LongInt;
begin
info^.changes := true;
off := SprayCanRadius;
SaveTicks:=TickCount;
repeat
repeat until TickCount<>SaveTicks; {Update no more than 60 times per second}
SaveTicks:=TickCount;
GetMouse(pt);
ScreenToOffscreen(pt);
with MaskRect, pt do begin
left := h - off;
top := v - off;
right := h + off;
bottom := v + off;
end;
with pt do begin
xcenter := h;
ycenter := v
end;
DrawSprayCan(xcenter, ycenter);
UpdateScreen(MaskRect);
until not button;
WhatToUndo := UndoEdit;
end;
procedure DoBrush; {(event: EventRecord)}
var
r, ScreenRect: rect;
p1, p2, p2x, start: point;
WhichWindow: WindowPtr;
SaveLineWidth, SaveForegroundColor: integer;
Constrained, MoreHorizontal, FirstTime: boolean;
offset, width: integer;
rWidth: double;
begin
SaveLineWidth := LineWidth;
p1 := event.where;
start := p1;
if OptionKeyDown then begin
case CurrentTool of
Brush, Pencil:
GetForegroundColor(event);
Eraser:
GetBackgroundColor(event);
end;
if (CurrentTool = Brush) or (CurrentTool = Eraser) then
exit(DoBrush);
end;
case CurrentTool of
Pencil:
LineWidth := 1;
Brush, Eraser: begin
if CurrentTool = Brush then
width := BrushWidth
else
width := 16;
LineWidth := round(width / info^.magnification);
if LineWidth < 1 then
LineWidth := 1;
end;
end;
with info^ do
rWidth := (LineWidth - 1) * info^.magnification / 2.0;
offset := round(rWidth * 1.00000001); {ppc-bug}
if CurrentTool <> Pencil then
with p1 do begin
h := h - offset;
v := v - offset
end;
Constrained := ShiftKeyDown;
FirstTime := true;
if CurrentTool = eraser then begin
SaveForegroundColor := ForegroundIndex;
SetForegroundColor(BackgroundIndex)
end;
repeat
GetMouse(p2);
if CurrentTool <> Pencil then
with p2 do begin
h := h - offset;
v := v - offset
end;
if FirstTime then
if not EqualPt(p1, p2) then begin
MoreHorizontal := abs(p2.h - p1.h) >= abs(p2.v - p1.v);
FirstTime := false;
end;
if Constrained then
if MoreHorizontal then
p2.v := p1.v
else
p2.h := p1.h;
if CurrentTool = brush then
DrawObject(BrushObj, p1, p2)
else
DrawObject(LineObj, p1, p2);
p1 := p2;
until not button;
if CurrentTool = Eraser then
SetForegroundColor(SaveForegroundColor);
LineWidth := SaveLineWidth;
WhatToUndo := UndoEdit;
end;
procedure DrawCharacter; {(ch: char)}
var
str: str255;
begin
if Info = NoInfo then begin
beep;
exit(DrawCharacter)
end;
if ch = cr then
with InsertionPoint do begin
h := TextStart.h;
v := v + CurrentSize;
SetupUndo;
TextStr := '';
TextStart := InsertionPoint;
exit(DrawCharacter)
end;
if ch = BackSpace then
with InsertionPoint do begin
if length(TextStr) > 0 then begin
delete(TextStr, length(TextStr), 1);
DisplayText(true);
end;
exit(DrawCharacter)
end;
str := ' '; {Needed for MPW}
str[1] := ch;
TextStr := Concat(TextStr, str);
DisplayText(true);
end;
procedure DoText; {(loc: point)}
{Handles text tool mouse clicks.}
var
value: extended;
str: str255;
isValue: boolean;
begin
if NoUndo then
exit(DoText);
ScreenToOffscreen(loc);
with loc do begin
InsertionPoint.h := h;
InsertionPoint.v := v + 4;
end;
IsInsertionPoint := true;
TextStart := InsertionPoint;
TextStr := '';
if OptionKeyDown then
with info^ do begin
isValue := true;
if (PreviousTool = LineTool) and (nLengths > 0) then
value := plength^[mCount2]
else if (PreviousTool = AngleTool) and (nAngles > 0) then
value := orientation^[mCount2]
else if mCount > 0 then
if AreaM in Measurements then
value := mArea^[mCount2]
else if MeanM in Measurements then
value := mean^[mCount2]
else
isValue := false;
if isValue then begin
RealToString(value, 1, precision, str);
if mCount2 > 0 then
mCount2 := mCount2 - 1;
DrawTextString(str, TextStart, TextJust);
end;
end;
WhatToUndo := UndoEdit;
end;
procedure DoFill (event: EventRecord);
var
loc: point;
MaskBits: BitMap;
BitMapSize: LongInt;
tPort: GrafPtr;
trect: rect;
SaveGDevice: GDHandle;
begin
ShowWatch;
loc := event.where;
ScreenToOffscreen(loc);
with info^ do begin
tRect := PicRect;
with tRect do
if (right mod 16 <> 0) and not Has32BitQuickDraw then
right := (right div 16) * 16 + 16; {Workaround for SeedCFill bug that results in garbage along right edge.}
with MaskBits do begin
RowBytes := PixelsPerLine div 8 + 1;
if odd(RowBytes) then
RowBytes := RowBytes + 1;
bounds := tRect;
BitMapSize := rowBytes * nLines;
baseAddr := NewPtr(BitMapSize);
if baseAddr = nil then begin
beep;
exit(DoFill)
end;
end;
SaveGDevice := GetGDevice;
SetGDevice(osGDevice);
GetPort(tPort);
SetPort(GrafPtr(osPort));
pmForeColor(ForegroundIndex);
SeedCFill(BitMapHandle(osPort^.PortPixMap)^^, MaskBits, tRect, tRect, loc.h, loc.v, nil, 0);
CopyBits(MaskBits, BitMapHandle(osPort^.PortPixMap)^^, tRect, tRect, SrcOr, nil);
DisposePtr(MaskBits.baseAddr);
changes := true;
end; {with}
SetPort(tPort);
SetGDevice(SaveGDevice);
UpdatePicWindow;
WhatToUndo := UndoEdit;
end;
procedure SetSprayCanSize;
var
TempSize: integer;
Canceled: boolean;
begin
TempSize := GetInt('Spray can diameter in pixels(2-250):', SprayCanDiameter, Canceled);
if Canceled then
exit(SetSprayCanSize);
if (TempSize > 1) and (TempSize <= 250) then begin
SprayCanDiameter := TempSize;
SprayCanRadius := SprayCanDiameter div 2;
SprayCanRadius2 := SprayCanRadius * SprayCanRadius
end
else
beep;
end;
procedure SetBrushSize;
var
TempSize: integer;
Canceled: boolean;
i, ticks, x, y: LongInt;
v: integer;
begin
TempSize := GetInt('Brush Size in pixels(1..99):', BrushWidth, Canceled);
if Canceled then
exit(SetBrushSize);
if (TempSize > 0) and (TempSize < 100) then begin
BrushWidth := TempSize;
BrushHeight := BrushWidth
end
else
beep;
{exit(SetBrushSize);}
{Timer}
x := 100;
y := 100;
ticks := TickCount;
for i := 1 to 1000000 do
v := MyGetPixel(x, y);
ShowMessage(concat('ticks=', long2str(TickCount - ticks)));
end;
procedure SetLineWidth;
var
TempSize: integer;
Canceled: boolean;
begin
TempSize := GetInt('Line Width in pixels(1..100):', LineWidth, Canceled);
if Canceled then
exit(SetLineWidth);
if (TempSize > 0) and (TempSize <= 100) then begin
LineWidth := TempSize;
ShowLineWidth;
end
else
beep;
end;
procedure FindWhatToCopy;
var
kind: integer;
WhichWindow: WindowPtr;
begin
WhatToCopy := NothingToCopy;
if AEisActive then WhichWindow := CurrentWptr { AE - RMD 5/10/95 Allow AE to specify current window }
else WhichWindow := FrontWindow;
if WhichWindow = nil then
exit(FindWhatToCopy);
kind := WindowPeek(WhichWindow)^.WindowKind;
if (CurrentTool = PickerTool) and (kind <> TextKind) then
WhatToCopy := CopyColor
else begin
if (kind = PicKind) and measuring and (not macro) then
kind := ResultsKind;
case kind of
PicKind:
with info^, info^.RoiRect do
if RoiShowing and (left >= 0) and (top >= 0) and (right <= PicRect.right) and (bottom <= PicRect.bottom) then
WhatToCopy := CopySelection;
HistoKind:
WhatToCopy := CopyHistogram;
ProfilePlotKind:
WhatToCopy := CopyPlot;
CalibrationPlotKind:
WhatToCopy := CopyCalibrationPlot;
LUTKind:
if info <> NoInfo then
WhatToCopy := CopyCLUT;
MapKind:
if info <> NoInfo then
WhatToCopy := CopyGrayMap;
ToolKind:
WhatToCopy := CopyTools;
TextKind: begin
TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
if TextInfo <> nil then
with TextInfo^.TextTE^^ do
if selEnd > selStart then
WhatToCopy := CopyText;
end;
InfoKind, ResultsKind:
if mCount > 0 then
WhatToCopy := CopyMeasurements;
otherwise
end;
end;
end;
procedure UpdateEditMenu;
var
DimUndo, ShowItems: boolean;
str: str255;
i: integer;
begin
with info^ do begin
if CurrentKind < 0 then begin {DA is active, so activate Edit menu.}
SetMenuItemText(EditMenuH, UndoItem, 'Undo');
SetMenuItemText(EditMenuH, CutItem, 'Cut');
SetMenuItemText(EditMenuH, CopyItem, 'Copy');
SetMenuItem(EditMenuH, UndoItem, true);
for i := CutItem to ClearItem do
SetMenuItem(EditMenuH, i, true);
exit(UpdateEditMenu);
end;
if not (WhatToUndo in [UndoLUT, UndoMeasurement, UndoPoint]) and ((info = NoInfo) or (PixMapSize <> CurrentUndoSize)) then
WhatToUndo := NothingToUndo;
DimUndo := WhatToUndo = NothingToUndo;
SetMenuItem(EditMenuH, UndoItem, not DimUndo);
if DimUndo then
SetMenuItemText(EditMenuH, UndoItem, 'Undo');
case WhatToUndo of
UndoEdit:
str := 'Editing';
UndoFlip:
str := 'Flip';
UndoRotate:
str := 'Rotate';
UndoFilter:
str := 'Filtering';
UndoPaste:
str := 'Paste';
UndoMeasurement, UndoPoint:
str := 'Measurement';
UndoTransform:
str := 'Transformation';
UndoClear:
str := 'Clear';
UndoZoom:
str := 'Zoom';
UndoOutline:
str := 'Outline';
UndoSliceDelete, UndoFirstSliceDelete:
str := 'Delete Slice';
UndoLUT:
str := 'LUT Change';
otherwise
str := '';
end;
SetMenuItemText(EditMenuH, UndoItem, concat('Undo ', str));
FindWhatToCopy;
if WhatToCopy = CopySelection then
str := 'Cut Selection'
else
str := 'Cut';
SetMenuItemText(EditMenuH, CutItem, str);
SetMenuItem(EditMenuH, CutItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText));
case WhatToCopy of
NothingToCopy, CopyText:
str := '';
CopySelection:
str := 'Selection';
CopyCLUT:
str := 'LUT';
CopyGrayMap:
str := 'Gray Map';
CopyTools:
str := 'Tools';
CopyPlot:
str := 'Plot';
CopyCalibrationPlot:
str := 'Calibration Plot';
CopyHistogram:
str := 'Histogram';
CopyMeasurements:
str := 'Measurements';
CopyColor:
str := 'Color';
end;
SetMenuItemText(EditMenuH, CopyItem, concat('Copy ', str));
SetMenuItem(EditMenuH, CopyItem, WhatToCopy <> NothingToCopy);
SetMenuItem(EditMenuH, ClearItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText));
ShowItems := (WhatsOnClip <> NothingOnClip) or (OldScrapCount <> GetScrapCount);
SetMenuItem(EditMenuH, PasteItem, ShowItems);
SetMenuItem(EditMenuH, ShowClipboardItem, ShowItems);
ShowItems := info <> NoInfo;
if CurrentKind = TextKind then
SetMenuItemText(EditMenuH, FillItem, 'FindŲ©')
else
SetMenuItemText(EditMenuH, FillItem, 'Fill');
SetMenuItem(EditMenuH, FillItem, ShowItems or (CurrentKind = TextKind));
SetMenuItem(EditMenuH, InvertItem, ShowItems);
SetMenuItem(EditMenuH, DrawBoundaryItem, ShowItems);
SetMenuItem(EditMenuH, DrawScaleItem, ShowItems);
if (RoiShowing and EqualRect(RoiRect, PicRect)) and (CurrentKind <> TextKind) then
SetMenuItemText(EditMenuH, SelectAllItem, 'Deselect All')
else
SetMenuItemText(EditMenuH, SelectAllItem, 'Select All');
SetMenuItem(EditMenuH, SelectAllItem, ShowItems or (CurrentKind = TextKind));
SetMenuItem(EditMenuH, DeselectItem, ShowItems and RoiShowing);
SetMenuItem(EditMenuH, ScaleAndRotateItem, ShowItems);
for i := RotateLeftItem to FlipHorizontalItem do
SetMenuItem(EditMenuH, i, ShowItems);
SetMenuItem(EditMenuH, UnZoomItem, ShowItems and ((magnification <> 1.0) or ScaleToFitWindow));
end; {with}
end;
procedure ZoomOut;
var
Width, Height, divisor, NewWidth, NewHeight: integer;
OldMagnification, xratio, yratio: extended;
begin
with Info^ do begin
if magnification < 2.0 then begin
beep;
exit(ZoomOut)
end;
OldMagnification := magnification;
if magnification = 2.0 then begin
magnification := 1.0;
divisor := 4
end
else if magnification = 3.0 then begin
magnification := 2.0;
divisor := 6
end
else if magnification = 4.0 then begin
magnification := 3.0;
divisor := 8
end
else begin
magnification := magnification / 2.0;
divisor := 4
end;
if EqualRect(SrcRect, PicRect) then begin {Make window smaller}
NewWidth := trunc(PicRect.right * magnification);
NewHeight := trunc(PicRect.bottom * magnification);
SizeWindow(wptr, NewWidth, NewHeight, true);
wrect.right := NewWidth;
wrect.bottom := NewHeight;
SrcRect := PicRect;
UpdateTitleBar;
UpdatePicWindow;
DrawMyGrowIcon(wptr);
exit(ZoomOut);
end;
if ((wrect.right > PicRect.right) or (wrect.bottom > PicRect.bottom)) then begin
xratio := wrect.right / PicRect.right;
yratio := wrect.bottom / PicRect.bottom;
if (xratio <> yratio) or ((xratio - trunc(xratio)) <> 0.0) then begin
UnZoom;
Exit(ZoomOut)
end;
SrcRect := PicRect;
Magnification := xratio;
UpdateTitleBar;
UpdatePicWindow;
DrawMyGrowIcon(wptr);
Exit(ZoomOut)
end;
end; {with}
with Info^.SrcRect, info^ do begin
if magnification = 1.0 then begin
width := wrect.right;
height := wrect.bottom;
end
else begin
width := round((right - left) * OldMagnification / Magnification);
height := round((bottom - top) * OldMagnification / Magnification);
end;
left := left - (width div divisor);
if left < 0 then
left := 0;
if (left + width) > Info^.PicRect.right then
left := Info^.PicRect.right - width;
top := top - (height div divisor);
if top < 0 then
top := 0;
if (top + height) > Info^.PicRect.bottom then
top := Info^.picRect.bottom - height;
right := left + width;
bottom := top + height;
RoiShowing := false;
UpdatePicWindow;
DrawMyGrowIcon(wptr);
UpdateTitleBar;
end;
ShowRoi;
end;
procedure DoGrow; {(WhichWindow: WindowPtr; event: EventRecord)}
var
NewSize: LongInt;
trect, WinRect, SizeRect: rect;
kind: integer;
WasDigitizing: boolean;
ZoomCenterH, ZoomCenterV, width, height: extended;
begin
kind := WindowPeek(WhichWindow)^.WindowKind;
if kind = PicKind then
with info^, SizeRect do begin
if ScaleToFitWindow then
SizeRect := qd.ScreenBits.bounds
else begin
right := PicRect.right + 1;
bottom := PicRect.bottom + 1;
if magnification > 1.0 then begin
right := round(right * magnification);
bottom := round(bottom * magnification);
end;
left := 32;
top := 32;
if left > right then
left := right;
if top > bottom then
top := bottom;
end
end
else
SetRect(SizeRect, 64, 48, 2048, 2048);
NewSize := GrowWindow(WhichWindow, event.where, SizeRect);
if newSize = 0 then
exit(DoGrow);
if kind = PicKind then
with Info^ do begin
SetPort(wptr);
WasDigitizing := digitizing;
StopDigitizing;
InvalRect(wrect);
with trect do begin
top := 0;
left := 0;
right := LoWrd(NewSize);
bottom := HiWrd(NewSize);
end;
if ScaleToFitWindow then begin
ScaleImageWindow(trect);
wrect := trect;
end
else begin
if trect.right > PicRect.right * magnification then
trect.right := trunc(PicRect.right * magnification);
if trect.bottom > PicRect.bottom * magnification then
trect.bottom := trunc(PicRect.bottom * magnification);
wrect := trect;
with SrcRect do begin
ZoomCenterH := left + (wrect.right / 2.0) / magnification;
ZoomCenterV := top + (wrect.bottom / 2.0) / magnification;
width := wrect.right / magnification;
height := wrect.bottom / magnification;
left := round(ZoomCenterH - width / 2.0);
if left < 0 then
left := 0;
if (left + width) > PicRect.right then
left := round(PicRect.right - width);
top := round(ZoomCenterV - height / 2.0);
if top < 0 then
top := 0;
if (top + height) > PicRect.bottom then
top := round(picRect.bottom - height);
right := round(left + width);
bottom := round(top + height);
wrect.right := trunc((right - left) * magnification);
wrect.bottom := trunc((bottom - top) * magnification);
end;
savewrect := wrect;
end;
SizeWindow(WhichWindow, wrect.right, wrect.bottom, true);
WindowState := NormalWindow;
if WasDigitizing then
StartDigitizing;
exit(DoGrow)
end; {with info^}
if WhichWindow = PlotWindow then begin
PlotWidth := LoWrd(NewSize);
PlotHeight := HiWrd(NewSize);
SetPort(PlotWindow);
SizeWindow(PlotWindow, PlotWidth, Plotheight, true);
InvalRect(PlotWindow^.PortRect);
exit(DoGrow)
end;
if (kind = TextKind) then begin
TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
GrowTextWindow(NewSize);
exit(DoGrow)
end;
if WhichWindow = ResultsWindow then begin
ResultsWidth := LoWrd(NewSize);
ResultsHeight := HiWrd(NewSize);
SetPort(ResultsWindow);
with ResultsWindow^.PortRect do
SetRect(tRect, right - 12, bottom - 12, right, bottom);
EraseRect(trect); {Erase Grow Box}
SizeWindow(ResultsWindow, ResultsWidth, ResultsHeight, true);
MoveControl(hScrollBar, -1, ResultsHeight - ScrollBarWidth);
MoveControl(vScrollBar, ResultsWidth - ScrollBarWidth, -1);
SizeControl(hScrollBar, ResultsWidth - 13, ScrollBarWidth + 1);
SizeControl(vScrollBar, ScrollBarWidth + 1, ResultsHeight - 13);
InvalRect(ResultsWindow^.PortRect);
with ListTE^^.viewRect do begin
right := left + ResultsWidth - ScrollBarWidth - 4;
bottom := top + ResultsHeight - ScrollBarWidth;
end;
UpdateResultsScrollBars;
ScrollResultsText;
end;
end;
procedure ZoomIn; {(event: EventRecord)}
var
width, height, OldMagnification: extended;
PicCenterH, PicCenterV, NewWidth, NewHeight: integer;
trect: rect;
begin
if Info = NoInfo then begin
beep;
exit(ZoomIn)
end;
if Info^.ScaleToFitWindow then begin
PutError('The magnifying glass does not work in "Scale to Fit Window" mode.');
exit(ZoomIn)
end;
if BitAnd(Event.modifiers, OptionKey) = OptionKey then begin
ZoomOut;
WhatToUndo := NothingToUndo;
exit(ZoomIn)
end;
with Info^ do begin
OldMagnification := magnification;
if magnification = 1.0 then
magnification := 2.0
else if magnification = 2.0 then
magnification := 3.0
else if magnification = 3.0 then
magnification := 4.0
else begin
magnification := magnification * 2.0;
if magnification > 64.0 then begin
magnification := 64.0;
exit(ZoomIn)
end;
end;
if (WindowState = NormalWindow) and EqualRect(SrcRect, PicRect) then {Make window bigger?}
with trect do begin
NewWidth := trunc(PicRect.right * magnification);
NewHeight := trunc(PicRect.bottom * magnification);
if NewWidth <= 640 then begin
GetWindowRect(wptr, trect);
if ((left + NewWidth) <= ScreenWidth) and ((top + NewHeight) <= ScreenHeight) then begin
SizeWindow(wptr, NewWidth, NewHeight, true);
wrect.right := NewWidth;
wrect.bottom := NewHeight;
end;
end;
end;
end; {with}
with Info^.SrcRect, Info^ do begin
PicCenterH := left + round(event.where.h / OldMagnification);
PicCenterV := top + round(event.where.v / OldMagnification);
width := wrect.right / magnification;
height := wrect.bottom / magnification;
left := PicCenterH - round(width / 2.0);
if left < 0 then
left := 0;
if (left + width) > PicRect.right then
left := PicRect.right - round(width);
top := PicCenterV - round(height / 2.0);
if top < 0 then
top := 0;
if (top + height) > PicRect.bottom then
top := picRect.bottom - round(height);
right := left + round(width);
bottom := top + round(height);
wrect.right := trunc((right - left) * magnification);
wrect.bottom := trunc((bottom - top) * magnification);
SizeWindow(wptr, wrect.right, wrect.bottom, true);
RoiShowing := false;
UpdatePicWindow;
DrawMyGrowIcon(wptr);
UpdateTitleBar;
WhatToUndo := UndoZoom;
ShowRoi;
end; {with}
end;
procedure SynchScroll;
var
n: integer;
TempInfo, SaveInfo: InfoPtr;
begin
SaveInfo := info;
if allsamesize then
for n := 1 to nPics do begin
TempInfo := pointer(WindowPeek(PicWindow[n])^.RefCon);
TempInfo^.SrcRect := info^.SrcRect;
TempInfo^.magnification := Info^.magnification;
info := TempInfo;
UpdatePicWindow;
Info := SaveInfo;
end
else
PutError('Synchronized scrolling requires all images and all windows to be the same size.');
end;
procedure Scroll; {(event: EventRecord)}
var
hstart, vstart, DeltaH, DeltaV, width, height: integer;
loc: point;
SaveSR: rect;
WasDigitizing: boolean;
begin
with info^ do begin
if ScaleToFitWindow then begin
PutError('Scrolling does not work in "Scale to Fit Window" mode.');
exit(Scroll)
end;
WasDigitizing := digitizing;
StopDigitizing;
with event.where do begin
hstart := h;
vstart := v
end;
with SrcRect do begin
width := right - left;
height := bottom - top
end;
SaveSR := SrcRect;
while StillDown do begin
GetMouse(loc);
DeltaH := hstart - loc.h;
DeltaV := vstart - loc.v;
with SrcRect do begin
left := SaveSR.left + DeltaH;
if left < 0 then
left := 0;
if (left + width) > PicRect.right then
left := PicRect.right - width;
right := left + width;
top := SaveSR.top + DeltaV;
if top < 0 then
top := 0;
if (top + height) > PicRect.bottom then
top := PicRect.bottom - height;
bottom := top + height;
end;
UpdatePicWindow;
DrawMyGrowIcon(wptr);
end;
WhatToUndo := NothingToUndo;
ShowRoi;
if OptionKeyDown and (nPics > 1) then
SynchScroll;
if WasDigitizing then
StartDigitizing;
end; {with info^}
end;
procedure ConvertClipboard;
{Converts local clipboard to system-wide clipboard}
{when quitting or switching to other programs.}
var
PicH: PicHandle;
err: LongInt;
saveClipRgn: RgnHandle;
begin
PicH := nil;
if ((WhatsOnClip = RectPic) or (WhatsOnClip = CameraPic)) and (ClipBuf <> nil) and not ClipboardConverted then
with ClipBufInfo^ do begin
ShowWatch;
SetPort(GrafPtr(osPort));
saveClipRgn := NewRgn;
GetClip(saveClipRgn);
ClipRect(RoiRect);
LoadLUT(ctable); {Switch to original LUT}
RGBForeColor(BlackRGB);
RGBBackColor(WhiteRGB);
PicH := OpenPicture(RoiRect);
with osPort^ do
CopyBits(BitMapHandle(portPixMap)^^, BitMapHandle(portPixMap)^^, RoiRect, RoiRect, SrcCopy, nil);
ClosePicture;
if info <> NoInfo then
LoadLUT(info^.ctable); {Restore LUT}
if (PicH <> nil) or ClipTextInBuffer then begin
err := ZeroScrap;
if err = NoErr then begin
if PicH <> nil then begin
hlock(handle(PicH));
err := PutScrap(GetHandleSize(handle(PicH)), 'PICT', handle(PicH)^);
hunlock(handle(PicH));
DisposeHandle(handle(PicH));
end;
if (err = noErr) and ClipTextInBuffer then
err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP));
end; {if err=NoErr}
end;
ClipboardConverted := true;
SetClip(saveClipRgn);
DisposeRgn(saveClipRgn);
end; {with}
end;
procedure SetupOperation; {(item: integer)}
var
AutoSelectAll: boolean;
begin
if NotinBounds then
exit(SetupOperation);
if item = DrawBoundaryItem then
if NoSelection then
exit(SetupOperation);
if item = InvertItem then
if not CheckCalibration then
exit(SetupOperation);
StopDigitizing;
AutoSelectAll := not Info^.RoiShowing;
if AutoSelectAll then
SelectAll(true);
SetupUndo;
WhatToUndo := UndoEdit;
case Item of
FillItem: begin
CurrentOp := PaintOp;
OpPending := true
end;
InvertItem: begin
CurrentOp := InvertOp;
OpPending := true
end;
DrawBoundaryItem: begin
CurrentOp := FrameOp;
OpPending := true
end;
end;
if AutoSelectAll then
KillRoi;
RoiUpdateTime := 0; {Forces outline to be redrawn in scale-to-fit mode.}
end;
procedure DoUndo;
var
aok: boolean;
begin
case WhatToUndo of
UndoMeasurement:
UndoLastMeasurement(true);
UndoPoint: begin
Undo;
UpdatePicWindow;
UndoLastMeasurement(true);
WhatToUndo := NothingToUndo;
end;
UndoZoom: begin
ZoomOut;
if info^.magnification < 2 then
WhatToUndo := NothingToUndo;
end;
UndoOutLine: begin
undo;
if WandAutoMeasure then
UndoLastMeasurement(true);
WhatToUndo := NothingToUndo;
UpdatePicWindow;
end;
UndoSliceDelete, UndoFirstSliceDelete:
if info^.StackInfo <> nil then
with info^.StackInfo^ do begin
if WhatToUndo = UndoFirstSliceDelete then
CurrentSlice := 0;
aok := AddSlice(false);
if aok then begin
Undo;
UpdatePicWindow;
end
else if CurrentSlice = 0 then
CurrentSlice := 1;
end;
UndoLUT: begin
UndoLutChange;
DrawMap;
DensitySlicing := false;
end;
otherwise begin
if UndoFromClip then
OpPending := false;
if not OpPending then
undo;
WhatToUndo := NothingToUndo;
if IsInsertionPoint then begin
InsertionPoint := TextStart;
TextStr := '';
end;
UpdatePicWindow;
if OpPending and (CurrentOp = PasteOp) then begin
OpPending := false;
KillRoi;
end;
OpPending := false;
end;
end; {case}
end;
end.