Macro programs for measuring root length and diameter is shown. Readers who want to use this macro should get macro programs from here.
{ver 1.54 97 Aug22 (C) 1997 Kimura Kazuhiko }
{Macro progrom for calculating Total Length or Length&Width }
{EdgeFilter and EdgeFilter2 should be in the NIH image folder }
{Diagonal count was modified to avoide overestimation due to }
{ false diagonal connections during counting pixels }
{Routine for diameter less than 1 unit is added }
{This is for Scion Image only. Delete4sides was replaced by add4sides. 98 May08}
VAR
i,j,width,height,EdgeCount,DiagonalCount,TotalCount,PicN,IterateN,ThresholdValue:integer;
Perimeter,TotalLength,BeforeLength,HorPerLength,DiagonalLength,Scale,AspectRatio:real;
filename,unit : string;
procedure initialize;
begin
PicN:=PicNumber;
IterateN:=1;
GetPicSize(width,height);
GetScale(scale,unit,Aspectratio);
ResetCounter;
SetCounter(20);
SetPrecision(2,12);
{SetOptions('User2 Length Area');}
SetOptions('User1 User2 Length');
SetUser1Label('TotalLength');
SetUser2Label('Width');
BeforeLength:=0;
for i:=1 to 20 do
begin
rUser1[i]:=0;
rUser2[i]:=0;
rLength[i]:=0;
end;
end;
procedure delete4sides;{set 0 for 4sides}{No more needed for ImagePC}
begin
for i:=1 to 4095 do LineBuffer[i]:=0;
PutRow(0,0,width);
PutRow(0,height-1,width);
{ PutColumn does not work if the column length > 4096}
{ Program was modified as below }
for i:=0 to height-1 do putpixel(0,i,0);
for i:=0 to height -1 do putpixel(width-1,i,0);
end;
procedure add4sides;{for ImagePC}
begin
SelectAll;
Copy;
SetNewSize(width+2,height+2);
MakeNewWindow('4 sides added');
Paste;
end;
procedure NoiseReduction; {remove isolated pixel}
begin
SetPicName('Removing Isolated Pixels');
SetBinaryCount(8);
Erode;
SetPicName('Isolated Pixels Removed');
SelectAll;
Duplicate('EdgeDeleted');{Noise Reduced}
SetPicName('EdgeDeleted');{added for appending in ImagePC}
end;
procedure SkeletonCalculation;
begin
SetPicName('Calculating Skeleton Length');
Convolve('EdgeFilter2');
ChangeValues(0,129,0);{delete non skeleton pixels}
ShowHistogram;Dispose;
TotalCount:=Histogram[130]+Histogram[135]+Histogram[140]+Histogram[145]+Histogram[150]+Histogram[156]+Histogram[161]+Histogram[166]+Histogram[171]+Histogram[176]+Histogram[182]+Histogram[187]+Histogram[192]+Histogram[197]+Histogram[202]+Histogram[208]+Histogram[213]+Histogram[218]+Histogram[223]+Histogram[228]+Histogram[234]+Histogram[239]+Histogram[244]+Histogram[249]+Histogram[255];
HorPerLength:=((Histogram[156]+Histogram[161]+Histogram[166]+Histogram[171]+Histogram[176])+2*(Histogram[182]+Histogram[187]+Histogram[192]+Histogram[197]+Histogram[202])+3*(Histogram[208]+Histogram[213]+Histogram[218]+Histogram[223]+Histogram[228])+4*(Histogram[234]+Histogram[239]+Histogram[244]+Histogram[249]+Histogram[255]))/2;
{
DiagonalLength:=((Histogram[135]+Histogram[161]+Histogram[187]+Histogram[213]+Histogram[239])+2*(Histogram[140]+Histogram[166]+Histogram[192]+Histogram[218]+Histogram[244])+3*(Histogram[145]+Histogram[171]+Histogram[197]+Histogram[223]+Histogram[249])+4*(Histogram[150]+Histogram[176]+Histogram[202]+Histogram[228]+Histogram[255]))/2;
}
DiagonalLength:=((Histogram[135]+Histogram[161])+2*(Histogram[140]+Histogram[166])+3*(Histogram[145]+Histogram[171]/3)+4*(Histogram[150]))/2;
TotalLength:=sqrt(sqr(DiagonalLength)+sqr(DiagonalLength+HorPerLength*0.5))+HorPerLength*0.5;
{++++++++++ save skeleton , if you want +++++++++++++++++}
{ filename:='skeleton';
filename:=concat(filename,chr(48+IterateN));
SetSaveAs('TIFF');
SaveAs(filename);
}
{++++++++++ save skeleton +++++++++++++++++++++++++++++}
{for next }
SelectWindow('Calculating Skeleton Length*');{ImagePC only to specify the window to be disposed}
Dispose;{Skeleton}
ShowMessage(IterateN,'normaly terminated');
rUser1[IterateN]:=TotalLength/scale*2.54;
rUser2[IterateN]:=(IterateN-1)*1.78/scale*25.4;
rLength[IterateN]:=abs(BeforeLength-TotalLength)/scale*2.54;
rArea[IterateN]:=totalCount/scale*2.54*1.10;{Length by line intercept ,Tanaka's way}
BeforeLength:=TotalLength;
ShowResults;
IterateN:=IterateN+1;
end;{of SkeletonCalculation}
procedure TotalSkeleton;
begin
SelectWindow('Isolated Pixels Removed*');{* is added for ImagePC}
SetPicName('Finding Skeleton');
Skeletonize;
SetPicName('Skeleton');
SkeletonCalculation;
end;{of TotalSkeleton}
procedure EdgeDeletion;
begin
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
SetPicName('Deleting Edges');
Convolve('EdgeFilter');
ShowHistogram;Dispose;
TotalCount:=Histogram[255];
ChangeValues(0,153,0);{delete false dots}
SetThreshold(254);{delete edge dots}
MakeBinary;
SetPicName('EdgeDeleted');
Duplicate('Peeled/Skeletonizing');
end;{of EdgeDeletion}
procedure PeelAndSkeleton;
begin {routine for diameter less than 1 unit is added}
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
Duplicate('deleting a line');
Setbinarycount(5);
Erode;
Skeletonize;
SkeletonCalculation;
rUser2[IterateN-1]:=1/scale*25.4;
repeat
EdgeDeletion;
Skeletonize;
SetPicName('Deleting Noise');
SkeletonCalculation;
rUser2[IterateN-1]:=(IterateN-3)*1.78/scale*25.4;
until (TotalCount=0);
rUser2[IterateN-1]:=(IterateN-3)*1.78/scale*25.4;
rUser2[IterateN]:=0;
end;{ of PeelAndSkeleton}
Macro 'Length&Width';
begin
initialize;
{ delete4sides;}{removed because too late in ImagePC}
Add4sides;{ instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
PeelAndSkeleton;
end;
procedure MainProcess;
begin
initialize;
{delete4sides;}{removed because too late in ImagePC}
Add4sides;{ instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
PeelAndSkeleton;
end;
Macro 'TotalLength';
begin
initialize;
{delete4sides;}{removed because too late in ImagePC}
Add4sides; {instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
end;
Procedure FileProcessForSkeleton;{(FileName,ThresholdValue)};
begin
open(filename);
{sharpen;sharpen;}{these process may be changed to get clear image}
SetThreshold(ThresholdValue);
MakeBinary;
MainProcess;
filename:=concat(filename,'sr154');
SetExport('Measurements');
Export(filename);
disposeAll;
end;
Macro 'Main';
begin
{FileName and ThresholdValue should be described below}
filename:='mac:LMS-300dpi:LMS111-1a';ThresholdValue:=122;FileProcessForSkeleton;
filename:='mac:LMS-300dpi:LMS111-2a';ThresholdValue:=122;FileProcessForSkeleton;
filename:='mac:LMS-300dpi:LMS111-3a';ThresholdValue:=122;FileProcessForSkeleton;
filename:='mac:LMS-300dpi:LMS111-4a';ThresholdValue:=122;FileProcessForSkeleton;
filename:='mac:LMS-300dpi:LMS111-5a';ThresholdValue:=122;FileProcessForSkeleton;
end;
{ver 1.80 Aug 6,1997 (C) 1997 Kimura Kazuhiko}
{Macro progrom for calculating Total Length or Length&Width }
{EdgeFilter and EdgeFilter2 should be in the NIH image folder }
{Diagonal count was modified to avoide overestimation due to }
{false diagonal connections during counting pixels }
{New diameter estimation was used. }
{Surface area calculation is added }
{routine for diameter less than 1 unit is added}
{This is for Scion Image only. Delete4sides was replaced by add4sides. 98 May08}
VAR
i,j,width,height,EdgeCount,DiagonalCount,TotalCount,TotalPixelN,PicN,IterateN,ThresholdValue:integer;
Perimeter,TotalLength,BeforeLength,HorPerLength,DiagonalLength,Scale,AspectRatio, SumArea:real;
filename,unit,DFName : string;
procedure initialize;
begin
PicN:=PicNumber;
IterateN:=1;
SumArea:=0;
GetPicSize(width,height);
GetScale(scale,unit,Aspectratio);
ResetCounter;
SetCounter(30);
SetPrecision(3,12);
{SetOptions('User2 Length Mean');}
SetOptions('User1 User2 Length Area');
SetUser1Label('Length#');
SetUser2Label('Width');
BeforeLength:=0;
for i:=1 to 30 do
begin
rUser1[i]:=0;
rUser2[i]:=0;
rLength[i]:=0;
rArea[i]:=0;
rMean[i]:=0;
end;
end;
procedure delete4sides;{set 0 for 4sides}{No more needed for ImagePC}
begin
for i:=1 to 4095 do LineBuffer[i]:=0;
PutRow(0,0,width);
PutRow(0,height-1,width);
{ PutColumn does not work if the column length > 4096}
{ Program was modified as below }
for i:=0 to height-1 do putpixel(0,i,0);
for i:=0 to height -1 do putpixel(width-1,i,0);
end;
procedure add4sides;{for ImagePC}
begin
SelectAll;
Copy;
SetNewSize(width+2,height+2);
MakeNewWindow('4 sides added');
Paste;
end;
procedure NoiseReduction; {remove isolated pixel}
begin
SetPicName('Removing Isolated Pixels');
SetBinaryCount(8);
Erode;
SetPicName('Isolated Pixels Removed');
SelectAll;
Duplicate('EdgeDeleted');{Noise Reduced}
SetPicName('EdgeDeleted');{added for appending in ImagePC}
end;
procedure SkeletonCalculation;
begin
{++++++++++ save skeleton , if you want +++++++++++++++++}
{ filename:='skeleton';
filename:=concat(filename,J);
SetSaveAs('TIFF');
SaveAs(filename);
}
{++++++++++ save skeleton +++++++++++++++++++++++++++++}
SetPicName('Calculating Skeleton Length');
Convolve('EdgeFilter2');
ChangeValues(0,129,0);{delete non skeleton pixels}
ShowHistogram;Dispose;
TotalCount:=Histogram[130]+Histogram[135]+Histogram[140]+Histogram[145]+Histogram[150]+Histogram[156]+Histogram[161]+Histogram[166]+Histogram[171]+Histogram[176]+Histogram[182]+Histogram[187]+Histogram[192]+Histogram[197]+Histogram[202]+Histogram[208]+Histogram[213]+Histogram[218]+Histogram[223]+Histogram[228]+Histogram[234]+Histogram[239]+Histogram[244]+Histogram[249]+Histogram[255];
HorPerLength:=((Histogram[156]+Histogram[161]+Histogram[166]+Histogram[171]+Histogram[176])+2*(Histogram[182]+Histogram[187]+Histogram[192]+Histogram[197]+Histogram[202])+3*(Histogram[208]+Histogram[213]+Histogram[218]+Histogram[223]+Histogram[228])+4*(Histogram[234]+Histogram[239]+Histogram[244]+Histogram[249]+Histogram[255]))/2;
{
DiagonalLength:=((Histogram[135]+Histogram[161]+Histogram[187]+Histogram[213]+Histogram[239])+2*(Histogram[140]+Histogram[166]+Histogram[192]+Histogram[218]+Histogram[244])+3*(Histogram[145]+Histogram[171]+Histogram[197]+Histogram[223]+Histogram[249])+4*(Histogram[150]+Histogram[176]+Histogram[202]+Histogram[228]+Histogram[255]))/2;
}
DiagonalLength:=((Histogram[135]+Histogram[161])+2*(Histogram[140]+Histogram[166])+3*(Histogram[145]+Histogram[171]/3)+4*(Histogram[150]))/2;
TotalLength:=sqrt(sqr(DiagonalLength)+sqr(DiagonalLength+HorPerLength*0.5))+HorPerLength*0.5;
{for next }
SelectWindow('Calculating Skeleton Length*');{ImagePC only to specify the window to be disposed}
Dispose;{Skeleton}
ShowMessage(IterateN,'normaly terminated');
rUser1[IterateN]:=TotalLength/scale*2.54;
rLength[IterateN]:=abs(BeforeLength-TotalLength)/scale*2.54;
rMean[IterateN]:=totalCount/scale*2.54*1.10;{Tanaka's method}
BeforeLength:=TotalLength;
ShowResults;
IterateN:=IterateN+1;
end;{of SkeletonCalculation}
procedure TotalSkeleton;
begin
SelectWindow('Isolated Pixels Removed*');{* is added for ImagePC}
ShowHistogram;Dispose;
TotalPixelN :=histogram[255];
rArea[IterateN]:=TotalPixelN*3.1415/scale*2.54/scale*2.54;
SetPicName('Finding Skeleton');
Skeletonize;
SetPicName('Skeleton');
SkeletonCalculation;
end;{of TotalSkeleton}
procedure EdgeDeletion;
begin
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
SetPicName('Deleting Edges');
Convolve('EdgeFilter');
ShowHistogram;Dispose;
TotalCount:=Histogram[255];
ChangeValues(0,153,0);{delete false dots}
SetThreshold(254);{delete edge dots}
MakeBinary;
SetPicName('EdgeDeleted');
Duplicate('Peeled/Skeletonizing');
end;{of EdgeDeletion}
procedure FilterLength;{less than 1unit width}
begin
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
Duplicate('Image B');
Convolve('DFA- 0.5');
SetThreshold(185);{deleted if less than 3 of 8-neighbors}
MakeBinary;
Imagemath('and',picnumber,picnumber-1,1,0,'Image C');
SelectWindow('Image A');
Dispose;
SelectWindow('Image B');
Dispose;
SelectWindow('Image C');
Duplicate('Image A');
SelectWindow('Image C');
Skeletonize;
SetBinaryCount(8);Erode;
SkeletonCalculation;
rUser2[IterateN-1]:=1/scale*25.4;
rArea[IterateN-1]:=rLength[IterateN-1]*rUser2[IterateN-1]/10*3.1415;
sumArea:=sumArea+rArea[IterateN-1];
rArea[IterateN]:=sumArea;{may be overwritten, but last calculation remains as totalArea}
end;
procedure FilterAndLength;
begin
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
Duplicate('Image B');
DFName:=concat('DFA-',J);
Convolve(DFName);
SetThreshold(254);
MakeBinary;
Imagemath('and',picnumber,picnumber-1,1,0,'Image C');
SelectWindow('Image A');
Dispose;
SelectWindow('Image B');
Dispose;
SelectWindow('Image C');
Duplicate('Image A');
SelectWindow('Image C');
Skeletonize;
SetBinaryCount(8);Erode;
SkeletonCalculation;
rUser2[IterateN-1]:=sqrt(J)*2/scale*25.4;
rArea[IterateN-1]:=rLength[IterateN-1]*rUser2[IterateN-1]/10*3.1415;
sumArea:=sumArea+rArea[IterateN-1];
rArea[IterateN]:=sumArea;{may be overwritten, but last calculation remains as totalArea}
end;
procedure WidthAndLength;
begin
SelectWindow('EdgeDeleted*');{* is added for ImagePC}
Duplicate('Image A');
if TotalCount >0 then FilterLength;{for less than 1 unit width};
J:=1;if TotalCount >0 then FilterAndLength; if TotalCount=0 then exit;
J:=2;if TotalCount >0 then FilterAndLength;
J:=4;if TotalCount >0 then FilterAndLength;
J:=5;if TotalCount >0 then FilterAndLength;
J:=8;if TotalCount >0 then FilterAndLength;
J:=9;if TotalCount >0 then FilterAndLength;
J:=13;if TotalCount >0 then FilterAndLength;
J:=16;if TotalCount >0 then FilterAndLength;
J:=20;if TotalCount >0 then FilterAndLength;
J:=25;if TotalCount >0 then FilterAndLength;
J:=32;if TotalCount >0 then FilterAndLength;
J:=36;if TotalCount >0 then FilterAndLength;
J:=41;if TotalCount >0 then FilterAndLength;
J:=49 ;if TotalCount >0 then FilterAndLength;
J:=58 ;if TotalCount >0 then FilterAndLength;
J:=68 ;if TotalCount >0 then FilterAndLength;
J:=80 ;if TotalCount >0 then FilterAndLength;
J:=98 ;if TotalCount >0 then FilterAndLength;
J:= 117;if TotalCount >0 then FilterAndLength;
J:= 137;if TotalCount >0 then FilterAndLength;
end;{WidthAndLength}
procedure MainProcess;
begin
initialize;
{delete4sides;}{removed because too late in ImagePC}
Add4sides; {instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
WidthAndLength;
end;
Macro 'TotalLength';
begin
initialize;
{delete4sides;}{removed because too late in ImagePC}
Add4sides; {instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
end;
Macro 'Length&Width';
begin
initialize;
{delete4sides;}{removed because too late in ImagePC}
Add4sides; {instead of delete4sides, ImagePC only}
NoiseReduction;
TotalSkeleton;
WidthAndLength;
end;
Procedure FileProcessForSkeleton;{(FileName,ThresholdValue)};
begin
open(filename);
sharpen;{sharpen;}{these process may be changed to get clear image}
SetThreshold(ThresholdValue);
MakeBinary;
MainProcess;
filename:=concat(filename,'result');
SetExport('Measurements');
Export(filename);
disposeAll;
end;
Macro 'Main';
begin
{FileName and ThresholdValue should be described below}
{ filename:='mac:migaku:sand0-1-2';ThresholdValue:=50;FileProcessForSkeleton;}
filename:='mac:migaku:sand0-1-3';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-1-4';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-2-1';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-2-2';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-2-3';ThresholdValue:=37;FileProcessForSkeleton;
filename:='mac:migaku:sand0-2-4';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-2-5';ThresholdValue:=50;FileProcessForSkeleton;
filename:='mac:migaku:sand0-3-1';ThresholdValue:=60;FileProcessForSkeleton;
filename:='mac:migaku:sand0-3-2';ThresholdValue:=60;FileProcessForSkeleton;
filename:='mac:migaku:sand0-3-3';ThresholdValue:=60;FileProcessForSkeleton;
filename:='mac:migaku:sand0-3-4';ThresholdValue:=60;FileProcessForSkeleton;
filename:='mac:migaku:sand0-3-5';ThresholdValue:=50;FileProcessForSkeleton;
end;