{Macros for use with "NIH Image: Use In Fluorescence And Confocal
Microscopy" by Harvey J. Karten}
{The following Macros should be copied to a separate file and saved in a
simple text format, in order to be accessible to NIH Image.}
{Copy all the text from this point to the end of the file into a text file.}
{The resultant file should be saved as "Confocal Macros"}
{If you want these macros to load automatically when you start NIH Image,}
{rename them as "Image Macros" and place them in the same directory}
{that contains the program NIH Image.}
{BEGIN Macros HERE}
var
top,left,n,w,h,width,height:integer;
name: string;
{Global variables}
var
n,nFrames:integer; {Global variable used by integration macros}
mag, barlength: real; {objective magnification, size of scale bar to
use (m)}
camerapid: integer; {PID of camera window}
bgpid: integer; {background window}
bgsub: boolean; {whether to subtract background}
tsoff: boolean; {whether to omit timestamp from captured images}
asoff: boolean; {whether the AutoShutter feature is off}
shopen: boolean; {whether we think the shutter is open}
tlperiod: real; {timelapse period}
name: string;
StackName:string;
OriginalStack,FirstSlice:Integer;
LastSlice,NextSlice,PartialStack:Integer;
left,top,x1,y1,x2,y2,lw:Integer;
{Error(s) issues the error message S and terminates the macro.}
procedure Error(s:string);
begin
PutMessage(s); exit;
end;
procedure CheckForStack;
begin
if nSlices=0 then begin
PutMessage('This window is not a stack');
exit;
end;
end;
procedure CheckForSelection;
var x1,y1,x2,y2,lw,l,t,w,h:integer;
begin
GetRoi(l,t,w,h);
GetLine(x1,y1,x2,y2,lw);
if (w=0) and (x1nSlices) then Error('Not a valid slice number.');
default:=nSlices;
if smart and (first=1) and (SliceNumber > 1) then default:=SliceNumber;
last:=GetNumber('Last slice:',default);
if (lastnSlices) then Error('Not a valid range of slices.');
end;
procedure GetSliceSequence(smart:boolean);
begin
GetSliceRange(smart);
step:=GetNumber('Step:', 1);
if (step1 then begin
SliceSpacing :=GetNumber('Section Interval:',0.35,2);
ActualSpacing:= (SliceSpacing*PixPerMicron);
SetSliceSpacing(ActualSpacing);
exit; end;
end;
procedure Animate;
{Not as fast as the Animate command under the Stacks Menu (Command+=)}
var
i,delay:integer;
begin
CheckForStack;
RequiresVersion (1.50);
i:=0;
delay:=0.1;
repeat
i:=i+1;
if i>nSlices then i:=1;
Wait(delay);
SelectSlice(i);
if KeyDown('shift') then delay:=1.5*delay;
if delay>1 then delay:=1;
if KeyDown('control') then delay:=0.66*delay;
if KeyDown('option') then exit;
ShowMessage('delay=', delay:4:6);
until button;
end;
macro '[M] Get Rectangle'; begin SelectTool('rectangle'); end;
macro '[6] 640x480 ROI';
begin
MakeRoi(0,0,640,480);
end;
macro '[P] Print Video';
begin
CallExport('TV-3 Module');
end;
macro '[Q] Get Path';
var
wPath, sPath, pPath: string;
name, FullPath, FileType, folder: string;
FileSize: integer;
begin
name := WindowTitle; {Grab name before before opening window}
wPath := GetPath('window'); {Grab path before before opening window}
SaveState;
SetFont('Geneva');
SetFontSize(12);
NewTextWindow('Path:',550,75);
if wPath = '' then begin
writeln('Image not saved with unique FileName, ');
writeln(' or No opened image or text window');
end else begin
FullPath := concat(wPath, name);
{writeln('Active window path = ');}
writeln( FullPath);
SelectAll;
Copy;
end;
end;
RestoreState;
end;
macro '(-';begin end;
procedure ShowBioRadInfo(InfoOffset: integer);
{Displays the contents of the 'header' at}
{the end of Biorad MRC 600/1000 Lasersharp 1024 single section files.}
{Needs correction of Offset values to properly read Z-series info}
var
MaxInfoSize,offset:integer;
ch, title:string;
begin
MaxInfoSize:=4096;
SetCustom(MaxInfoSize, 1, InfoOffset);
SetImport('8-bit'); {Don't invert}
Import('');
GetRow(0,0,MaxInfoSize);
Dispose;
SaveState;
title := concat(WindowTitle, '.Info');
NewTextWindow(title, 500,400);
SetCursor('Watch');
SetFont('Monaco');
SetFontSize(12);
for i:=0 to MaxInfoSize-1 do begin
offset:=i mod 96;
if offset=0 then writeln;
ch:=chr(LineBuffer[i]);
if (offset=2) and (ord(ch)=0) then exit;
if (offset>=16) and (offset=32) and (ord(ch)512) or (height1) then begin
Dispose;
PutMessage('Please to not change width, height, etc. in the Import dialog box.');
exit;
end;
width:=GetPixel(0,0)+GetPixel(1,0)*256;
height:=GetPixel(2,0)+GetPixel(3,0)*256;
nImages:=GetPixel(4,0)+GetPixel(5,0)*256;
Dispose;
hdrsize:= 76;
picsize:=width*height;
if (width2048) or (height2048) or
(nImages256) then begin
PutMessage('This does not seem to be a Biorad MRC 600/1000 Z Series file.');
exit;
end;
start:=GetNumber('Starting image:',1);
offset:=HdrSize+(start-1)*PicSize;
SetImport('8-bit, Invert');
SetCustom(width,height,offset,nimages);
Import('');
ShowBioRadInfo(HdrSize + nImages * width * height);
CalibrateImage;
end;
macro '[F2] Calibrate Image';
begin CalibrateImage; end;
macro '[F3] Z Projection';
Begin
SetProjection('Initial Angle',0);
SetProjection('Total Rotation',0);
SetProjection('Rotation Increment', 0);
SetProjection('Interior Depth-Cueing', 0);
SetProjection('Y-Axis');
SetProjection('Brightest');
SetProjection('Save Projections', false);
SetProjection('Minimize Size', false);
SetDensitySlice(0,254);
Project;
end;
macro'[F4] Make Stereo Views';
Begin
SetProjection('Initial Angle',348);
SetProjection('Total Rotation',24);
SetProjection('Rotation Increment', 6);
SetProjection('Interior Depth-Cueing', 0);
SetProjection('Y-Axis');
SetProjection('Brightest');
SetProjection('Save Projections', false);
SetProjection('Minimize Size', false);
SetDensitySlice(0,254);
Project;
Animate;
end;
macro '[F5] RGB to Indexed ';
begin
RGBToIndexed('System, Dither');
end;
macro '[W] Swap Red_Green';
begin
CheckforStack;
ChooseSlice(1);
SelectAll;
Copy;
DeleteSlice;
SetBackground(255);
AddSlice;
Paste;
KillRoi;
RGBToIndexed('System, Dither');
end;
macro '[S] Merge Split BioRAD';
var
OriginalPic,w,h,rgb: integer;
{name: string;}
begin
OriginalPic:= PidNumber;
SelectPic(OriginalPic);
GetPicSize(w,h);
MakeRoi(0,0,w/2,h);
Copy;
SetNewSize(w/2,h);
name := GetString('New Stack Name', 'RGB');
MakeNewStack(name);
rgb:=PicNumber;
SelectPic(rgb);
Paste;
SetBackground(255);
AddSlice;
AddSlice;
SelectPic(OriginalPic);
MakeRoi(w/2,0,w/2,h);
Copy;
KillRoi;
SelectPic(rgb);
SelectSlice(2);
Paste;
SetBackGround (255);
RGBToIndexed('System,Dither');
end;
macro ' Color Merge Two Images';
var
i,w1,w2,h1,h2,rgb:integer;
begin
RequiresVersion(1.50);
SaveState;
if nPics2 then begin
PutMessage('This macro operates on exactly two images.');
exit;
end;
SelectPic(1);
GetPicSize(w1,h1);
SelectPic(2);
GetPicSize(w2,h2);
if (w1w2) or (h1h2) then begin
PutMessage('The two images must have the same width and height.');
exit;
end;
SetNewSize(w1,h2);
SetBackground(255);
MakeNewStack('RGB');
AddSlice;
AddSlice;
rgb:=PicNumber;
SelectPic(1);
SelectAll;
Copy;
SelectPic(rgb);
SelectSlice(1);
Paste;
SelectPic(2);
SelectAll;
Copy;
SelectPic(rgb);
SelectSlice(2);
Paste;
RGBToIndexed('Custom');
end;
macro ' Color Merge Two Stacks';
var
i,w1,w2,h1,h2,d1,d2,d3:integer;
rgb,merged:integer;
begin
RequiresVersion(1.50);
SaveState;
if nPics2 then begin
PutMessage('This macro operates on exactly two stacks.');
exit;
end;
ChoosePic(1);
GetPicSize(w1,h1);
d1:=nSlices;
ChoosePic(2);
GetPicSize(w2,h2);
d2:=nSlices;
if (d1=0) or (d2=0) then begin
PutMessage('Both images must be stacks.');
exit;
end;
if d1>=d2
then d3:=d2
else d3:=d1;
if (w1w2) or (h1h2) then begin
PutMessage('The two stacks must have the same width and height.');
exit;
end;
SetNewSize(w1,h2);
SetBackground(255);
MakeNewStack('RGB');
AddSlice;
AddSlice;
rgb:=PicNumber;
SetPalette('System');
MakeNewStack('Merged');
merged:=PicNumber;
for i:=1 to d3 do begin
ChoosePic(1);
ChooseSlice(i);
SelectAll;
Copy;
{Following line was deleted, as it makes value of 'd3' erroneous when
used in loop}
{DeleteSlice;}
ChoosePic(rgb);
ChooseSlice(1);
SelectAll;
Paste;
{Invert;}
ChoosePic(2);
ChooseSlice(i);
SelectAll;
Copy;
{Following line was deleted, for same as previous reason above}
{DeleteSlice;}
ChoosePic(rgb);
ChooseSlice(2);
SelectAll;
Paste;
{Invert;}
SelectPic(rgb);
RGBToIndexed('System,Dither');
SelectAll;
Copy;
Dispose;
ChoosePic(merged);
Paste;
if id3 then AddSlice;
end;
ChoosePic(rgb);
Dispose;
RestoreState;
end;
macro ' Separate SplitScreen Z Stack';
var
LeftStack,RightStack,OriginalStack,w,h,i,OriginalnSlices:integer
begin
{set up parameters for new stacks}
CheckForStack;
OriginalStack:= PidNumber;
ChoosePic(OriginalStack);
OriginalnSlices:=nSlices;
GetPicSize(w,h);
SetNewSize(w/2,h);
SetBackground(255);
name := GetString('New Stack Name', 'RGB');
MakeNewStack(name,' Left Stack');
LeftStack:=PidNumber;
MakeNewStack(name,' Right Stack');
RightStack:=PidNumber;
{OK, now you have two stacks, Left Stack and Right Stack}
{PutMessage('This Stack has ',nSlices,' slices. Slice =',i);}
for i:= 1 to OriginalnSlices do begin
ChoosePic(OriginalStack);
SelectSlice(i);
MakeRoi(0,0,w/2,h);
Copy;
ChoosePic(LeftStack);
ChooseSlice(i);
Paste;
SetBackground(255);
AddSlice;
ChoosePic(OriginalStack);
MakeRoi(w/2,0,w/2,h);
Copy;
KillRoi;
ChoosePic(RightStack);
SelectSlice(i);
Paste;
SetBackground(255);
AddSlice;
KillRoi;
{ SelectPic(OriginalStack);}
end;
end;
macro ' Merge Two Stacks';
{
Combines two stacks(w1xh1xd1 and w2xh2xd2) to create a new
w1+w2 x max(h1,h2) x max(d1,d2) stack. For example, a 256x256x40
and a 256x256x30 stack would be combined into one 512x256x40 stack.
}
var
i,w1,w2,w3,h1,h2,h3,d1,d2,d3:integer;
begin
SaveState;
if nPics2 then begin
PutMessage('This macro operates on exactly two stacks.');
exit;
end;
SelectPic(1);
GetPicSize(w1,h1);
d1:=nSlices;
SelectPic(2);
GetPicSize(w2,h2);
d2:=nSlices;
if d1>=d2
then d3:=d1
else d3:=d2;
if d3=0 then begin
PutMessage('Both images must be stacks.');
exit;
end;
w3:=w1+w2;
if h1>=h2
then h3:=h1
else h3:=h2;
SetNewSize(w3,h3);
MakeNewStack('Merged');
for i:=1 to d3 do begin
SelectPic(1);
SelectSlice(1);
SelectAll;
Copy;
DeleteSlice;
SelectPic(3);
MakeRoi(0,0,w1,h1);
Paste;
SelectPic(2);
SelectSlice(1);
SelectAll;
Copy;
DeleteSlice;
SelectPic(3);
MakeRoi(w1,0,w2,h2);
Paste;
if i keys and hit key 'F'. This
will store slicenumber as variable FirstSlice.
Easily modified to inform user of size of resulting Stack in bytes.
Proceed macro Choose LastSlice.}
}
begin
CheckForStack;
StackName:=WindowTitle;
OriginalStack:=PidNumber;
GetRoi(left,top,width,height);
if (width=0) then
begin
SelectAll;
GetPicSize(width,height);
KillRoi;
end;
{CheckForSelection;}{Replace following SelectAll with ROI?}
FirstSlice:=SliceNumber;
ShowRange;
{SelectAll;}
end;
macro '[F11] Choose Last Slice';
{Select the last slice that is to be used to end the new stack
and hit key 'L'}
begin
CheckforStack;
OriginalStack:=PidNumber;
StackName:=WindowTitle;
LastSlice:=SliceNumber;
ShowRange;
end;
macro ' Show range of slices';
begin
ShowMessage('"' StackName'"' ,' has PidNumber = ', OriginalStack,
'\ Image Size = 'width ' x ' height ' pixels' ';\ Number of Slices = ',
nSlices, ';\First Slice # = ', FirstSlice,';\ Last Slice # = ' LastSlice);
If FirstSlice>LastSlice then
PutMessage('Selection of First Slice must precede Last Slice');
end;
procedure CheckSliceRange;
Begin
If FirstSlice>LastSlice then begin
PutMessage('Not a valid range of slices. First Slice must precede Last Slice in Stack');
exit;
end;
end;
macro '[F12] Z-Projection of Partial Stack';
begin
CheckSliceRange;
SetNewSize(width,height);
SetBackground(255);
MakeNewStack('Partial Stack');
PartialStack:=PidNumber;
Begin
SelectPic(OriginalStack);
For NextSlice := FirstSlice to LastSlice do begin
SelectSlice(NextSlice);
MakeROI(left,top,width,height);
Copy;
SelectPic(PartialStack);
Paste;
AddSlice;
SelectPic(OriginalStack);
NextSlice:=NextSlice+1;
end;
Killroi;
end;
Begin
SelectPic(PartialStack);
CheckForStack;
SetProjection('Initial Angle',0);
SetProjection('Total Rotation',0);
SetProjection('Rotation Increment', 0);
SetProjection('Interior Depth-Cueing', 0);
SetProjection('Y-Axis');
SetProjection('Brightest');
SetProjection('Save Projections', false);
SetProjection('Minimize Size', false);
SetDensitySlice(0,254);
Project;
end;
end;
macro '(-';
{macro 'Make stack same size as front image [N]';
var
width, height: integer;
name: string;
begin
SaveState;
GetPicSize(width, height);
SelectAll;
Copy;
KillRoi;
SetNewSize(width, height);
name := GetString('New Stack Name', 'stack');
SetBackground(255);
MakeNewStack(name);
Paste;
KillRoi;
RestoreState;
end;}
macro ' Make stack size front image';
var
width, height: integer;
begin
SaveState;
GetPicSize(width, height);
SetNewSize(width, height);
name := GetString('New Stack Name', 'stack');
MakeNewStack(name);
RestoreState;
end;
macro ' MakeStack w_Current Image';
var
w,h:integer;
begin
SelectAll;
GetPicSize(w,h);
SetNewSize(w,h);
Copy;
MakeNewStack('NewStack');
Paste;
KillRoi;
SetBackground(255);
AddSlice;
AddSlice;
SelectSlice(2);
end;
macro ' Add Slice'; begin AddSlice end;
macro '[A] Add Black Slice';
begin
SetBackground(255);
AddSlice;
end;
macro '[D] Delete Slice'; begin DeleteSlice end;
macro '[=] Animate Stack';
{Hit Shift to slow down, Control to speed up and Option to halt}
begin animate;end;
macro '(-' begin; end;
macro ' Autoshutter';
begin
asoff := not asoff;
if asoff then ShowMessage('Autoshutter off.')
else ShowMessage('Autoshutter on.');
end;
procedure CloseShutter;
begin
OpenSerial('9600 baud,no parity,eight data,one stop');
PutSerial(chr(49));
shopen:=false;
end;
procedure OpenShutter;
begin
OpenSerial('9600 baud,no parity,eight data,one stop');
PutSerial(chr(48));
shopen:=true;
end;
procedure TriggerShutter;
begin
OpenSerial('9600 baud,no parity,eight data,one stop');
PutSerial(chr(50));
shopen:=false;
end;
procedure ResetShutter;
begin
OpenSerial('9600 baud,no parity,eight data,one stop');
PutSerial(chr(51));
shopen:=false;
end;
macro '[O] Open Shutter'; begin OpenShutter; end;
macro '[C] Close Shutter'; begin CloseShutter; end;
macro '[T] Trigger Shutter'; begin TriggerShutter; end;
macro '[R] Reset Shutter'; begin ResetShutter; end;
macro '[G] Open Shutter-Grab-Close';
begin
OpenShutter;
StartCapturing;
CloseShutter;
end;
procedure EndIntegration;
begin
CloseShutter;
Exit;
end;
procedure Integrate (mode:string);
var
x,y,delta:integer;
begin
if nFrames=0 then nFrames:=2;
SelectWindow('Camera');
repeat
if button then begin
GetMouse(x,y);
if (x220 then begin
nFrames:=nFrames-delta;
if nFrames240 then nFrames:=240;
ShowHistogram;
end;
SelectWindow('Camera');
end;
AverageFrames(mode, nFrames);
ShowMessage('# Frames Integrated = ',nFrames);
until false;
end;
macro '[F6] Integrate On-chip Using Cohu';
begin
OpenShutter;
Integrate('integrate on-chip'); CloseShutter;
end;
macro '[F7] Integrate One Image on Cohu';
begin
SelectWindow('Camera');
OpenShutter;{Wait(0.1);}
AverageFrames('integrate on-chip',nFrames);
CloseShutter;
{Add code to for TimeStamp on window}
{ShowHistogram;}
ShowMessage('# Frames Integrated = ',nFrames);
end;
{Add macro to Re-Set number of frames to 2}
macro '[2] SetIntegrate:2 Frames';
begin
nFrames:=2;
end;
macro '[F] Show nFrames';
begin
{PutMessage('# Frames Integrated = ',nFrames);}
ShowMessage('# Frames Integrated = ',nFrames);
end;
macro ' Integrate White Light';
begin
Integrate('integrate on-chip');
end;
{Live and Average are fancy context-sensitive macros:
* in the Camera window, Live starts capturing and Average adds to a stack
* in another window with a ROI selected, Live starts a Live paste, and Average
pastes in an averaged picture for the ROI
* in another window with no ROI, Live switches to the Camera window, and starts
capturing
}
macro ' Live';
var l,t,w,h:integer;
begin
GetROI(l,t,w,h);
RequiresVersion(1.53);
if not asoff then OpenShutter;
if (camerapid=0) or (WindowTitle='Camera') or (w=0) then begin
StartCapturing;
camerapid := PidNumber; exit;
end;
{If we get to here, we're in a non-Camera window with a ROI; start Live Paste}
PasteLive;
end;
macro ' Average'; {assumes that Live has been called
already}
var
l,t,w,h,destpid,p:integer;
year,month,day,hour,minute,second,DoW:integer;
camera:boolean;
begin
GetROI(l,t,w,h);
RequiresVersion(1.53);
if not asoff and not shopen then begin
OpenShutter; Wait(.1); {Compensate for SIT's lag time}
end;
destpid:=PidNumber;
camera:=(WindowTitle='Camera');
if camera then begin {try to find the first stack}
p:=0;
repeat
p:=p+1;
Choosepic(p);
until (nSlices>0) or (p>=nPics);
if (nSlices>0) then destpid:=p;
{else leave destpid pointing at Camera, later code will start a new
stack}
Choosepic(camerapid);
end;
if not camera then begin
ChoosePic(camerapid);
if (w>0) then MakeROI(l,t,w,h);
end;
AverageFrames;
if (w=0) then SelectAll;
Copy;
GetTime(year,month,day,hour,minute,second,DoW);
if not asoff then CloseShutter;
SelectPic(destpid);
if (w>0) and not camera then begin {we were in PasteLive mode}
MakeRoi(l,t,w,h); Paste; BkgdSub; exit;
end;
if nSlices>0 then begin
SelectSlice(nSlices);
AddSlice;
end;
if nSlices=0 then begin
if (camera and (w>0)) then SetNewSize(w,h) else SetNewSize(640,480);
MakeNewStack(month:2,'/',day:2,'/',year-1900:2,' ',hour:2,'.',minute:2,'.',second:2);
end;
Paste; BkgdSub;LabelFrame(0,0,not tsoff);
if (camera and (w>0)) then SelectPic(camerapid);
end;
{
Flash to Stack flashes once and puts the averaged picture in the first stack
that it finds. If there's no stack, it creates one. If you frame a ROI in the
camera window, only the ROI contents will be saved in the stack...
}
macro '[F8] Flash to Stack ';
var
l,t,w,h,destpid,p:integer;
year,month,day,hour,minute,second,DoW:integer;
camera:boolean;
begin
GetROI(l,t,w,h);
RequiresVersion(1.53);
destpid:=PidNumber;
camera:=(WindowTitle='Camera');
if (camerapid=0) then begin
Capture; camerapid := PidNumber;
if (destpid=0) then destpid:=camerapid else ChoosePic(destpid);
end;
if camera then begin {try to find the first stack}
p:=0;
repeat
p:=p+1;
ChoosePic(p);
until (nSlices>0) or (p>=nPics);
if (nSlices>0) then destpid:=p;
{else leave destpid pointing at Camera, later code will start a new
stack}
Choosepic(camerapid);
end;
if not camera then begin
ChoosePic(camerapid);
if (w>0) then MakeROI(l,t,w,h) else SelectAll;
end;
OpenSerial('9600 baud'); StopCapturing; {in case we're live}
{wait for even frame of the video signal, then flash and grab}
repeat until ((BitAnd(Scion[3],48)=0));
PutSerial(chr(48));
{AverageFrames('Video Rate Capture',2);}
{test integration with shutter}
Integrate('integrate on-chip');
CloseShutter;
GetTime(year,month,day,hour,minute,second,DoW);
if (w=0) then SelectAll; Copy;
SelectPic(destpid);
if nSlices>0 then begin
SelectSlice(nSlices);
AddSlice;
end;
if nSlices=0 then begin
if (camera and (w>0)) then SetNewSize(w,h) else SetNewSize(640,480);
MakeNewStack(month:2,'/',day:2,'/',year-1900:2,' ',hour:2,'.',minute:2,'.',second:2);
end;
Paste; BkgdSub; LabelFrame(0,0,not tsoff);
if (camera and (w>0)) then SelectPic(camerapid);
end;
macro '(-'; begin; end;
macro ' Smooth Stack';
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
SetOption; Smooth;
end;
end;
macro ' Sharpen Stack';
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
SetOption; Smooth;
SetOption; Sharpen;
end;
end;
macro '[I] Invert Stack';
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
Invert;
end;
end;
macro ' Reduce Noise Stack';
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
ReduceNoise;
end;
end;
macro '[L] Apply LUT to Stack ';
var
i,stack,slices:integer;
begin
CheckForStack;
stack:=PicNumber;
slices:=nSlices;
Duplicate('Temp');
for i:= 1 to slices do begin
SelectPic(stack);
SelectSlice(i);
ApplyLut;
SelectPic(nPics);
if islices then PropagateLut;
end;
SelectPic(nPics);
Dispose;
end;
macro '[0] Remove 0 and 255 from Stack';
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
ChangeValues(0,0,1);
ChangeValues(255,255,254);
end;
end;
procedure flip(vertical:boolean);
var
i:integer;
begin
CheckForStack;
for i:= 1 to nSlices do begin
SelectSlice(i);
if vertical
then FlipVertical
else FlipHorizontal;
end;
end;
macro ' Flip Stack Vertical'; begin flip(true) end;
macro ' Flip Stack Horizontal'; begin flip(false) end;
{procedure CheckForSelection;
var
x1,y1,x2,y2,LineWidth:integer;
begin
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
GetLine(x1,y1,x2,y2,LineWidth);
if (RoiWidth=0) or (x1>=0) then begin
PutMessage('Please make a rectangular selection.');
exit;
end;
end;}
macro ' Clear Outside Stack';
var
i:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
begin
CheckForStack;
CheckForSelection;
for i:= 1 to nSlices do begin
SelectSlice(i);
Copy;
SelectAll;
Clear;
RestoreRoi;
Paste;
RestoreRoi;
end;
end;
procedure CropAndScale(fast:boolean; angle:real);
var
i,OldStack,NewStack:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
N,NewWidth:integer;
ScaleFactor:real;
OneToOne:boolean;
begin
CheckForStack;
CheckForSelection;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
SaveState;
OldStack:=PicNumber;
N:=nSlices;
ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
OneToOne:=ScaleFactor=1.0;
NewWidth:=round(RoiWidth*ScaleFactor);
if odd(NewWidth) then begin
NewWidth:=NewWidth-1;
ScaleFactor:=NewWidth/RoiWidth;
end;
SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
MakeNewStack('NewStack');
NewStack:=PicNumber;
if not OneToOne then begin
if fast
then SetScaling('Nearest; Create New Window')
else SetScaling('Bilinear; Create New Window');
end;
SelectPic(OldStack);
for i:= 1 to N do begin
SelectSlice(i);
if OneToOne and (angle=0.0) then Duplicate('Temp')
else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
SelectAll;
Copy;
SelectPic(NewStack);
if i1 then AddSlice;
Paste;
SelectPic(nPics);
Dispose; {Temp}
SelectPic(OldStack);
{DeleteSlice;}
end;
{Dispose;} {OldStack}
RestoreState;
SelectPic(NewStack);
Animate;
end;
macro ' [E] Crop and Scale-Fast';
begin CropAndScale(true, 0); end;
macro ' Crop and Scale-Smooth';
begin CropAndScale(false, 0); end;
procedure Rotate(left:boolean);
var
i,OldStack,NewStack:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
N,NewWidth:integer;
ScaleFactor,SliceSpacing:real;
OneToOne:boolean;
begin
CheckForStack;
SelectAll;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
OldStack:=PicNumber;
SliceSpacing:=GetSliceSpacing;
N:=nSlices;
SetNewSize(RoiHeight,RoiWidth);
MakeNewStack('Stack');
if SliceSpacing>0 then SetSliceSpacing(SliceSpacing);
NewStack:=PicNumber;
SelectPic(OldStack);
for i:= 1 to N do begin
SelectSlice(1);
if left
then RotateLeft(true)
else RotateRight(true);
SelectAll;
Copy;
SelectPic(NewStack);
if i1 then AddSlice;
Paste;
ChoosePic(nPics);
Dispose;
SelectPic(OldStack);
DeleteSlice;
end;
Dispose;
end;
macro ' Rotate Left'; begin rotate(true) end;
macro ' Rotate Right'; begin rotate(false) end;
macro ' Rotate';
var
angle:real;
begin
angle:=GetNumber('Angle(-180.0..180.0):',45.0);
CropAndScale(false, angle);
end;
procedure DoReslicing(horizontal:boolean);
var
OutputSpacing,stack1,stack2,width,height:integer;
RoiLeft,RoiTop,RoiWidth,RoiHeight,loc,max:integer;
InputSpacing:real;
FirstTime:boolean;
begin
CheckForStack;
CheckForSelection;
SaveState;
SetBackground(0);
SetBackground(255);
stack1:=PicNumber;
InputSpacing:=GetSliceSpacing;
if InputSpacingmin) and (i 63) do
d := GetNumber('Amount of color',20);
for i := d*2 to 127 do begin
j := 255 - i;
RedLUT[i] := j + d;
GreenLUT[i] := j + d;
BlueLUT[i] := j - d*2;
RedLUT[j] := i - d*2;
GreenLUT[j] := i + d;
BlueLUT[j] := i + d;
end;
UpdateLUT;
end;
macro '[U] Move Slice Up';
var
lower,upper:integer;
begin
GetThresholds(lower,upper);
lower:=lower-1;
upper:=upper-1;
if lower254 then lower:=254;
if upper254 then upper:=254;
SetDensitySlice(lower,upper);
ShowMessage(lower:4,upper:4)
end;
macro '[Y] Move Slice Down ';
var
lower,upper:integer;
begin
GetThresholds(lower,upper);
lower:=lower+1;
upper:=upper+1;
if lower254 then lower:=254;
if upper254 then upper:=254;
SetDensitySlice(lower,upper);
ShowMessage(lower:4,upper:4)
end;