Category : Science and Education
Archive   : AIMAY89.ZIP
Filename : DIVAR.PAS

{PROGRAM: DIVAR
AUTHOR : Jonthan Kraidin
SITE : Medical College of Pennsylvania, Anatomy Department
DATE : 9/20/88
}

{$m 65520,0,0}
PROGRAM AIPROG;

{ This is the Main Code. The units are as follows:

AIGLOB........Global variables used by AI routines
AIBINA........Cursor control, Image contrasting, and Menus
INITUNIT......Routines to initialize video board
BORDUNIT......Routines to access video board
AIEDGE........AI routine library
AIMATH........Statistical functions
AIUSER........User interface routines
AIIMGS........Image enhancement
CHARUNIT......Routines to number marked nuclei

The video board represents each pixel as a gray level between 0 and 255 on
a 512x512 memory image. Zero is the darkest and 255 is the brightest. All
odd values are represented on the monitor as RED.

The program is used as follows. The user sets the lighting on the
microscope and finds an appropriate section. A Shading Correct makes sure
that the lighting is uniform. The user selects the brightest, darkest,
largest, and smallest nuclei. In addition, the shading of the nucleoli is
checked. These Options all appear in the Menu Driver as well as the
following choices. The user then selects the size of S1, the window
in which to scan for the nuclei, and the coordinates are passed to
ScanDriver. The size of S2, the scan-window, is set by the program.

After the run the program allows the user to add missed nuclei. If the
LearnMode is ON the thresholds are set to account for the missed nuclei.
Likewise, the user can delete errors and Learning ensues. Finally, the
nuclei are numbered and the user can print the area and perimeter of all
good nuclei.
}

Uses
crt,globunit,aiglob,
aibina,initunit,bordunit,printer,
aiedge2,aimath,aiuser,aiimgs,charunit;

Var
xv1,xv2,yv1,yv2 : word;
Mval2,Mvalx2 : double;
graystriketemp,
strikes : byte;
hx,lx,num : byte;
xz,yz : word;
nulltrys : limitarray;
Decision,
SubDecision1,
SubDecision2 : byte;
Finished : boolean;
subfinished,
subfinished2 :boolean;
a,p,a2x,p2x : word;
_q : double;
i : word;
_mean,_stdev,
background : byte;
miss,
seenx : byte;
x1,y1,x2,y2 : word;
Ok_to_continue : boolean;
p1,p2,p3,p4 : pointer;
nucsize : byte;
small,Goodfill : boolean;
forecomp,
_foredev : double;
Mval : double;
Narea : word;
oldx,oldy : word;
_f,_s : double;
below : byte;
ku,stout,rx,rx2,
hypothet : double;

{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}

{--------------------RESTRICT SCAN REGION----------------------------}

{This procedure is given the (x,y) coordinates that describe a box that
contains the nucleus and then restricts that zone from being scanned
for any other nuclei. MARK is the number of restricted zones that are
stored in stored in two arrays. Rather than restrict the entire box,
the routine looks for the bottom of the RED-shaded nucleus and resets
the bottom of the box to be 5 lines below it. STARTLIMITS contains
the starting coordinates and FINISHLIMITS contains the end coordinates.}

Procedure RestrictSpot(x1,y1,x2,y2:word;Var mark : word;
Var startlimits,finshlimits:limitarray);
Var
j,k:word;
notdone : boolean;
begin
notdone := true;
k := (y1+y2) shr 1; {start at center}
while ((k <= y2) and notdone) do {till last y2}
begin
notdone := false; {scan from left to right }
for j := x1 to x2 do {until a RED is found. If RED}
if oldgrayvalue(j,k) and 1 = 1 then {is found, NOTDONE is set to}
notdone := true; {TRUE and a new line is scanned}
k := k+1; {If no RED exists then the loop stops and the }
end; {restriction is set 5 lines below nucleus. }
k := k+5;
{now store new restriction coords}
mark := mark + 1;
startlimits[mark].x := x1;
startlimits[mark].y := y1;
finshlimits[mark].x := x2;
finshlimits[mark].y := k;
end;{end procedure RestrictSpot}

{This function complements RestrictSpot and scans the array in order to
determine if a coordinate pair is within a restricted zone.}

Function IsItRestricted(x,y,totalSpots:word;
startlimits,finshlimits:limitarray):boolean;
Var
i : byte;
NotDone : boolean;
begin
i := 1;
NotDone := TRUE;
IsItRestricted := FALSE;
While (i <= totalspots) and NotDone do
begin
If ((x >= StartLimits[i].x) and (x <= FinshLimits[i].x) and
(y >= StartLimits[i].y) and (y <= FinshLimits[i].y)) then
begin
IsItRestricted := TRUE;
NotDone := FALSE;
end;
i := i + 1;
end;
end;{end function IsItRestricted}

{This procedure initializes the arrays to zero.}

Procedure Settrys;
Var
i : byte;
begin
for i := 1 to 20 do
begin
nulltrys[i].x := 0;
nulltrys[i].y := 0;
end;
end;

{When the program thinks it is looking at a nucleus but is not positive
it stores the coordinates in the array NULLTRYS. TRIEDAFEW is given the
(a,b) location under scrutiny. If these coordinates are within a fixed
distance from other attempts a value of TRUE is returned as well as
the number of times this region has been questionable.}

Function TriedaFew(a,b:word;Var count : byte):boolean;
Var
i : byte;
dist : double;
j,k : word;
begin
count := 0;
for i := 1 to 20 do {cycle through a list of twenty locations}
begin
j := nulltrys[i].x;
k := nulltrys[i].y;
dist := ( (a-j)*(a-j) ) + ( (b-k)*(b-k) );
If dist < 300 then
count := count+1;
end;
If count >= 1 then
TriedaFew := true
else
triedafew := false;
end;
{____________________________________________________________________________}

{When deleting an area, this routine, given the cursor coordinates,
will find the closest stored nucleus by finding the
least distance between the cursor location and the nucli centers.}

Procedure Findclosest(x,y:word;Var closeX,closeY:word;Var itemp:byte);
Var
i : byte;
temp : double;
smallest : double;
xt,yt : word;
begin
smallest := 99999E+70;
For i := 1 to CellCount do
begin
xt := AiCells[i].xcoord;
yt := AiCells[i].ycoord;
Temp := ((xt-x)*(xt-x)) + ((yt-y)*(yt-y));
Temp := sqrt(temp);
If temp < smallest then
begin
smallest := temp;
itemp := i;
closeX := xt;
closeY := yt;
end;
If smallest > 100 then
itemp := 0;
end;
end;{end procedure findclosest}

{------------------------------DATA STORAGE-------------------------}

{This procedure will store all pertinent data on the nuclei in case
Learning is necessary.}

Procedure HouseKeep(Areax,Perimeterx,x,y,a,p:word;
gray1:byte;cmval,blackcmp,_for,_std,_stdx,_forx:double;
_dadb:word;rxa,rxb:double);
begin
cellcount := cellcount+1; {next cell}
With AiCells[cellcount] do {store in record}
begin
Area := Areax; {pixel area}
Perimeter := Perimeterx; {pixel perimeter}
_area := a; {calibrated area and perimeter}
_perim := p;
Good := TRUE; {Flag = FALSE if deleted.}
xcoord := x; {Coords of center of search.}
ycoord := y;
gray := gray1; {gray value used by Spot-Scanner}
mval := cmval; {Sample gray value}
black := blackcmp; {% of sample that was nucleolus}
foregnd := _for; {% above background value}
_stdev := _std; {standard deviation of sample}
dadb := _dadb; {hypothetical area}
stdx := _stdx; {standard dev of entire nucleus}
forx := _forx; {average gray value of nucleus}
cytost := stout; {standard dev of surrounding cytoplasm}
kux := ku; {kurtosis of nucleus}
rx1 := rxa; {nucleus-sample/cytoplasm ratio}
rx2 := rxb; {nucleus/cytoplasm ratio}
end;
end;{end procedure housekeep}

{This procedure generates a simple report giving the area and
perimeter. If a nucleus is deleted its data are not reported.}

Procedure ReportAll;
Var
total : word; {Total nuclei printed}
begin
total := 0;
Writeln(LST,'*** CELL AREA DATA REPORT ***');
Writeln(LST);
For i := 1 to cellcount do
with aicells[i] do
If Good then {Check if Deleted}
begin
total := total + 1;
Writeln(LST,'CELL #: ',i:3,' AREA: ',_Area/(calibfactor2*calibfactor2):10:4,
' PERIMETER: ',_Perim/calibfactor2:10:4);
end;
Writeln(LST);
Writeln(LST,'TOTAL COUNT: ',Total);
end; {end procedure ReportAll}

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{This is the Main Driver routine for the program. SCANDRIVER is given
the window (x1,y1,x2,y2) to search for all nuclei and the width and height
of the scan-box within which data are sampled to find each nuclei.
NUCSIZE is a value describing the size of the nucleus to the recognition
algorithms. MVAL is an average gray-level threshold.}

Procedure ScanDriver(x1,y1,x2,y2,width,height:word;nucsize:byte;mval:double);

Var
j,k : word;
s,t : word;
hw,hh : byte;
incrm : byte;
xstart,ystart : word;
y,x : word;
xa,ya : word;
Ok_to_continue,
Intensity_Ok,
goodifnucleolus,
goodifsmall,
cytcond,
abscyt : boolean;
_mean,_stdev : double;
temp : double;
ForeComp,
blackcomp : double;
Roundness : double;
seenbefore : byte;
smallnuc : byte;
da,db : byte;
standardD : double;
sd : byte;
count : byte;
rxq : double;
Mhigh : byte;
gray1 : byte;
xm,ym : word;
_forex,_stdx : double;
startlimits,
finshlimits : limitarray;
totalspots : word;
Uncertain : boolean;
debug : boolean;
icount : word;
incrmy : byte;
n2size : byte;
hits : byte;
foundcell : boolean;
Cmval : double;
stout : double;
tx,
sx : byte;
begin
settrys; {Initialize arrays and variables}
cellcount := 0;
tx := 0;
sx := 0;
graystriketemp := 255;
debug := false;
icount := 0;
totalspots := 0;
hw := width shr 1;
hh := height shr 1;
y := y1-hh;
x := x1-hw;
incrm := 5;
incrmy := 3;
n2size := nucsize shl 1;
smallnuc := round(nucsize/3);
standardd := 2*nucsize*nucsize;
sd := 1;
hits := 0;
FoundCell := FALSE;

{-------------------------execution begins here-----------------------}

While (Y+hh < Y2) do {Vertical bounds}
begin
While (X+hw < X2) do {horizontal bounds}
begin
xa := x + hw; {move to new location}
ya := y + hh;
Foundcell := FALSE;
MakeCross(xa,ya,0); {mark center-point on monitor}
Intensity_Ok := IntensityCheck(xa,ya,n2size); {ON/OFF routine to
check if above threshold}

{------------------------------Level One Spot-Scanner----------------------}

If Intensity_Ok and {SpotContrast returns an ON/OFF }
(SpotContrast(xa,ya,n2size,goodifsmall)) and {value, but uses an Energy routine}
Not(IsItRestricted(xa,ya,totalspots,startlimits,finshlimits)) then
begin {Restriction routine is ON/OFF}
ok_to_continue := TRUE; {*** ADJUST SCAN RESOLUTION ***}
icount := 0; {If something is there reduce}
incrm := 2; {the horizontal scan increments}
end
else
begin
ok_to_continue := FALSE; {otherwise, increase them if }
icount := icount+1; {nothing is found after 5 trys}
If icount = 5 then
incrm := round(nucsize/1.5);
end;

{---------------------------Level Two Spot-Scanner--------------------------}

IF OK_TO_CONTINUE THEN {check if region has been questionable before}
BEGIN
Uncertain:= triedafew(xa,ya,seenbefore);
tx := tx+1;
if tx = 21 then {If program has gotten this far then region }
tx := 1; {is of some interest. Therefore, store coords}
nulltrys[tx].x := xa; {incase region fails later tests but is }
nulltrys[tx].y := ya; {encountered again.}
Cmval := Mscan(xa,ya,smallnuc,blackcomp); {Get average gray-level }
{and % of nucleolus in sample}

if (cmval > 0.9*mvalx) and
(blackcompMinblack) or (blackcomp=0)) then
begin {check nuc. staining pattern}

If shellscan(xa,ya,nucsize,Uncertain,goodifnucleolus) then
begin
{---------------Spot-Scanner ends...Determine composition %--------}

Escan(xa,ya,nucsize,round(mval),da,db); {get edge distances}

If ( ((da*db > 0) and (blackcomp <> 0)) or
((da*db > dadbx) and (blackcomp = 0)) ) then
begin
Mhigh := 0;
for t := ya-2 to ya+2 do {center on bright pixel}
for s := xa-2 to xa+2 do
begin
gray1 := oldgrayvalue(s,t);
if gray1 > Mhigh then
begin
Mhigh := gray1;
xm := s;
ym := t;
end;
end; {get crude estimate}

If (da*db < 0.4*standardd/sd) then
small := TRUE
else
Small := FALSE;
HowMuchFore(xm,ym,(smallnuc shr 1)+1,ForeComp,_stdev);

If (small or (Not(small) and (cmval > 0.93*mvalx))) and
((_stdev < _stqset) or (Uncertain and (_stdev < _stqset+5))
or (seenbefore > 2))
and ((forecomp > forset) or (Seenbefore > 2)) and
(Not(goodifsmall) or (goodifsmall and small)) then
begin {get crude size est.}
{shade in nucleus}

FillIn(x,y,x+width,y+height,small,
round(1.3*nucsize),seenbefore); {get area}
a := 1+findarea(x,y,x+width,y+height,_forex,_stdx);

If (da*db < 50) or ((_stdx < _stqxset) or Uncertain) and
((_forex > forxset) or (Seenbefore > 2)) then
begin

histoanalysis(xa,ya,nucsize,below,ku,stout,
rx,rx2,cytcond,abscyt);
db := max(da,db);
hypothet := a/(db*db); {determine actual_area/guess}
if hypothet > 1.2 then
previous := TRUE
else
previous := FALSE;
If (below > 7) and (rx < rx2) then
begin
temp := rx2;
rx2 := rx;
rx := temp;
end;
{cross ref. data} if (abscyt) and (Not(goodifnucleolus) or
(goodifnucleolus and (below > 7)) or
(seenbefore > 2)) and

((_stdx <_stqxset) or
((seenbefore > 2) and (_stdx < 1.5*_stqxset)) or
((Below > 7) and (_stdx < 2.5*_stqxset)) ) then
begin
if ((cytcond) or ((Hypothet < 1.5) and (_stdx < 25))
or (seenbefore > 3)) and
((hypothet>lowhyp) or ((hypothet > -2) and
(_stdx < 25)))
and ((hypothet ((below>11) and (hypothet<4))) and
(rx > rx1low) and (rx < rx1high) and
(rx2 > rx2low) and (rx2 < rx2high) and
(ku > kulow) and (ku < kuhigh) and
(rx > rx2) and (rx2 > 1.02) then
begin
if small then
seenbefore := seenbefore + 2;
{cross ref. data} if (stout < 30) or
((seenbefore > 0) and (stout < 33)) or
((seenbefore > 0) and (stout < 36)) or
((seenbefore > 1) and (stout < 42)) or
((seenbefore > 2) and (stout < 46)) or
((seenbefore > 3) and (stout < 50)) or
((seenbefore > 4) and (stout < 55)) then
begin
{check area} if (a > MinArea) and (A < MaxArea) then
begin
p := scanedge(x,y,x+width,y+height);
Roundness := p*p/(12.56*a);
{check roundness} If (Roundness > ShapeLow) and
((Roundness < ShapeHigh) or
((seenbefore > 2) and (Roundness < 1.1))) then
{we have a cell} begin
standardd := standardd+(da*db);
sd := sd+1;
a2x := 1+findarea(x,y,x+width,y+height,_q,_q);
p2x := scanedge(x,y,x+width,y+height);
FoundCell := TRUE;
hits := hits+1;
{so not scan this region} RestrictSpot(x,y,x+width,y+height,totalspots,
startlimits,finshlimits);
makedark(x-(nucsize shr 1),y-(nucsize shr 1),
x+width+(nucsize shr 1),y+height+(nucsize shr 1));
Gray1 := Max(oldgrayvalue(xa,ya),
oldgrayvalue(xa-1,y));
Gray1 := Max(gray1,oldgrayvalue(xa+1,y));
{Reset striking value} If gray1 < graystriketemp then
graystriketemp := gray1;
If (hits > strikes) and
(0.98*graystriketemp > graystrike) then
graystrike := round(0.98*graystriketemp);
{store data} HouseKeep(a,p,xa,ya,a2x,p2x,gray1,Cmval,
blackcomp,forecomp,_stdev,_stdx,_forex,da*db,
rx,rx2);
end; {end shape index check}
end; {end area check}
end;
end; {end hist data and cyto standard deviation}
end; {end hist data and ratios}
end; {end standard dev. and foreground of sample}
end; {end st. dev and foreground before FillIn}
end; {end da*db check}
If Not(FoundCell) then
erosion2(x-10,y-10,x+width+10,y+height+10);
end; {end shellscan}
end; {end nucleolus check}
END; {end ok_to_continue--level 1 spotscanner}
If Not(FoundCell) then {marker of current center-point}
erasecross(xa,ya,0);
FoundCell := FALSE;
x := x + incrm; {move horizontally}
end; {end While X}
x := x1-hw;
y := y + incrmy; {next line}
end; {end While Y}
end; {end procedure scandriver}

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

Begin {Begin Program Code }

textbackground(black);
clrscr;
strikes := 3;
Cellcount := 0;
Calibfactor2 := 1.690; {pixels/micron @ 40x }
Initialize; {initialize video board }
InitWindow; {initialize window routines }
hx := 255;
lx := 0;
SetUpMenu; {set up Menu Window data }
SetSubMenu1;
SetSubMenu2;
DisplayMenu(true); {display main menu }
Finished := FALSE;
LearnMode := TRUE;
forecomp := 1; {set lax constraints... }
dadbq := 2; {These variables are used }
lowhyp := 0.2; { by the Learn Routines. }
MaxBlack := 0.20; {Max/Min allowable nucleolus}
MinBlack := 0.02;
_stqset := 15; {st. devs of nuc. sample }
_stqxset := 25;
DaDbx := 15; {product of edge lengths }
forset := 0.5; {sample foreground }
forxset := 0.0;
ShapeHigh := 1.03; {roundness limits }
ShapeLow := 0.6;
cytoset := 8; {max st. dev. of surrounding}
kulow := -0.8; { cytoplasm. }
kuhigh := 30; {shape of nuclear histogram }
rx1low := 1; {nuc/cyt ratios }
rx1high := 2;
rx2low := 1;
rx2high := 2;
minarea := 10; {Used when first setting nuc}
maxarea := 9999; { size limits. }
setaddress; {Sets memory address of a }
p1 := @isitbackground; { routine used by assembly }
p2 := @isitforeground; { code for shading nucleus.}
p3 := @isitbackgroundv;
p4 := @isitforegroundv;
previous := FALSE;
seenx := 0;
{--------------------------BEGIN MAIN MENU DRIVER---------------------------}
While Not(Finished) do
begin
Decision := ChooseMenu(0,34,8); {Get user choice}
Case Decision of
1: Begin {Mark cursor location on }
PixelFinder; { monitor with gray-level}
DisplayMenu(false); {Redraw menu }
end;
2: begin {Sub Menu to set up image}
SubFinished := FALSE; {not done with sub menu }
DisplaySubMenu1(true); {display sub menu }
While Not(SubFinished) do
begin
SubDecision1 := ChooseMenu(1,30,7);
Case subDecision1 of
1: begin
Storeshading; {store blank image }
displaysubMenu1(false);
Repeat {Get location }
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
end;
2: begin
acquiresingle; {freeze image }
shadingcorrect; {perform shading correct }
Repeat {Get location }
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
DisplaySubMenu1(false);
end;
3: begin
centerlighter := true; {get initial nuc data }
GoodFill := FALSE; {accept data only if user}
oldx := 2; { acknowledges that OK }
oldy := 2;
Repeat {Get location }
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);

{-------Get brightest cell----------}

MakeAnotherWindow;
Message3; {Tell user what to get }
REPEAT
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If ((xdig <> oldx) or (ydig <> oldy)) then
begin
erasecross(oldx,oldy,3); {Mark location }
Makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig <> 0);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
Lowdiv := 50; {don't have this value yet}
fillin(xdig-30,ydig-30,xdig+30,ydig+30, {shade and see if OK }
false,20{nucsize},seenx);
If Askwindow then {is it OK? }
GoodFill := TRUE
else
Erosion2(xdig-round(2*20),ydig-round(2*20),
xdig+round(2*20),ydig+round(2*20));
UNTIL goodfill;
Mval := GetGray(xdig,ydig,5); {set data }
Mvalx := 0.93*Mval;
CriticalValue := round(0.97*Mval);
GrayStrike := round(mval);
If 1.1*Mval < 255 then
CriticalHigh := round(1.1*Mval)
else if 1.08*mval < 255 then
criticalhigh := round(1.08*mval)
else if 1.06*mval < 255 then
criticalhigh := round(1.06*mval)
else if 1.04*mval < 255 then
criticalhigh := round(1.04*mval)
else
CriticalHigh := 255;
Lowdiv := round(Criticalvalue/1.13); {set nucleolus }
EraseIt(xdig,ydig,nucsize);

{-------Get darkest cell------------}

GoodFill := FALSE;
Message4;
REPEAT
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If ((xdig <> oldx) or (ydig <> oldy)) then
begin
erasecross(oldx,oldy,3);
Makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig <> 0);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
fillin(xdig-30,ydig-30,xdig+30,ydig+30,
false,20{nucsize},seenx);
If Askwindow then
GoodFill := TRUE
else
Erosion2(xdig-round(2*20),ydig-round(2*20),
xdig+round(2*20),ydig+round(2*20));
UNTIL goodfill;
Mval2 := GetGray(xdig,ydig,5); {See if any values have to }
Mvalx2 := 0.94*Mval2; { be changed to account for}

If Mval2 < Mval then {darker nuclei. }
begin
Mval := Mval2;
Mvalx := Mvalx2;
criticalvalue := round(0.97*Mval);
Graystrike := round(mval);
end
else
begin
lowdiv := round(0.96*Mval2/1.13);
If 1.1*Mval2 < 255 then
CriticalHigh := round(1.1*Mval2)
else if 1.08*mval2 < 255 then
criticalhigh := round(1.08*mval2)
else if 1.06*mval2 < 255 then
criticalhigh := round(1.06*mval2)
else if 1.04*mval2 < 255 then
criticalhigh := round(1.04*mval2)
else
CriticalHigh := 255;
end;
EraseIt(xdig,ydig,nucsize);
forxset := round(criticalvalue/1.015);

lowdiv := 80;

{------------Largest cell---------------}

GoodFill := FALSE;
Message1;
REPEAT
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If ((xdig <> oldx) or (ydig <> oldy)) then
begin
erasecross(oldx,oldy,3);
Makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig <> 0);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
fillin(xdig-30,ydig-30,xdig+30,ydig+30,
false,20{nucsize},seenx);
If Askwindow then
GoodFill := TRUE
else
Erosion2(xdig-round(2*20),ydig-round(2*20),
xdig+round(2*20),ydig+round(2*20));
UNTIL goodfill;
{set area} NArea := 1+findarea(xdig-30,ydig-30,xdig+30,ydig+30,_f,_s);
MaxArea := round(1.3*Narea);
Nucsize := round( 1.2*sqrt(Narea/3.14) );
Eraseit(xdig,ydig,nucsize);

{---------------smallest cell---------------}

GoodFill := FALSE;
Message2;
REPEAT
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If ((xdig <> oldx) or (ydig <> oldy)) then
begin
erasecross(oldx,oldy,3);
Makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig <> 0);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
fillin(xdig-40,ydig-40,xdig+40,ydig+40,
true,20{nucsize},seenx);
If Askwindow then
GoodFill := TRUE
else
Erosion2(xdig-round(1.5*nucsize),ydig-round(1.5*nucsize),
xdig+round(1.5*nucsize),ydig+round(1.5*nucsize));
UNTIL goodfill;
NArea := 1+findarea(xdig-40,ydig-40,xdig+40,ydig+40,_f,_s);
MinArea := round(0.6*Narea);
EraseIt(xdig,ydig,nucsize);
zapMwindow; {erase small window }
DisplaySUbMenu1(false); {reset sub menu }
end;
4: begin
Histogramstretch(hx,lx); {histogram stretch }
visionfix(xv1,yv1,xv2,yv2);
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
5: begin
Subfinished2 := FALSE; {real-world interface}
DisplaySubMenu2(true);
While Not(SubFinished2) do
begin
SubDecision2 := ChooseMenu(2,40,10);
Case SubDecision2 of
1: begin {nothing}
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
2: begin {toggle LEARN mode}
LearnMode := Not(LearnMode);
If LearnMode then
Menu2[2] := 'Learn Mode ON '
else
Menu2[2] := 'Learn Mode OFF ';
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
3: begin {reinitialize video}
Initialize;
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
4: begin
ReportAll; {report data to printer}
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
5: begin {set S1}
tabletdriver(xv1,yv1,xv2,yv2,false);
Repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
6: begin {end "real world " menu}
ZapMWindow;
SubFinished2 := TRUE;
repeat
digitlocate(xdig,ydig,butdig,errdig);
until (butdig = 0);
end;
end;{end case}
end;{end while}
DisplaySubMenu1(false);
end;
6: begin {end submenu}
ZapMWindow;
Repeat {Get location }
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
SubFinished := TRUE;
end;
end;{end case}
end;{end while}
DisplayMenu(false);
end;
3: begin {execute scan}
scandriver(xv1,yv1,xv2,yv2,round(2*Nucsize), {xv1,...= S1}
round(3*nucsize),nucsize,mval); {2*nucsize,3*nucsize = }
While (askwindow2) do {width and height of S2}
begin {did it get all nuclei?}
oldx := 2;
oldy := 2;
Repeat
Digitlocate(xdig,ydig,butdig,errdig); {point to nuclei to fill}
Until (butdig = 0);
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If (xdig <> oldx) or (ydig <> oldy) then
begin
erasecross(oldx,oldy,3);
makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig = 1);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0); {fill in}
fillin(xdig-nucsize,ydig-nucsize,xdig+nucsize,ydig+nucsize,
false,nucsize,seenx);
If Askwindow then {is it OK?}
begin {Learn}
LearnFromAddition(xdig,ydig,Nucsize,40,40,Mval);
MakeDark(xdig-20,ydig-20,xdig+20,ydig+20);
end
else
EraseIt(xdig,ydig,nucsize);
end;
MakeVideobox(xv1,yv1,xv2,yv2); {put box back to align}
blacktored(xv1-nucsize,yv1-nucsize,xv2+nucsize,yv2+nucsize);
for i := 1 to cellcount do {write nuclei numbers}
begin
Writenum(i,aicells[i].xcoord+15,aicells[i].ycoord-15);
end;
fixit; {unstretch}
acquirecontinuous; {get live image}
end;
4: begin {manually add area}
centerlighter := true;
oldx := 0;
oldy := 0;
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If (xdig <> oldx) or (ydig <> oldy) then
begin
erasecross(oldx,oldy,3);
makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig = 1);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
fillin(xdig-20,ydig-20,xdig+20,ydig+20,
false,nucsize,seenx);
If Askwindow then
begin
LearnFromAddition(xdig,ydig,Nucsize,40,40,Mval);
MakeDark(xdig-20,ydig-20,xdig+20,ydig+20);
end
else
EraseIt(xdig,ydig,nucsize);
end;
5: Begin {manually delete area}
centerlighter := true;
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
oldx := 2;
oldy := 2;
Repeat
DigitLocate(xdig,ydig,butdig,errdig);
If (xdig <> oldx) or (ydig <> oldy) then
begin
erasecross(oldx,oldy,3);
makecross(xdig,ydig,3);
oldx := xdig;
oldy := ydig;
end;
Until (butdig = 1);
Repeat
Digitlocate(xdig,ydig,butdig,errdig);
Until (butdig = 0);
erasecross(xdig,ydig,3);
eraseit(xdig,ydig,nucsize);
If LearnMode then
begin
findclosest(xdig,ydig,xz,yz,num); {find closest cell to }
If num = 0 then { the cursor (on video)}
writeln(chr(7))
else
begin
AiCells[num].good := false; {do not print this data}
LearnFromDeletion(num); {Learn }
end;
end;
end;
6: Finished := TRUE; {Exit }
end;{end case}
End;{end While}

END.