{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 (x1<0) then Error('Please make a rectangular selection.');
end;
procedure ShowRange;
{Display file name, PidNumber, number of slices in stack, first and last
slices to be used.}
begin
ShowMessage('FileName: ' StackName ,'\ Image Size = ', width, ' x ',
height, 'pixels' ';\ Number of Slices = ',nSlices, ';\ First Slice # = ',
FirstSlice,';\ Last Slice # = ', LastSlice);
end;
{
GetSliceRange is a procedure that gets the implied parameters first and last,
then does range checking to make sure this is a valid range of slices.
GetSliceSequence gets the implied parameters first, last, and step, doing
range checking to make sure it's a valid sequence of slices.
}
procedure GetSliceRange(smart:boolean);
var default:integer;
begin
first:=GetNumber('First slice:',1);
if (first<1) or (first>nSlices) 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 (step<1) then Error('Step must be 1 or greater.');
end;
procedure CalibrateImage;
var
unit: string;
SliceSpacing,PixPerMicron,ActualSpacing: real
begin
SetScale(0,'');
GetScale(PixPerMicron,unit);
if nSlices>1 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<=95) and (ord(ch)>=32) and (ord(ch)<=126)
then write(ch);
end;
RestoreState;
end;
macro '[F1] Import Biorad Z Series';
{macro 'Import Biorad Z Series';}
{
Imports a Z series(multiple images per file) from a Biorad MRC 600/1000
confocal microscope. The width, height and number of images are
extracted from the first 3 16-bit word in the 76 byte header and
the file name is extracted from bytes 18-23 of the header. This macro
does not read merged pseudocolored BioRad files. Note that the Undo
and Clipboard buffers must be set to 384K to work with the typical
768x512 Biorad images.
}
var
width,height,nImages,offset,hdrsize,i,start,picsize:integer;
begin
RequiresVersion(1.50);
width:=512;
height:=1;
offset:=0;
SetImport('8-bit');
SetCustom(width,height,offset);
Import(''); {Read header}
GetPicSize(width,height);
if (width<>512) or (height<>1) 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 (width<128) or (width>2048) or (height<128) or (height>2048) or
(nImages<1) or (nImages>256) 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 nPics<>2 then begin
PutMessage('This macro operates on exactly two images.');
exit;
end;
SelectPic(1);
GetPicSize(w1,h1);
SelectPic(2);
GetPicSize(w2,h2);
if (w1<>w2) or (h1<>h2) 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 nPics<>2 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 (w1<>w2) or (h1<>h2) 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 i<>d3 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 nPics<>2 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< d3 then AddSlice;
end;
SelectPic(1);
Dispose;
SelectPic(1);
Dispose;
RestoreState;
end;
macro '(-' begin end;
macro '[F10] Choose First Slice';
{1) Choose the Stack you want to fractionate.
2) grab the WindowTitle, PidNumber, Window or ROI size in pixels.
3) select the beginning slice - using < or > 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 (x<0) or (y<0) then EndIntegration;
delta:=round(0.250*nFrames);
if delta<1 then delta:=1;
if y>220 then begin
nFrames:=nFrames-delta;
if nFrames<1 then nFrames:=1;
end else begin
nFrames:=nFrames+delta;
if nFrames>240 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 i<>slices 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 i<>1 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 i<>1 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 InputSpacing<=0 then InputSpacing:=1;
InputSpacing:=GetNumber('Input Slice Spacing:',InputSpacing);
SetSliceSpacing(InputSpacing);
OutputSpacing:=round(InputSpacing+0.25);
OutputSpacing:=round(GetNumber('Output Slice Spacing:',OutputSpacing));
FirstTime:=true;
GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
if horizontal then begin
loc:=RoiTop+OutputSpacing;
max:=RoiTop+RoiHeight;
end else begin
loc:=RoiLeft+OutputSpacing;
max:=RoiLeft+RoiWidth;
end;
while loc< 1) or (d > 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 lower<1 then lower:=1;
if lower>254 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 lower<1 then lower:=1;
if lower>254 then lower:=254;
if upper254 then upper:=254;
SetDensitySlice(lower,upper);
ShowMessage(lower:4,upper:4)
end;