macro 'Unsharp Mask'; var I, pid1, pid2: integer; begin pid1 := PidNumber; Duplicate(concat(WindowTitle, ' (Unsharp Mask)')); pid2 := PidNumber; for i := 1 to 8 do filter('smooth more'); ImageMath('subract', pid1, pid2, 1, 0, pid2); end; macro 'Make Bas-relief' begin Duplicate('Bas-relief'); SelectAll; Smooth; Copy; MoveRoi(-1,-1); {Try MoveRoi(1,1) for a different effect.} Paste; Subtract; EnhanceContrast; ApplyLUT; end; macro 'Normalize to 0 to 255'; { Similar to enhance contrast but alters the pixel data instead of generating a LUT function. Can be used to normalize multiple images to the same brightness scale when creating a poster. } var min,max,count:integer; begin ResetCounter; Measure; count:=rCount; min :=rMin[count]; max:=rMax[count]; KillROI; SelectAll; AddConstant(-min); Max:=Max-min; MultiplyByConstant(255/max); ShowMessage('Results are best if a ROI is drawn before the macro is executed'); end; macro 'Subtract Background'; var i,Corrected,smoothf:integer; scalef:real; begin scalef:=.125; smoothf:=10; SelectAll; Duplicate('Background Corrected'); Corrected:=PicNumber; Duplicate('Background'); SetScaling('Bilinear'); ScaleSelection(scalef,scalef); RestoreRoi; for i:=1 to smoothf do begin SetOption; Smooth; end; ScaleSelection(1/scalef,1/scalef); ScaleMath(false); SelectAll; Copy; SelectPic(Corrected); Paste; Subtract; ResetGrayMap; end; macro 'Make Variance ImageÉ'; { Divides an image into cells, replacing all pixels in each cell by the standard deviation for that cell. You will need to enter the cell width, cell height, and estimated maximum standard deviation. The actual maximum standard deviation is displayed when the macro finishes. } var x,y,xinc,yinc,width,height:integer; cellwidth,cellheight,value:integer; maxstd,max:real; begin RequiresVersion(1.58); GetPicSize(width,height); xinc:=GetNumber('Cell Width:', 16, 0); yinc:=GetNumber('Cell Height:', xinc, 0); max:=GetNumber('Max std dev:', 50); maxstd:=0; y:=0; repeat cellheight:=yinc; if (y+cellheight)>height then cellheight:=height-y; x:=0; repeat cellwidth:=xinc; if (x+cellwidth)>width then cellwidth:=width-x-1; MakeRoi(x,y,cellwidth,cellheight); measure; if rStdDev[rcount]>maxstd then maxstd:=rStdDev[rcount]; value:=trunc(rStdDev[rcount]/max*253)+1; if value>254 then value:=254; SetForeground(value); fill; ResetCounter; x:=x+xinc; until x >= width; y:=y+yinc; until y >= height; KillRoi; ShowMessage('max std dev=',maxstd:1:2); end; procedure Square(scale:real) { Applies a parabolic LUT} var i,y:integer; begin for i:= 1 to 254 do begin y:= (i-127)*(i-127)*scale/64.25; if y > 255 then y:=255; RedLUT[i]:=y; GreenLUT[i]:= y; BlueLUT[i]:=y; end; UpdateLUT; ApplyLUT; end; procedure ImpulseFilter; {This is an impulse filter (all zeros with a 1 in the middle) minus a 5x5 average (5x5 1's divided by 25), then scaled so the smallest tap is 1 (i.e. times 25).} begin RequiresVersion(1.53); NewTextWindow('5x5 mean diff',150,140); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 24 -1 -1'); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 -1 -1 -1'); ScaleConvolutions(true); Convolve(''); Dispose; end; macro 'Find Variance [V]' { Finds the "instantaneous" variance, the variance of a pixel in its neighborhood. var(i) = (x(i) - avg(x))^2/(N-1) where avg(x) is the average of values in a neighborhood (say 5x5) around a pixel x(i), and N is the number of pixels in the neighborhood (25). Let's disregard the /(N-1) operation for now -- it's merely a scaling operation. x(i) - avg(x) can be found by convolving with an appropriate filter.The squaring operation can be done with a parabolic LUT. This LUT can include the scaling operation for those who need calibrated results (modify the argument to "Square" to be other than 1.0 to scale the LUT). Contributed by Norm Hurst (norm_hurst@maca.sarnoff.com). } begin ImpulseFilter; {impulse minus 5x5 average} Square(1.0); {Adjust argument to scale the LUT} end; macro 'Impulse Filter'; begin RequiresVersion(1.53); ImpulseFilter; end; macro '3x3 Sharpen [F]'; begin NewTextWindow('3x3 sharpen',120,120); writeln('-1 -1 -1'); writeln('-1 9 -1'); writeln('-1 -1 -1'); Convolve(''); Dispose end; macro '5x5 Laplace'; begin NewTextWindow('5x5 laplace',140,120); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 24 -1 -1'); writeln('-1 -1 -1 -1 -1'); writeln('-1 -1 -1 -1 -1'); Convolve(''); Dispose; end; macro '7x7 Gauss'; begin NewTextWindow('7x7 gauss',160,140); writeln(' 1 1 2 2 2 1 1'); writeln(' 1 2 2 4 2 2 1'); writeln(' 2 2 4 8 4 2 2'); writeln(' 2 4 8 16 8 4 2'); writeln(' 2 2 4 8 4 2 2'); writeln(' 1 2 2 4 2 2 1'); writeln(' 1 1 2 2 2 1 1'); Convolve(''); Dispose; end; procedure Hat13; begin NewTextWindow('13x13 hat',350,200); writeln(' 0 0 0 0 0 -1 -1 -1 0 0 0 0 0'); writeln(' 0 0 0 -1 -1 -2 -2 -2 -1 -1 0 0 0'); writeln(' 0 0 -2 -2 -3 -3 -4 -3 -3 -2 -2 0 0'); writeln(' 0 -1 -2 -3 -3 -3 -2 -3 -3 -3 -2 -1 0'); writeln(' 0 -1 -3 -3 -1 4 6 4 -1 -3 -3 -1 0'); writeln('-1 -2 -3 -3 4 14 19 14 4 -3 -3 -2 -1'); writeln('-1 -2 -4 -2 6 19 24 19 6 -2 -4 -2 -1'); writeln('-1 -2 -3 -3 4 14 19 14 4 -3 -3 -2 -1'); writeln(' 0 -1 -3 -3 -1 4 6 4 -1 -3 -3 -1 0'); writeln(' 0 -1 -2 -3 -3 -3 -2 -3 -3 -3 -2 -1 0'); writeln(' 0 0 -2 -2 -3 -3 -4 -3 -3 -2 -2 0 0'); writeln(' 0 0 0 -1 -1 -2 -2 -2 -1 -1 0 0 0'); writeln(' 0 0 0 0 0 -1 -1 -1 0 0 0 0 0'); Convolve(''); Dispose; end; macro '13x13 Hat - scaled'; begin ScaleConvolutions(true); Hat13; end; macro '13x13 Hat - clipped'; begin ScaleConvolutions(false); Hat13; end; macro 'Unweighted SmoothingÉ'; var n, row,column:integer; begin n:=GetNumber('Kernel Size[3-63]:',7); if (n<3) or (n>63) then begin PutMessage('N must be in the range 3-63.'); exit; end; NewTextWindow('nxn smooth',300,100); for row:=1 to n do begin for column:=1 to n do write(' 1'); writeln; end; Convolve(''); Dispose; end; macro 'Grayscale Erosion'; var iterations,i:integer; begin iterations:=GetNumber('Iterations:',1); for i:=1 to iterations do filter('min'); end; macro 'Grayscale Dilation'; begin repeat filter('max'); until button; end; macro 'Shadow Demo'; begin Shadow('N'); wait(1); Undo; Shadow('NE'); wait(1); Undo; Shadow('E'); wait(1); Undo; Shadow('SE'); wait(1); Undo; Shadow('S'); wait(1); Undo; Shadow('SW'); wait(1); Undo; Shadow('W'); wait(1); Undo; Shadow('NW'); wait(1); Undo; Undo; end; macro 'Fractal Dilation'; var iterations,i:integer; begin iterations:=24; ResetCounter; SetUser1Label('Count'); SetOptions('User1'); SetBinaryCount(1); Measure; rUser1[rCount]:=histogram[255]; UpdateResults; for i:=1 to iterations do begin Dilate; Measure; rUser1[rCount]:=histogram[255]; UpdateResults; end; ShowResults; end; macro '(---'; begin end; macro 'Smooth [1]'; begin filter('smooth') end; macro 'Smooth More [2]'; begin filter('smooth more') end; macro 'Sharpen [3]'; begin filter('sharpen') end; macro 'Sharpen More [4]'; begin filter('sharpen more') end; macro 'Sobel [5]'; begin filter('sobel') end; macro 'Trace Edges [6]'; begin filter('smooth'); filter('sobel'); AutoThreshold; MakeBinary end; macro 'Median [7]'; begin filter('median') end; macro 'Dither [8]'; begin filter('dither') end; macro '(---'; begin end; macro '5x5'; { Note: you only see the open file dialog box the first time one of these macros is called, since Image keeps track of the folder containing the convolution kernels. } begin convolve('Hat(5x5)'); end; macro '7x7' begin convolve('Hat(7x7)'); end; macro '9x9]' begin convolve('Hat(9x9)'); end;