TreeTrace macros -- for use with NIH Image
See Tree Trace documentation file for directions on use.
{TreeTrace macros by D.K. Hartline et al. Copyright (C) 1995; 1996
v01I 11/3/97 Add Edit Spacing to change z-spacing in pixels
v01H 10/24/95 Add Make Z Plan to include z-range option.
v01G 8/31/95 remove Black plan component of colored plan
v01F 8/30/95 add "Get Parent [P]"; DisplayActive procedure (placed on www)
v01E 8/7/95 add grey-coded ("colored") plan; ChangeParams; rej.var bug fixed; add lineWidth to 'L'
v01D 6/30/95
For documentation, see TreeTraceMacros.manual;
Note term "segment" in program corresponds to "Section" in user manual
}
{Hot-key commands:
A Retrieve active section
B mark Branch Point
C Change Parameters
D Delete terminal section
E Erase marked branch points
F Find nearest node
G Go to section
J Jump to Slice
L draw and digitize Line Segment
M (reserved for edit)
N Next Unresolved Branch Point
R Restore end of list
Restore variables
S Save Results
U Undelete deleted section
Z Create Z Plan
+* Increase size of circle
-= Decrease size of circle
F1 Initialize stack
F12 Restore results
}
{***************************GLOBAL DEFINITIONS ************************}
var
activeSegment: integer; {Count # for current ("active") segment & node}
diam: real; {diameter of active segment (distal end)}
dens: integer; {mean density of segment}
i:integer; {segment index for ActivateSegment, etc.}
lineWidth:integer; {width of trace line}
nChildren:integer; {nbr of branches from A.S.}
nUnresolved:integer; {Pointer to last unresolved branch in rAngle}
parent:integer; {parent of active segment,}
segLength: real; {3D length of active segment}
selectionFlag: boolean; {flag indicating +/- keyed for initial selection circle}
spacing: real; {slice spacing in pixels}
traceColor,markColor,branchColor,eraseColor:integer; {color codes for line segments}
treeOrigin: boolean; {true if 1st point has been digitized}
rwidth:integer; {width of SavedResults pseudoimage}
vers:integer; {TreeTrace macro version number: 0=<01D; 1=01D}
x,x1,x2,y,y1,y2:real; {x,y coord's of begin(1) & end(2) of activeSegment in pixels}
z,z1,z2:integer; {z's are global slice numbers}
parent0,nChildren0,z10,z20: integer; {save-variables}
diam0,x10,y10,x20,y20,segLength0:real;
{----------------------- PROCEDURES (subroutines) ---------------------------}
{-------------------------- ACTIVATE SEGMENT ---------------------------}
procedure ActivateSegment; {activate section (segmen)t i, setting appropriate seg. parameters}
begin {SET variable "i" to segment to be activated prior to call}
activeSegment:=i;
x1:=rX[i]; x2:= rMin[i]; x:=x2;
y1:=rY[i]; y2:= rMax[i]; y:=y2;
z1:=rUser1[i]; z2:=rUser2[i]; z:=z2;
parent:=rMajor[i];
nChildren:=rMinor[i];
segLength:=rLength[i];
diam:=rArea[i];
MakeOvalRoi(x2-diam/2,y2-diam/2,diam,diam); {set circular selection for diameter}
SelectSlice(z2);
end;
{----------------------------- DISPLAY ACTIVE parameters -----------------}
procedure DisplayActive; {Puts message with parameters for active segment}
{NOTE: activeSegment and all standard parameters must have been updated first}
begin
PutMessage('Active Section =',i,' x1=',x1,' y1=',y1,' z1=',z1,' x2=',x2,' y2=',y2,' z2=',z2,' parent=',parent,' nChildren=',nChildren,' length=',segLength,' diameter='diam);
end;
{----------------------------- DRAW SYMBOL ----------------------------}
procedure DrawSymbol; {draws 2-pixel square symbol at distal end of segment i}
{NOTE: integer variable i must be set to segment # by calling routine}
{NOTE: symbol color must be set with SetForegroundColor() by calling rtn}
var
scratch,xx,yy,zz: integer;
begin
scratch:=SliceNumber;
xx:=rMin[i]; yy:=rMax[i]; zz:=rUser2[i]; {x2,y2,z2 of segment i}
SelectSlice(zz);
MoveTo(xx-1,yy-1);
LineTo(xx+1,yy-1); LineTo(xx+1,yy+1); {draw symbol with specified color}
LineTo(xx-1,yy+1);LineTo(xx-1,yy-1);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {restore sel. circle at active node}
SelectSlice(scratch);
end;
{----------------------------- REJUVENATE VARIABLES ----------------------}
procedure RejuvenateVariables; {restores basic variables after macro-edit session}
begin
activeSegment:=rCount;
lineWidth:=1;
traceColor:=1; markColor:=2; branchColor:=3; eraseColor:=255; {CHANGE 255 IF NEED}
treeOrigin:=true;
nUnresolved:=0;
for i:=1 to rCount do begin {count nbr of unresolved BPs}
if rAngle[i]>0 then begin
nUnresolved:=nUnresolved+1;
end;
end;
rwidth:=27;
SetScale(0,'pixels'); SetUser1Label('z1'); SetUser2Label('z2');
SetOptions('Area,Mean,X-Y Center,Length,Major,Minor,Min/Max,User1,User2');
if nSlices>0 then begin
i:=rCount; ActivateSegment; z2:=SliceNumber;
end;
end;
{----------------------------- UPDATE VARIABLES ----------------------}
procedure UpdateVariables; {updates results list variables after changes; set i beforehand}
begin
rArea[i]:=diam;
rMean[i]:=dens;
rX[i]:=x1; rMin[i]:=x2; x:=x2;
rY[i]:=y1; rMax[i]:=y2; y:=y2;
rUser1[i]:=z1; rUser2[i]:=z2; z:=z2;
rMajor[i]:=parent;
rMinor[i]:= nChildren;
rLength[i]:=segLength;
end;
{------------------------------ End of procedures -------------------------------}
{************************** INITIALIZE TRACE [F1] *************************}
macro 'Initialize Tracing[F1]' {initialization required before any 'Trace' macros}
var n:integer;
begin
if not selectionFlag then begin
PutMessage('Must set diameter [+/- keys] first');
exit;
end;
KillRoi;
lineWidth:=1; {constants ....}
rwidth:=27; vers:=1; {change in RestoreResults also}
traceColor:=1; markColor:=2; branchColor:=3; eraseColor:=255; {CHANGE 255 IF NEED}
activeSegment:=1; i:=1; {variable initializations ...}
spacing:=GetNumber('Please enter z-axis spacing in pixels',1);
ResetCounter;
Measure; {inc counter to 1st entry: soma parameters}
nUnresolved:=0;
segLength:=0;
x1:=0; y1:=0; x2:=x; y2:=y; {coordinates of origin set to selection circle center}
z2:=SliceNumber;
rArea[1]:=diam; rX[1]:=0; rY[1]:=0; rLength[1]:=0; rMajor[1]:=0; rMinor[1]:=0;
rMin[1]:=x; rMax[1]:=y; rUser1[1]:=z2; rUser2[1]:=z2;
SetScale(0,'pixels'); SetUser1Label('z1'); SetUser2Label('z2');
SetOptions('Area,Mean,X-Y Center,Length,Major,Minor,Min/Max,User1,User2');
{diam, mean, x1, y1, L, parent, #child, x2,y2, z1, z2}
for n:= 1 to nSlices do begin
SelectSlice(n);
ChangeValues(255,255,254);
ChangeValues(0,6,7); {note this will erase any colors previously on image}
end;
SelectSlice(z2); {restore slice}
DrawSymbol;
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {restore sel. circle in soma}
treeOrigin:=true;
end;
{*********************** MACROS (alphabetical) **************************}
macro 'Test [T]'
var j,x,y:integer;
begin
PutMessage('j =',j);
PutMessage('x1 =',x1);
end;
{************************* ACTIVE SEGMENT [A] ***************************}
macro 'Active Segment[A]' {Position slice & selection circle to current active node}
begin
i:=activeSegment;
ActivateSegment;
DisplayActive;
end;
{************************* BRANCH MARK [B] ****************************}
macro 'Branch Mark [B]' {Mark branch pt. at active node; node-->rAngle[].}
begin {Nodes in rAngle are "Unresolved Branches", returned to with "N" key}
if treeOrigin then begin
nUnresolved:=nUnresolved+1; {inc number of unresolved branch points}
rAngle[nUnresolved]:=activeSegment;
i:=activeSegment; SetForegroundColor(markColor); DrawSymbol;
end{if}
else begin
PutMessage('Cannot mark branch until tree origin defined [use L]');
end;{else}
end;
{***************** CHANGE ACTIVE SEGMENT PARAMETERS [C] *****************}
macro 'Change Parameters[C]' {Edits parameters for current active node}
begin
i:=activeSegment;
x1:=GetNumber('x1',x1);
y1:=GetNumber('y1',y1);
z1:=GetNumber('z1',z1);
x2:=GetNumber('x2',x2);
y2:=GetNumber('y2',y2);
z2:=Getnumber('z2',z2);
dens:=GetNumber('density',dens);
parent:=GetNumber('parent',parent);
nChildren:=GetNumber('nChildren',nChildren);
segLength:=GetNumber('Length',segLength);
diam:=GetNumber('diameter',diam);
UpdateVariables;
DisplayActive;
end;
{************************ DELETE LAST SEGMENT [D] **********************}
macro 'Delete Last Segment [D]' {Delete line segment at end of list & activate parent}
var
j: integer;
begin
if{1} rCount>0 then begin
SetForegroundColor(eraseColor);
SelectSlice(rUser2[rCount]); {z2 of last segment [slice at segment end]}
MoveTo(rX[rCount],rY[rCount]); {x1,y1 of last segment}
LineTo(rMin[rCount],rMax[rCount]); {x2,y2 last segment}
parent0:=rMajor[rCount]; nChildren0:=rMinor[rCount]; diam0:=rArea[rCount];
x10:=rX[rCount]; y10:=rY[rCount]; segLength0:=rLength[rCount]; {for undel}
x20:=rMin[rCount]; y20:=rMax[rCount]; z10:=rUser1[rCount]; z20:=rUser2[rCount];
rMinor[parent0]:=rMinor[parent0]-1; {decr # of children of parent}
if{2} rMinor[parent0]=1 then begin {if # of siblings reduced to 1 from 2...}
DrawSymbol; {.... erase branch mark on parent}
end;{if2}
for j:=1 to nUnresolved do begin {check branch mks for relevant marked nodes}
if{3} rAngle[j]=rCount then begin {if deleted seg. has unresolved branches...}
rAngle[j]:=0; {.... erase branch marks on deleted segment}
i:=rCount; DrawSymbol;
end; {if3}
if{4} (rAngle[j]=parent0) and (rMinor[parent0]<2) then begin {if on parent...}
rAngle[j]:=0; {.... erase branch marks if #children<2}
i:=parent0; DrawSymbol;
end;{if4}
end;{for}
SetCounter(rCount-1); {back track on segment counter}
i:=rCount; ActivateSegment; {activate next earlier segment}
UpdateResults;
end {if1}
else{1} PutMessage('No more line segments to delete');
end;
{************************** ERASE LAST BRANCH MARK *********************}
macro 'Erase Last Mark' {Delete last unresolved branch point...}
begin
if nUnresolved>0 then begin
i:=rAngle[nUnresolved]; {Line#'s of unresol. BPs held in rAngle[]}
rAngle[nUnresolved]:=0;
nUnresolved:=nUnresolved-1;
SetForegroundColor(eraseColor); DrawSymbol;
end {if}
else PutMessage('No more unresolved branches to delete');
end;
{************************** FIND NEAREST NODE [F] ***********************}
macro 'Find Nearest Node[F]' {activates seg. with x2,y2 nearest cursor in slice}
var
d,dMinimum:real;
j:integer;
begin
dMinimum:=1000;
GetMouse(x,y);
for j:=1 to rCount do begin
{ if (SliceNumber=rUser2[j]) then begin {check if test node is in same slice}}
x2:=rMin[j]; y2:=rMax[j]; {if so, calc. cursor distance from x2,y2 end}
d:=sqrt(sqr(x2-x)+sqr(y2-y));
if di then begin
ActivateSegment; {"activate" segment i}
DisplayActive;
end{if}
else begin
ActivateSegment; {"activate" segment i}
PutMessage('Segment ',activeSegment,' already active');
end;{else}
end;
{************************** GO TO [G] ***************************}
macro 'Go To [G]' {activates section (segment) specified in response to dialog window}
begin
i:=GetNumber('Select section number',1);
ActivateSegment;
DisplayActive;
end;
{************************** JUMP (Go) TO SLICE [J] ***************************}
macro 'Jump To Slice [J]' {gets slice specified in response to dialog window; active section (segment) unchanged}
begin
i:=GetNumber('Select slice number',1);
SelectSlice(i);
end;
{***************************** LINE TRACE [L] **************************}
macro 'Line Trace[L]' {Add 1 section (segment) at active node of growing dendritic tree}
begin
if not treeOrigin then begin PutMessage('Tree origin must be defined [F1]'); end;
if (x2=x) and (y2=y) and (z2=SliceNumber) then begin
PutMessage('Point already digitized: Move selection circle');
end;
x1:=x2; y1:=y2; z1:=z2;
x2:=x; y2:=y; z2:=SliceNumber;
SetForegroundColor(traceColor);
SetLineWidth(lineWidth);
MoveTo(x1,y1); LineTo(x2,y2);
PutPixel(x2,y2,markColor); {make 1-pixel distal-node mark}
if z1=z2 then begin {if line wrote over parent node distal mark...}
PutPixel(x1,y1,markColor); {... restore mark}
end;
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {assure circular sel. pattern}
Measure; {rCount incremented, then dummy values inserted in Results array}
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {restore circular sel. pattern}
rX[rCount]:=x1; rY[rCount]:=y1; rUser1[rCount]:=z1; {overwrite Results ar'y.}
rMin[rCount]:=x2; rMax[rCount]:=y2; rUser2[rCount]:=z2;
parent:=activeSegment; {set parent to store conn. to prev. A.S.}
segLength:=sqrt(sqr(x2-x1)+sqr(y2-y1)+sqr(spacing*(z2-z1)));
rMajor[rCount]:=parent; rArea[rCount]:=diam;
rLength[rCount]:=segLength;
nChildren:=0; rMinor[rCount]:=nChildren;
rMinor[parent]:=rMinor[parent]+1; {inc. child count of parent seg.}
if rMinor[parent]>1 then begin {mark a fork with blue square}
i:=parent; SetForegroundColor(branchColor); DrawSymbol;
end;
activeSegment:=rCount; {update active segment}
UpdateResults;
end;
{************************** NEXT BRANCH [N] ***************************}
macro 'Next Branch [N]' {activates segment on top of unresolved-branch pushdown}
var
j:integer;
begin
if{1} nUnresolved>0 then begin
for j:=1 to nUnresolved do begin
if{2} rAngle[j]>0 then begin {get next non-0 on unresol. branch list}
i:=rAngle[j];
end;{if2}
end;{for}
if{3} i>0 then begin {for loop ends with i= most recent marked node}
ActivateSegment; {if legal marked branch, activate its segment ...}
DisplayActive;
nUnresolved:=nUnresolved-1; {... and shrink list}
end;{if3}
end{if1}
else begin
PutMessage('No more unresolved branches');
end;{else}
end;
{************************** get PARENT [P] ***************************}
macro 'Parent [P]' {activates segment parental to current active segment}
var
i:integer;
begin
i:=parent;
ActivateSegment;
DisplayActive;
end;
{************************ EDIT DIAMETER [Q] **********************}
macro 'Edit Diameter [Q]' {allows diameter of active seggment to be chaged}
begin
rArea[ActiveSegment]:=diam;
PutMessage('New diameter =',diam);
end;
{************************** REJUVENATE VARIABLES *****************}
macro 'Rejuvenate Variables'
begin
RejuvenateVariables;
end;
{************************** RESUME at LAST SEGMENT [R] *****************}
macro 'Resume Last Segment [R]'
begin
i:=rCount;
ActivateSegment;
end;
{*************************** UNDELETE SEGMENT [U] *******************}
macro 'Undelete Segment[U]'
begin
SetCounter(rCount+1);
rMajor[rCount]:=parent0; rMinor[rCount]:=nChildren0; rArea[rCount]:=diam0;
rX[rCount]:=x10; rY[rCount]:=y10; rLength[rCount]:=segLength0;
rMin[rCount]:=x20; rMax[rCount]:=y20; rUser1[rCount]:=z10; rUser2[rCount]:=z20;
i:=rCount; ActivateSegment;
SetForegroundColor(traceColor);
MoveTo(x1,y1); LineTo(x2,y2);
MakeOvalRoi(x2-diam/2,y2-diam/2,diam,diam); {make circular sel. pattern}
UpdateResults;
end;
{*************************** MOVE SELECTION CIRCLE TO CURSOR [ ] *******************}
macro 'Move Circle [ ]'
begin
if not selectionFlag then begin diam:=3; selectionFlag:=true; end;
GetMouse(x,y);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {set circular selection for diam.}
end;
{*************************** INCREMENT DIAMETER [+] *******************}
macro 'Increment Diameter [+]'
begin
if not selectionFlag then begin diam:=3; selectionFlag:=true; end;
diam:=diam+1;
diam:=round(diam);
GetMouse(x,y);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {set circular selection for diam.}
end;
*****************************X10 INCREMENT DIAMETER [*] *******************}
macro 'X10 Increment Diameter [*]'
begin
if not selectionFlag then begin diam:=3; selectionFlag:=true; end;
diam:=diam+10;
diam:=round(diam);
GetMouse(x,y);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {set circular selection for diam.}
end;
{*************************** DECREMENT DIAMETER [-] *******************}
macro 'Decrement Diameter [-]'
begin
if not selectionFlag then begin diam:=5; selectionFlag:=true; end;
diam:=diam-1;
diam:=round(diam);
if diam<=0 then begin
diam:=0;
end;
GetMouse(x,y);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {set circular selection for diam.}
end;
{***************************X10 DECREMENT DIAMETER [=] *******************}
macro 'X10 Decrement Diameter [=]'
begin
if not selectionFlag then begin diam:=5; selectionFlag:=true; end;
diam:=diam-10;
diam:=round(diam);
if diam<=0 then begin
diam:=0;
end;
GetMouse(x,y);
MakeOvalRoi(x-diam/2,y-diam/2,diam,diam); {set circular selection for diam.}
end;
{*********************** SAVE RESULTS [S] ******************************}
{ The "Save" facility saves 2-byte integers as 2 8-bit greyscale pixels in a pseudoimage file given a default extension ".svr". The first row (y=0) of pixels contains the file header (byte0=TreeTrace vers. #; byte1 = width in pixels = number of results-variable bytes; bytes 2 & 3 = height in pixels = number of results-table rows; byte 4= # unresolved branch points marked; byte 5 = # branches on initial node; bytes 6&7= 100* slice spacing in pixels}
macro 'Save Results[S]'
var
j,msB: integer;
imageName,resultsName: string;
begin
rwidth:=27;{NOTE: changes in results width must also be made in INITIALIZE & RESTORE}
imageName:=WindowTitle;
SaveAs(imageName);
imageName:=WindowTitle; {recheck image name for changes}
resultsName:=concat(imageName,'.svr');
SetNewSize(rwidth,rCount+1); {rCount+1 because of row 0}
MakeNewWindow(resultsName);
PutPixel(0,0,vers); {version number into header-Pixel 0}
PutPixel(1,0,rwidth);
msB:=trunc(rCount/256); PutPixel(2,0,msB); PutPixel(3,0,rCount-256*msB);
PutPixel(4,0,nUnresolved);
if spacing=0 then begin spacing:=GetNumber('slice spacing (pixels)?',0); end;
msB:=trunc(spacing*100/256); PutPixel(6,0,msB); PutPixel(7,0,spacing*100-256*msB);
PutMessage('slice spacing is' ,spacing,' pixels');
MoveTo(0,0);
for j:=1 to rCount do begin
msB:=trunc(rArea[j]/256); lineBuffer[1]:=msB; lineBuffer[2]:=rArea[j]-256*msB;
msB:=trunc(rMean[j]/256); lineBuffer[3]:=msB; lineBuffer[4]:=rMean[j]-256*msB;
msB:=trunc(rStdDev[j]/256); lineBuffer[5]:=msB; lineBuffer[6]:=trunc(rStdDev[j] -256*msB);
msB:=trunc(rX[j]/256); lineBuffer[7]:=msB; lineBuffer[8]:=rX[j]-256*msB;
msB:=trunc(rY[j]/256); lineBuffer[9]:=msB; lineBuffer[10]:=rY[j]-256*msB;
msB:=trunc(rLength[j]/256);lineBuffer[11]:=msB;lineBuffer[12]:=trunc(rLength[j]-256*msB);
msB:=trunc(rMajor[j]/256); lineBuffer[13]:=msB; lineBuffer[14]:=rMajor[j]-256*msB;
msB:=trunc(rMinor[j]/256); lineBuffer[15]:=msB; lineBuffer[16]:=rMinor[j]-256*msB;
msB:=trunc(rAngle[j]/256); lineBuffer[17]:=msB; lineBuffer[18]:=rAngle[j]-256*msB;
msB:=trunc(rMin[j]/256); lineBuffer[19]:=msB; lineBuffer[20]:=rMin[j]-256*msB;
msB:=trunc(rMax[j]/256); lineBuffer[21]:=msB; lineBuffer[22]:=rMax[j]-256*msB;
msB:=trunc(rUser1[j]/256); lineBuffer[23]:=msB; lineBuffer[24]:=rUser1[j]-256*msB;
msB:=trunc(rUser2[j]/256); lineBuffer[25]:=msB; lineBuffer[26]:=rUser2[j]-256*msB;
PutRow(0,j,27);
end;
SaveAs(resultsName);
{ Close;}
end;
{*******************RESTORE RESULTS ******************}
macro 'Restore Results[F12]'
var
j,msB: integer;
imageName,ttl: string;
rwidth: integer
begin
rwidth:=27; {NOTE: changes in results width must also be made in INITIALIZE & SAVE}
vers:=1; {NOTE: must also enter changes in INITIALIZE}
traceColor:=1; markColor:=2; branchColor:=3; eraseColor:=255; {MOD 255 IF NEED}
SetScale(0,'pixels'); SetUser1Label('z1'); SetUser2Label('z2');
SetOptions('Area,Mean,X-Y Center,Length,Major,Minor,Min/Max,User1,User2');
{imageName:=WindowTitle;}
{ ttl:=concat(imageName,'.svr'); Open(ttl); doesn't work}
Open('results');
if rwidth<>GetPixel(1,0) then begin {check for .svr size compatibility}
PutMessage('Unexpected rwidth: ',GetPixel(1,0),' of .svr file')
end;
ResetCounter;
msB:=GetPixel(2,0);
SetCounter(GetPixel(3,0)+256*msB);
nUnresolved:=GetPixel(4,0);
msB:=GetPixel(6,0);
spacing:=(GetPixel(7,0)+256*msb)/100;
treeOrigin:=true;
for j:=1 to rCount do begin {read in row at a time & pick out stored variables}
GetRow(0,j,rwidth);
msB:= LineBuffer[1]; rArea[j]:= LineBuffer[2]+256*msB;
msB:= LineBuffer[3];rMean[j]:= LineBuffer[4]+256*msB;
msB:= LineBuffer[5]; rStdDev[j]:=LineBuffer[6]+256*msB;
msB:= LineBuffer[7]; rX[j]:= LineBuffer[8]+256*msB;
msB:= LineBuffer[9]; rY[j]:= LineBuffer[10]+256*msB;
msB:= LineBuffer[11]; rLength[j]:= LineBuffer[12]+256*msB;
msB:= LineBuffer[13];rMajor[j]:= LineBuffer[14]+256*msB;
msB:= LineBuffer[15];rMinor[j]:= LineBuffer[16]+256*msB;
msB:= LineBuffer[17]; rAngle[j]:=LineBuffer[18]+256*msB;
msB:= LineBuffer[19]; rMin[j]:= LineBuffer[20]+256*msB;
msB:= LineBuffer[21]; rMax[j]:= LineBuffer[22]+256*msB;
msB:= LineBuffer[23];rUser1[j]:= LineBuffer[24]+256*msB;
msB:= LineBuffer[25];rUser2[j]:= LineBuffer[26]+256*msB;
end;
Close;
{SelectWindow(imageName);}
if nSlices>0 then begin
i:=rCount; ActivateSegment;
end;
end;
{********************* CREATE Z PLAN [Z] *******************}
macro 'Create Z Plan' {superimposes a line drawing of the entire digitized tree on the current window with specified grey-value, for z within specified limits}
var
c,j,dx,dy,x1,x2,y1,y2,w,zz1,zz2:integer;
begin
c:=GetNumber('Enter grey-scale value for plan [0-255]',255);
SetForegroundColor(c);
zz1:=GetNumber('Enter lowest z-value to include in plan',1);
zz2:=GetNumber('Enter highest z-value to include in plan',1);
for j:=2 to rCount do begin
if (rUser2[j]>=zz1) and (rUser2[j]<=zz2) then begin
SetLineWidth(rArea[j]);
x1:=rX[j]; y1:=rY[j]; x2:=rMin[j]; y2:=rMax[j];
MoveTo(x1,y1); LineTo(x2,y2);
end;
end;
end;
{********************* CREATE COLORED PLAN *******************}
{when you want to exit the "while" loop, enter 0 for "color next descendants of segment #"}
{WARNING: assumes Results Table in hierarchical sequence: rCount[paren]0) do begin
c:=GetNumber('Enter grey-scale value for plan [0-255]',c);
SetForegroundColor(c);
for j:=1 to rCount do begin
rAngle[j]:=0; {clear flag array}
end;{for}
rAngle[n]:=1;
for j:=n+1 to rCount do begin
{if rMajor[j]>0 and rAngle[rMajor[j]]<>0 then begin add child of valid (>0) flagged (rAngle=1) parent to list}
if rAngle[rMajor[j]]<>0 then begin
rAngle[j]:=1;
SetLineWidth(rArea[j]);
x1:=rX[j]; y1:=rY[j]; x2:=rMin[j]; y2:=rMax[j];
MoveTo(x1,y1); LineTo(x2,y2);
end;{if}
end;{for}
c:=c+1;
if c>255 then begin
c:=0; {after a black plan, default to white on next}
end;{if}
n:=GetNumber(' Color next descendants of segment # [default terminates]',0);
end; {while}
PutMessage('Warning: do not save results: macro corrupts rAngle array')
end; {begin}
{*********************New Diameter********************}
macro 'New diameter[z]'
begin
PutMessage('Old diameter=', rArea[activeSegment]);
rArea[activeSegment]:=diam;
i:= activeSegment;
PutMessage('New Diameter=', diam);
end;
{*********************Change slice spacing********************}
macro 'Change slice spacing'
var
j,msB: integer;
begin
msB:=GetPixel(6,0);
spacing:=(GetPixel(7,0)+256*msB)/100;
PutMessage('Slice spacing is=' ,spacing,'pixels');
spacing:=GetNumber('New spacing',spacing);
msB:=trunc(spacing*100/256); PutPixel(6,0,msB);
PutPixel(7,0,spacing*100-256*msB);
end;
{****************************** PROJECTION MACROS 7/14/94 dkh ****************
}
macro 'Invert Stack Contrast'
var
i: integer;
begin
for i:=1 to nSlices do begin
SelectSlice(i);
Invert;
end;
end;
macro 'Change Values'
var
i: integer;
begin
for i:=1 to nSlices do begin
SelectSlice(i);
ChangeValues(0,3,4);
end;
end;
macro 'Reserve black end'
var
i: integer;
begin
for i:=1 to nSlices do begin
SelectSlice(i);
ChangeValues(252,255,251);
end;
end;
macro 'SwapMarkValues'
var
i: integer;
begin
for i:=1 to nSlices do begin
SelectSlice(i);
ChangeValues(1,3,255);
end;
end;
macro 'ReSwapMarkValues'
var
i: integer;
begin
for i:=1 to nSlices do begin
SelectSlice(i);
ChangeValues(255,255,0);
end;
end;
Return to Hartline Home Page.
PBRC Anonymous FTP area
Return to PBRC Home Page.