ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/AI_MAY89.ZIP/DIVAR.PAS

Pascal/Delphi Source File | 1989-03-29 | 38.1 KB | 962 lines

{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
         (blackcomp<Maxblack) and ((blackcomp>Minblack) 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<dadbq) or
                              ((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.