var {Global variable, initially zero} RoiLeft,RoiTop,RoiRight,RoiBottom:integer; macro 'Show Tools [T]'; begin SelectWindow('Tools'); end; Macro 'Draw Arrow [A]' {Draws an arrow based on the current straight line selection.} var size,angle,dx,dy,pi,theta:real; x1,y1,x2,y2,LineWidth,width,height:integer; begin size:=12; {pixels} angle:=20; {degrees} pi:=3.14159; GetLine(x1,y1,x2,y2,LineWidth); if x1<0 then begin beep; PutMessage('Use the line tool (straight) to select a line first.'); exit; end; MoveTo(x1,y1); LineTo(x2,y2); KillRoi; GetPicSize(width,height); y1:=height-y1; y2:=height-y2; if LineWidth>1 then size:=size*LineWidth*0.5; angle:=(angle/180)*pi; dx:=x1-x2; dy:=y1-y2; if dx=0 then begin if dy>=0 then theta:=pi/2 else theta:=3/2*pi end else begin theta:=arctan(dy/dx); if dx<0 then theta:=theta+pi; end; moveto(x2,height-y2); lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle))); moveto(x2,height-y2); lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle))); end; macro 'Clear Outside [C]' {Erase region outside current selection to background color.} begin Copy; SelectAll; Clear; RestoreRoi; Paste; KillRoi; end; macro 'Change Colors'; { Changes the value of pixels in the image that are in the current foreground color to the current background color. Use Undo if you don't like the result. } var SavePixel,foreground,background:integer; begin SavePixel:=GetPixel(0,0); MakeRoi(0,0,1,1); Fill; foreground:=GetPixel(0,0); Clear; background:=GetPixel(0,0); PutPixel(0,0,SavePixel); PutMessage('Pixels in the foreground color (',foreground:1,') will be changed to the background color (',background:1,').'); ChangeValues(foreground,foreground,background); end; macro 'Change ValuesÉ'; var v1,v2:integer; begin v1:=GetNumber('Change pixels with this value:',255); v2:=GetNumber('to this value:',254); ChangeValues(v1,v1,v2); end; macro 'Fix Pseudocolors'; begin ChangeValues(0,0,1); ChangeValues(255,255,254); end; macro 'Remove Isolated Black Lines'; var width,height,value,x,y,xstart,ystart:integer; begin GetRoi(xstart,ystart,width,height); if width=0 then begin PutMessage('This macro requires a retangular selection'); exit; end; for y:=ystart to ystart+height-1 do begin if GetPixel(width div 2,y)=255 then for x:=xstart to xstart+width-1 do PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2); end; KillRoi; end; macro 'Make Mosaic'; var n:integer; begin SaveState; n:=GetNumber('Cell Size(pixels square):',8); Duplicate('Mosaic'); SetScaling('Nearest; Same Window'); ScaleSelection(1/n,1/n); RestoreRoi; ScaleSelection(n,n); RestoreState; end; macro 'Draw Grid...'; var x, y, xinc, yinc, width, height:integer; scale, x, y, xinc, yinc: real; unit, prompt: string; begin GetPicSize(width, height); GetScale(scale, unit); prompt := concat('Spacing (', unit, '):'); xinc := GetNumber(prompt, 10) * scale; yinc := xinc; x := 0; y := 0; repeat x := x + xinc; y := y + yinc; moveto(0, round(y)); lineto(width, round(y)); moveto(round(x), 0); lineto(round(x), height); until (x > width) and (y > height); end; macro 'Make 256x256 Selection [S]'; {Creates a 256x256 selection centered on the image.} var w,h:integer; begin GetPicSize(w,h); MakeRoi((w-246)/2,(h-256)/2, 256, 256); end; macro 'Position fixed size ROI'; var width,height,x,y:integer; begin width:=100; height:=100; repeat GetMouse(x,y); MakeRoi(x-width/2,y-height/2,width,height); DrawBoundary; Undo; until button; end; macro 'Flip ROI Horizontally'; { Creates a "mirror image" of the current ROI. It opens a temporary blank window, transfers the ROI to that window, draws its outline, flips the contents horizontally, creates a new marching ants ROI using the AutoOutline command, restores the flipped ROI to the original window, and then deletes the temporary window. } var hloc,vloc,width,height,pid1,pid2:integer; begin RequiresVersion(1.55); GetRoi(hloc,vloc,width,height); if width=0 then begin PutMessage('This macro requires a selection'); exit; end; SaveState; MoveRoi(-hloc,-vloc); KillRoi; SetNewSize(width+1,height); SetForegroundColor(255); SetBackgroundColor(0); pid1:=PidNumber; MakeNewWindow('Temp'); RestoreRoi; DrawBoundary; SelectAll; FlipHorizontal; KillRoi; AutoOutline(0,height/2); pid2:=PidNumber; SelectPic(pid1); RestoreRoi; SelectPic(pid2); Dispose; RestoreState; end; macro '(-' begin end; macro 'Make CircleÉ [M]'; var x1,x2,y1,y2,top,left,width,height: integer; xcenter, ycenter: integer; d, scale, default: real; unit, prompt: string; begin GetLine(x1,y1,x2,y2,width); if x1<0 then begin PutMessage('Click with line selection tool to define center.'); exit; end; xcenter:=x1+(x2-x1)/2; ycenter:=y1+(y2-y1)/2; GetScale(scale, unit); if unit='pixel' then unit:='pixels'; default:=50/scale; prompt:=concat('Diameter (', unit:1:2, '):'); d:=GetNumber(prompt, default); d:=d*scale; MakeOvalROI(xcenter-d/2, ycenter-d/2, d, d); end; macro 'Make Circle from Line'; var x1,x2,y1,y2,top,left,width,height:integer; xcenter,ycenter,radius:integer; begin GetLine(x1,y1,x2,y2,width); if x1<0 then begin PutMessage('This macro requires a line selection.'); exit; end; xcenter:=x1+(x2-x1)/2; ycenter:=y1+(y2-y1)/2; radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2; MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2); end; macro 'Define Upper Left [1]'; var x1,y1,x2,y2,LineWidth:integer; begin GetLine(x1,y1,x2,y2,LineWidth); if x1<0 then begin PutMessage('Click with line selection tool to define upper left corner of ROI.'); exit; end; RoiLeft:=x1+(x2-x1)/2; RoiTop:=y1+(y2-y1)/2; end; macro 'Define Lower Right and Create ROI [2]'; var x1,y1,x2,y2,LineWidth:integer; begin GetLine(x1,y1,x2,y2,LineWidth); if x1<0 then begin PutMessage('Click with line selection tool to define lower right corner of ROI.'); exit; end; RoiRight:=x1+(x2-x1)/2; RoiBottom:=y1+(y2-y1)/2; if (RoiLeft=RoiRight) and (RoiTop=RoiBottom) then begin PutMessage('Upper left and bottom right are the same.'); exit; end; MakeRoi(RoiLeft,RoiTop,RoiRight-RoiLeft,RoiBottom-RoiTop) end; macro 'Draw File Name in each Image'; var i: integer; begin SaveState; SetForegroundColor(255); for i := 1 to nPics do begin SelectPic(i); MoveTo(10,12); Write(WindowTitle); end; RestoreState; end;