'----- Standerd code of EPI1.exe -------
'-- --Made by Eiichi YAGI MD 1999-----
'---- Dermatologist, Akita, Japan -----
' In tumor growth several functions are added -- optional

For hpp = 1 To 1

  GoSub maikk
    bazzz$ = "d:\akuz" + RTrim$(LTrim$(Str$(hpp))) + ".txt"
    Open bazzz$ For Output As #4
   '  SavePicture picture1.Image, bazzz$
   GoSub inin
     Close #4
      ' allcell = va
Next hpp

  GoTo jjaabb
  
maikk:
  ReDim kyorn(1 To 500)  As Integer
  ReDim kyor(1 To 500)  As Single
   ReDim kyorss(1 To 500)  As Single
   ReDim suti(1 To 500)  As Single
   ReDim suti2(1 To 500)  As Single
   ReDim jak(1 To 500)  As Integer

   ReDim ceddx(0 To 500) As Single     
   ReDim ceddy(0 To 500) As Single   
   ReDim ceddrr(0 To 500) As Single   
    ReDim ceddhi(0 To 500) As Single   
   ReDim ceddBUN(0 To 500) As Single   
   ReDim ceddDIR(0 To 500) As Single  

   ReDim ceddcoL(0 To 500) As Single  
    ReDim cedsoko(0 To 500) As Single   

    ReDim ceconXb(0 To 500) As Single   
     ReDim ceconYb(0 To 500) As Single  

   'ReDim ceV(0 To 100) As Single   

   ReDim gax(0 To 500) As Single
   ReDim gay(0 To 500) As Single

   ReDim cellkk(0 To 500)  As Single
   ReDim celjj(0 To 500)  As Single
   ReDim ceZXX(0 To 500)  As Single

   ReDim BOXTx(0 To 100) As Single
   ReDim BOXTy(0 To 100) As Single

picture2.SetFocus
' ---- ----
r = www1  'hankei
tate = www2     
yoko = www3    
allcell = www4  'cell number
basee = www5
gran = www6
squat = www7
buNRET = www8
PRP = www9
kakkak_1 = www10
kakkak_2 = www11
kakkakA_1 = www12
kakkakA_2 = www13
'  XZX = 9     '  0 - 9 �� 0 - 180  // 0 - 18 �� 0 - 360
ddj = www14      
LAT = www15
kakNN = www16
corn = www17
cornda = www18
mazx = www19
gzg = www20
baseb = www21


Dkak = www22
Xbsyn = www23
Ybsyn = www24
Xbbsyn = www25


'*******************  ******************** *****  **********
   For va = 1 To allcell
        ceddrr(va) = r + Rnd / 5
        ceddx(va) = 150 + 2 * ceddrr(va) * va
        ceddy(va) = Rnd
        ceddBUN(va) = Rnd + Rnd     ' ----  0  to  2.0
        ceddDIR(va) = (kakkak_2 - kakkak_1) * Rnd + kakkak_1
        ceconXb(va) = Rnd + Rnd'
        ceconYb(va) = Rnd + Rnd 
        ceddcoL(va) = 1
        cedsoko(va) = 1
        ceddhi(va) = 1
   Next va
      ' allcell = va


GoTo jjkkabb
'*******************************  *****************  **********
Randomize
BU = 0
        ceddx(1) = 50
        ceddy(1) = 25
  kq = 0
  UA = 0
 
   Do Until BU = allcell
        XM = (yoko * Rnd + 20)
        YM = (tate * Rnd + 40)
            kq = kq + 1
            UA = 0
            'text1.Text = kq
          For baz = 1 To kq
           fx = ceddx(baz) - XM
           FY = ceddy(baz) - YM
           RTR = Sqr(fx * fx + FY * FY)
           rm = r' + (Rnd - .5) / 20
             If RTR < rm * 2 Then
                UA = 6
                Exit For
             End If
           Next baz
           If UA = 0 Then
             BU = BU + 1
            ceddx(BU) = XM
            ceddy(BU) = YM
            gax(BU) = XM
            gay(BU) = YM
            End If
  Loop
'  *********************************

jjkkabb:
   ' For maa = 1 To allcell
   ' FillColor = QBColor(Int(Rnd * 15))
        'picture1.PSet (ceddx(maa), 150 - ceddy(maa)), QBColor(12)
      'picture1.Circle (ceddx(maa), 150 - ceddy(maa)), R, QBColor(12)
      'picture1.Circle (ceddx(maa), 150 - ceddy(maa)), R / 3, QBColor(12)
    '  picture2.PSet (ceddx(maa), 150 - ceddy(maa)), QBColor(12)
     ' picture2.Circle (ceddx(maa), 150 - ceddy(maa)), R, QBColor(12)

    ' Next maa
 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Randomize
 ' GoTo taxx

'  MAIN ROUTINE ----///-----///-----/////----////-----
   gagaga = 1
   qap = 0
Do Until allcell >= 182 Or jaja = 1
   text1.Text = allcell

   qap = qap + 1
    If qap > ddj Then
     qap = 0
    End If
 '   If allcell = 300 Then
  '            SavePicture picture1.Image, "d:\pppp.bmp"
  '  jaja = 1
   ' End If
'Beep
    'ggaa = Int(allcell * Rnd) + 1 
        'ggaa = 5
    'If ggaa > allcell Then
     '  ggaa = allcell
    'End If
       
  For Rt = 1 To allcell  '    min of kyor
         
        cozXb = ceconXb(Rt) 
        cozYb = ceconYb(Rt)
        For RRt = 1 To allcell
         If Rt <> RRt Then
          kyoj = (ceddx(Rt) - ceddx(RRt)) * (ceddx(Rt) - ceddx(RRt)) + (ceddy(Rt) - ceddy(RRt)) * (ceddy(Rt) - ceddy(RRt))
          koryy = Sqr(kyoj + .0001) 
             secomXb = ceconXb(RRt)
             secomYb = ceconYb(RRt)
           cozXb = secomXb / (koryy * koryy) + cozXb
           cozYb = Dkak * secomYb / (koryy * koryy) + cozYb
             'text9.Text = ceconXb(RRt)
         End If
       Next RRt
          ceconXb(Rt) = cozXb
           ceconYb(Rt) = cozYb
  Next Rt
   If maxbun > 1000 Then
      For Rt = 1 To allcell  '    min of kyor
        cozXb = (ceconXb(Rt) - maxbun + 10) * 5 / allcell 
        cozYb = (ceconYb(Rt) - maxbun + 10) * 5 / allcell 

       '  text8.Text = cozXb
        ceconXb(Rt) = cozXb * Xbsyn + cozYb * Ybsyn
        ceconYb(Rt) = cozYb * Xbbsyn
          ceddBUN(Rt) = ceconXb(Rt)
     Next Rt
   Else
      For Rt = 1 To allcell  '    min of kyor
        cozXb = ceconXb(Rt) '- 5000' 
        cozYb = ceconYb(Rt) '- 5000' 

      '  text8.Text = cozXb
        ceconXb(Rt) = cozXb * Xbsyn + cozYb * Ybsyn
        ceconYb(Rt) = cozYb * Xbbsyn
         ceddBUN(Rt) = ceconXb(Rt)
     Next Rt
   End If


For Rt = 1 To allcell  '    min of kyor
  suti2(Rt) = 0
Next Rt
For Rt = 1 To allcell
  suti2(Rt) = -ceddBUN(Rt)
Next Rt
For BXBX = 1 To allcell
    SUTIMIN = suti2(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell
       If suti2(j) < SUTIMIN Then
          SUTIMIN = suti2(j)
          KMIN = j
       End If
   Next j
       H1 = suti2(BXBX)
       H2 = suti2(KMIN)
       suti2(BXBX) = H2
       suti2(KMIN) = H1
Next BXBX

     maka = 0
     pasa = 0

Do Until maka = 1 Or pasa > 10     
  pasa = pasa + 1
     maxbun = -suti2(pasa)
     minbb = -suti2(allcell)
       text8.Text = maxbun
         ' text7.Text = minbb
       For sa = 1 To allcell
          If maxbun = ceddBUN(sa) Then
               nub = sa
               Exit For
          End If
       Next sa
         If cedsoko(nub) > Rnd + baseb Then
             maka = 1
             ggaa = nub
         Else
             maka = 0
          End If
Loop
If Rnd > .8 Then
  ggaa = nub
Else
  ggaa = Int((allcell - 1) * Rnd) + 1
End If
  cozXbc = ceconXb(ggaa) '- 5000'  
  cozYbc = ceconYb(ggaa) '- 5000'  

       ceconXb(ggaa) = cozXbc * .95 - Rnd * .2
       ceconYb(ggaa) = cozYbc * 1.05 + Rnd * .2 
     
GoTo hggbb
'////////////////////////////////////////////////////
For Rt = 1 To allcell  '    min of kyor
  suti2(Rt) = 0
Next Rt
For Rt = 1 To allcell
  suti2(Rt) = ceddx(Rt)
Next Rt
For BXBX = 1 To allcell
    SUTIMIN = suti2(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell
       If suti2(j) < SUTIMIN Then
          SUTIMIN = suti2(j)
          KMIN = j
       End If
   Next j
       H1 = suti2(BXBX)
       H2 = suti2(KMIN)
       suti2(BXBX) = H2
       suti2(KMIN) = H1
Next BXBX
      mingx = suti2(2)
      mangx = suti2(allcell - 1)
      hanhan = mangx - mingx - 2 * r
   ReDim najj(1 To 100) As Single
         
               hanzz = mingx + Rnd * hanhan
                hanII = hanzz
        
                gp = 0
             For XTT = 1 To allcell
                 If ceddx(XTT) >= hanII And ceddx(XTT) < hanII + 2 * r Then
                    gp = gp + 1
                    najj(gp) = ceddy(XTT)
                  End If
             Next XTT
                  GoSub gppabb
             For XTT = 1 To allcell
                 If ceddy(XTT) = minyyy Then
                      bunr = XTT
                      Exit For
                  End If
             Next XTT
     ggaa = bunr
      picture1.Circle (ceddx(ggaa), 150 - ceddy(ggaa)), r / 2, QBColor(12)
  'Print #1, ""
  'Print #1, "ggaa  "; ggaa
'/////////////////////////////////////////////////////////////
hggbb:

'---  --�|�|�|�|�|�|�|�|�|�|�|
'Randomize
   ' rree = (22 * Rnd) - 1
    rree = ceddDIR(ggaa)
    kaku = rree   '* XZX
 '  If kaku < 60 Then
  '    kaku = 60
  ' End If
  '  If kaku > 120 Then
   '    kaku = 120
   ' End If

     'text4.Text = kaku
       pai = 3.141593
       kakrd = kaku * pai / 180
         xxxb = ceddx(ggaa)
         yyyb = ceddy(ggaa)

     '   text1.Text = 2 * r * Cos(kakrd)
      '  text2.Text = 2 * r * Sin(kakrd)
      'text10.Text = xxxb
      'text11.Text = yyyb
       'picture1.Line (xxxb - R / 2, 150 - (yyyb - R / 2))-(xxxb + R / 2, 150 - (yyyb + R / 2)), QBColor(14), BF
       'picture3.Line (xxxb - R / 2, 150 - (yyyb - R / 2))-(xxxb + R / 2, 150 - (yyyb + R / 2)), QBColor(14), BF
        xx = (xxxb + 2 * r * Cos(kakrd))
        yy = (yyyb + 2 * r * Sin(kakrd))
       'picture1.PSet (xx, 150 - yy), QBColor(12)
      'picture1.Line (xx - R / 2, 150 - (yy - R / 2))-(xx + R / 2, 150 - (yy + R / 2)), QBColor(8), BF
    '   picture1.Line (xx - r / 2, 150 - (yy - r / 2))-(xx + r / 2, 150 - (yy + r / 2)), QBColor(8), BF


  '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  allcell = allcell + 1

 If Rnd > (1 - buNRET) Then
   RRGR = r + (Rnd - .5) * PRP
 Else
    RRGR = r
 End If
   ' RRGR = r
 RMOTO = ceddrr(ggaa)   
  'text8.Text = ggaa
  'text9.Text = Int(ggaa)
'^^^^^^^^^^^^^^^^^^
   '  For ryr = 1 To 100
    '    text1.Text = ryr
    ' Next ryr
       
      Xbnod = ceconXb(ggaa) 
      Ybnod = ceconYb(ggaa) 
      coLBB = ceddcoL(ggaa)
      soko = cedsoko(ggaa)
      hiritu = ceddhi(ggaa)

'/---------////// ////---------------------

For celdot = 0 To (RMOTO + RRGR) Step 3
   
   ReDim ceFFx(0 To 500) As Single
   ReDim ceFFy(0 To 500) As Single
   ReDim ceFFR(0 To 500) As Single
   ReDim ceFFBU(0 To 500) As Single
   ReDim ceFFDR(0 To 500) As Single
   ReDim ceFFxbn(0 To 500) As Single
   ReDim ceFFybn(0 To 500) As Single
   ReDim ceFFcoL(0 To 500) As Single
   ReDim ceFFsoko(0 To 500) As Single
   ReDim ceFFhiri(0 To 500) As Single

   'text3.Text = celdot
    rxx = (xxxb + celdot * Cos(kakrd))
    rYY = (yyyb + celdot * Sin(kakrd))
     'ceddx(allcell) = Rxx
     'ceddy(allcell) = RYy
       www = 0
   For nz = 1 To allcell - 1
      If Int(ggaa) = nz Then
        ceFFx(nz) = rxx
        ceFFy(nz) = rYY
        ceFFR(nz) = RRGR
        ceFFBU(nz) = maxbun
        ceFFDR(nz) = kaku
        ceFFxbn(nz) = Xbnod
        ceFFybn(nz) = Ybnod
        ceFFcoL(nz) = coLBB
        ceFFsoko(nz) = soko
        ceFFhiri(nz) = hiritu

       Else
         ceFFx(nz) = ceddx(nz)
         ceFFy(nz) = ceddy(nz)
         ceFFR(nz) = ceddrr(nz)
         ceFFBU(nz) = ceddBUN(nz)
         ceFFDR(nz) = ceddDIR(nz)
        ceFFxbn(nz) = ceconXb(nz)
        ceFFybn(nz) = ceconYb(nz)
        ceFFcoL(nz) = ceddcoL(nz)
        ceFFsoko(nz) = cedsoko(nz)
        ceFFhiri(nz) = ceddhi(nz)

       End If
   Next nz
      ' text9.Text = www
    ' ceFFx(allcell - 1) = Rxx
    ' ceFFy(allcell - 1) = RYy
    ceFFx(allcell) = xxxb
    ceFFy(allcell) = yyyb
    ceFFR(allcell) = RMOTO
    ceFFBU(allcell) = maxbun
    ceFFDR(allcell) = kaku
        ceFFxbn(allcell) = Xbnod
        ceFFybn(allcell) = Ybnod
        ceFFcoL(allcell) = coLBB
        ceFFsoko(allcell) = soko
        ceFFhiri(allcell) = hiritu

     ' ceddcoL(allcell) = 1

  ' GoTo taxx
  ' For nz = 1 To allcell
  '   Print #1, "ceffx "; nz; " "; ceFFx(nz)
  '   Print #1, "ceffy "; nz; " "; ceFFy(nz)
  ' Next nz
 Randomize
  For nz = 1 To allcell - 1
    xxa = ceFFx(nz)
    yya = ceFFy(nz)
    JOU = (xxa - rxx) * (xxa - rxx) + (yya - rYY) * (yya - rYY)
    JOUY = Sqr(JOU)
      'Randomize
    cellkk(nz) = JOUY + Rnd / 100
  Next nz



'^^^^^^^^^^^^^^^^^^^^^^^^^^
                                              
For Rt = 1 To allcell - 1  '    min of kyor
  suti(Rt) = 0
Next Rt
       
For Rt = 1 To allcell - 1
  suti(Rt) = cellkk(Rt)
Next Rt

For BXBX = 1 To allcell - 1
    SUTIMIN = suti(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell - 1
       If suti(j) < SUTIMIN Then
          SUTIMIN = suti(j)
          KMIN = j
       End If
   Next j
       H1 = suti(BXBX)
       H2 = suti(KMIN)
       suti(BXBX) = H2
       suti(KMIN) = H1
Next BXBX
      
     For uu = 1 To allcell - 1
          jja = suti(uu)
         '  ' picture2.Print jja
              For sa = 1 To allcell - 1
                 If jja = cellkk(sa) Then
                      nub = sa
                    Exit For
                 End If
              Next sa
          celjj(uu) = nub
      Next uu
  ' Print #1, "-----------------" '^^^^^^^^^^^^^^^^^^^^^
   ' For uu = 1 To allcell - 1
   '   Print #1, celjj(uu)
    ' Next uu


'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    ' ceFFx(allcell) = ceddx(ggaa)
    ' ceFFy(allcell) = ceddy(ggaa)

 For nax = 1 To allcell - 1
   xaga = ceFFx(celjj(nax))
   yaga = ceFFy(celjj(nax))
   RTRA = ceFFR(celjj(nax))
   BUNKA = ceFFBU(celjj(nax))
   KAKUTA = ceFFDR(celjj(nax))
   XXbnod = ceFFxbn(celjj(nax))
   YYbnod = ceFFybn(celjj(nax))
   coLBBN = ceFFcoL(celjj(nax))
   sokoN = ceFFsoko(celjj(nax))
   hirituNA = 1 / ceFFhiri(celjj(nax))

     For ZJJ = nax + 1 To allcell - 1
                 
        xag = ceFFx(celjj(ZJJ))
        yag = ceFFy(celjj(ZJJ))
        RTR = ceFFR(celjj(ZJJ))
        BUNK = ceFFBU(celjj(ZJJ))
        KAKUT = ceFFDR(celjj(ZJJ))
        hirituN = 1 / ceFFhiri(celjj(ZJJ))
       ll = (xag - xaga) * (xag - xaga) + (yaga - yag) * (yaga - yag)
        LJ = Sqr(ll)
                 xv = xag - xaga
                 yv = yag - yaga
               
              If xv = 0 Then
                 xv = .00000001
              End If

                    hii = yv / xv
             If xv < 0 Then
               kakutu = 180 + Atn(hii) * 180 / pai
             Else
               kakutu = Atn(hii) * 180 / pai
             End If

               siita = kakutu * pai / 180
                 
                 H_RTR = Sqr(RTR * RTR / (Cos(siita) * Cos(siita) + hirituN * hirituN * Sin(siita) * Sin(siita)))
                 H_RTRA = Sqr(RTRA * RTRA / (Cos(siita) * Cos(siita) + hirituNA * hirituNA * Sin(siita) * Sin(siita)))

             If LJ < (H_RTR + H_RTRA) Then
                      
                    gx = xaga + (H_RTR + H_RTRA) * Cos(siita)
                    gy = yaga + (H_RTR + H_RTRA) * Sin(siita)
            
            GoTo mkj
                If kakNN > Rnd Then
                  If gy > squat + 40 Then
                     gy = squat + 40
                  yyyb = yyyb - (gy - squat - 40)
                   ' yyyb = yyyb - (gy - squat)
                    text5.Text = yyyb
                    ceFFy(celjj(nax)) = yaga - (gy - squat - 40)
                  Else
                  gy = gy
                   End If
                 End If
mkj:
                    ceFFx(celjj(ZJJ)) = gx
                    ceFFy(celjj(ZJJ)) = gy
                    ceFFR(celjj(ZJJ)) = RTR
                    ceFFBU(celjj(ZJJ)) = BUNK
                    ceFFDR(celjj(ZJJ)) = KAKUT

          '  LA = (xaga - gx) * (xaga - gx) + (yaga - gy) * (yaga - gy)
           ' LAA = Sqr(LA)

              ' Print #1, "1,"; xaga; ","; yaga; ","; LJ
               ' Print #1, "2,"; xag; ","; yag; ","; LJ
                '  Print #1, "3,"; gx; ","; gy; ","; LAA

                 End If
       Next ZJJ

 Next nax
' 'picture1.Cls
    For maa = 1 To allcell - 1
     ceddx(maa) = ceFFx(maa)
     ceddy(maa) = ceFFy(maa)
     ceddrr(maa) = ceFFR(maa)
     ceddBUN(maa) = ceFFBU(maa)
     ceddDIR(maa) = ceFFDR(maa)
     ceconXb(maa) = ceFFxbn(maa)
     ceconYb(maa) = ceFFybn(maa)
      ceddcoL(maa) = ceFFcoL(maa)
      cedsoko(maa) = ceFFsoko(maa)
     ceddhi(maa) = ceFFhiri(maa)


    Next maa
      ceddx(allcell) = xxxb
      ceddy(allcell) = yyyb
      ceddrr(allcell) = RMOTO
      ceddBUN(allcell) = maxbun + (.5 - Rnd) * 3
      ceddDIR(allcell) = kaku
      ceconXb(allcell) = Xbnod 
      ceconYb(allcell) = Ybnod 
      ceddcoL(allcell) = coLBB
      cedsoko(allcell) = soko
      ceddhi(allcell) = hiritu

      ' text9.Text = www
    ' ceFFx(allcell - 1) = Rxx
    ' ceFFy(allcell - 1) = RYy

'haaa = 1'Int(Rnd * 7)
 'picture1.Cls
'haaa = 1  '8'Int(Rnd * 13)
 '   For MAA = 1 To allcell
      picture1.PSet (ceddx(maa), 150 - ceddy(maa)), QBColor(haaa)
     ' FillColor = QBColor(Int(Rnd * 15))
  '    picture1.Circle (ceddx(MAA), 150 - ceddy(MAA)), ceddrr(MAA), QBColor(haaa)
  '  Next MAA
      'text7.Text = celdot
  ' For ryr = 1 To 1
   '     text1.Text = ryr
   '  Next ryr

Next celdot
    '------------------------------------------------------------
    picture1.Cls
    For maa = 1 To allcell - 1
     ceddx(maa) = ceFFx(maa)
     ceddy(maa) = ceFFy(maa)
      ceddrr(maa) = ceFFR(maa)
     'ceddBUN(MAA) = ceFFBU(MAA)
     ' ceddDIR(MAA) = ceFFDR(MAA)
     ceddBUN(maa) = ceFFBU(maa)
     ceddDIR(maa) = (kakkakA_2 - kakkakA_1) * Rnd + kakkakA_1    

    Next maa
       ceddx(ggaa) = xxxb
       ceddy(ggaa) = yyyb
       ceddrr(ggaa) = RMOTO
     
       ceddx(allcell) = rxx
       ceddy(allcell) = rYY
       ceddrr(allcell) = RRGR
      
      If qap = 0 Then    
       ceddBUN(ggaa) = (Rnd + Rnd) * LAT
       ceddDIR(ggaa) = (kakkakA_2 - kakkakA_1) * Rnd + kakkakA_1   
       'ceddBUN(allcell) = (Rnd + Rnd) * LAT  
       ceddDIR(allcell) = (kakkakA_2 - kakkakA_1) * Rnd + kakkakA_1    
             
      ' GoTo ioio
           If gzg > Rnd Then
                   kwe = 0
               For maa = 1 To allcell - 1
                   vatx = ceddx(maa)
                   vaty = ceddy(maa)
                       sayd = 0
                        
                       For nzn = 1 To allcell - 1
                         kax = vatx - ceddx(nzn)
                         kay = vaty - ceddy(nzn)
                           gja = Sqr(kax * kax + kay * kay)
                           rere = ceddrr(maa) + ceddrr(nzn)
                              If gja < rere + 2 Then
                                      sayd = sayd + 1
                              End If
                        Next nzn
                                text4.Text = sayd
                            If sayd <= 3 And vaty < 0 Then
                             cedsoko(maa) = 1                    
                             kwe = kwe + 1
                             Else cedsoko(maa) = 0
                              
                            End If
                           ' text6.Text = kwe
                  Next maa
                  text6.Text = kwe
                Else
                    For maa = 1 To allcell - 1
                         cedsoko(maa) = 1                   
                    Next maa
                  ' text6.Text = "non"
               End If
ioio:
      Else
       ceddBUN(ggaa) = maxbun  
       ceddDIR(ggaa) = (kakkakA_2 - kakkakA_1) * Rnd + kakkakA_1     
       ceddBUN(allcell) = (Rnd + Rnd) * LAT '
       ceddDIR(allcell) = (kakkakA_2 - kakkakA_1) * Rnd + kakkakA_1    
      ' ceV(qap) = allcell
      End If

' -------- disp ----------
'----
GoTo uba
For Rt = 1 To allcell  '    min of kyor
  suti2(Rt) = 0
Next Rt
For Rt = 1 To allcell
  suti2(Rt) = -ceddBUN(Rt)
Next Rt
For BXBX = 1 To allcell
    SUTIMIN = suti2(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell
       If suti2(j) < SUTIMIN Then
          SUTIMIN = suti2(j)
          KMIN = j
       End If
   Next j
       H1 = suti2(BXBX)
       H2 = suti2(KMIN)
       suti2(BXBX) = H2
       suti2(KMIN) = H1
Next BXBX
uba:
     coibun = text8.Text
      If coibun = 0 Then
         coibun = .001
      End If
    ' text9.Text = suti2(4)

'----
  haaa = 1  '8'Int(Rnd * 13)
    For maa = 1 To allcell
    sg = Abs((ceddBUN(maa) / coibun) * 160)
    If sg < 0 Then
         sg = 1
         ElseIf sg > 230 Then
          sg = 230
     End If
        If ceddcoL(maa) = 1 Then
            sga = 0
            sgb = 0
            sgc = 0
            sgg = 100
         ElseIf ceddcoL(maa) = 0 Then
            sga = 156
            sgb = 256
            sgc = 256
            sgg = 256
         End If
      picture1.DrawWidth = 3
      picture1.PSet (ceddx(maa), 150 - ceddy(maa)), RGB(sgg, sgg, sgg)
        picture1.DrawWidth = 1
     ' FillColor = QBColor(Int(Rnd * 15))
      picture1.Circle (ceddx(maa), 150 - ceddy(maa)), ceddrr(maa), RGB(sga, sgb, sgc), , , ceddhi(maa)
    Next maa
       picture1.Circle (ceddx(ggaa), 150 - ceddy(ggaa)), ceddrr(ggaa) / 3, RGB(50, sg, 0), , , ceddhi(ggaa)
     ' picture1.Line (20, 150 - squat)-(300, 150 - squat)
  '---------------------------------
 'GoTo MAKK


'-----   --------------------------------
    For maa = 1 To allcell
    
    If ceddy(maa) > gran Then 'And Rnd > 0 Then
          ceddhi(maa) = .5 + (.1 - Rnd / 8)
     End If
    Next maa
      
'-----------------------------------

'-----  -------------------------------

If corn > Rnd Then
For Rt = 1 To allcell '   min of kyor
  suti(Rt) = 0
Next Rt
For Rt = 1 To allcell
  suti(Rt) = ceddy(Rt) * -1
Next Rt
For BXBX = 1 To allcell
    SUTIMIN = suti(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell
       If suti(j) < SUTIMIN Then
          SUTIMIN = suti(j)
          KMIN = j
       End If
   Next j
       H1 = suti(BXBX)
       H2 = suti(KMIN)
       suti(BXBX) = H2
       suti(KMIN) = H1
Next BXBX
     maxyty = -1 * suti(1)
     
     For uu = 1 To allcell
          If maxyty = ceddy(uu) Then
              nubb = uu
              Exit For
          End If
      Next uu

      If maxyty > squat Then
         ceddcoL(maxyty) = 0
    '     For guu = nubb + 1 To allcell
    '        ceddy(guu - 1) = ceddy(guu)
    '        ceddx(guu - 1) = ceddx(guu)
    '     Next guu
    '    allcell = allcell - 1
       End If
  
 End If
'-----------------------------------
'----- ----------------------------

If cornda > Rnd Then
For Rt = 1 To allcell '   min of kyor
  suti(Rt) = 0
Next Rt
For Rt = 1 To allcell
  suti(Rt) = ceddy(Rt) * -1
Next Rt
For BXBX = 1 To allcell
    SUTIMIN = suti(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To allcell
       If suti(j) < SUTIMIN Then
          SUTIMIN = suti(j)
          KMIN = j
       End If
   Next j
       H1 = suti(BXBX)
       H2 = suti(KMIN)
       suti(BXBX) = H2
       suti(KMIN) = H1
Next BXBX
     
    ' For kap = 1 To mazx
     maxyty = -1 * suti(1)
     For uu = 1 To allcell
          If maxyty = ceddy(uu) Then
              nubb = uu
              Exit For
          End If
      Next uu

      ceddcoL(nubb) = 0
    '     For guu = nubb + 1 To allcell
    '        ceddy(guu - 1) = ceddy(guu)
    '        ceddx(guu - 1) = ceddx(guu)
    '     Next guu
    '    allcell = allcell - 1
      ' For guu = nubb + 1 To allcell
      '      ceddy(guu - 1) = ceddy(guu)
      '      ceddx(guu - 1) = ceddx(guu)
      '   Next guu
       ' allcell = allcell - 1
      'Next kap
      
  End If

'----------------------------------

MAKK:
Loop
Return
'++++++++++++++++++++++++++++++++++++++++++++++++
 '  GoTo jjaabb



ffkabb:
    For maa = 1 To allcell
      'picture3.PSet (ceddx(maa), 150 - ceddy(maa)), QBColor(haaa)
      'picture3.Circle (ceddx(maa), 150 - ceddy(maa)), R, QBColor(haaa)
    Next maa
    'text7.Text = allcell
    For maa = 1 To basee
      '  'picture3.PSet (gax(maa), 150 - gay(maa)), QBColor(12)
     ' 'picture3.Circle (gax(maa), 150 - gay(maa)), r, QBColor(12)
    Next maa

taxxabb:
     For maa = 1 To allcell
     ceddx(maa) = ceFFx(maa)
     ceddy(maa) = ceFFy(maa)
    Next maa

    For maa = 1 To allcell
      'picture3.PSet (ceddx(maa), 150 - ceddy(maa)), QBColor(haaa)
      'picture3.Circle (ceddx(maa), 150 - ceddy(maa)), R, QBColor(haaa)
    Next maa




'***************************
gppabb:
For Rt = 1 To gp  '    min of kyor
  suti2(Rt) = 0
Next Rt
For Rt = 1 To gp
  suti2(Rt) = najj(Rt)
Next Rt
For BXBX = 1 To gp
    SUTIMIN = suti2(BXBX)
    KMIN = BXBX
   For j = BXBX + 1 To gp
       If suti2(j) < SUTIMIN Then
          SUTIMIN = suti2(j)
          KMIN = j
       End If
   Next j
       H1 = suti2(BXBX)
       H2 = suti2(KMIN)
       suti2(BXBX) = H2
       suti2(KMIN) = H1
Next BXBX
       minyyy = suti2(1)


Return
'--------------------------
inin:

   For va = 1 To allcell
       Print #4, ceddrr(va); ",";
       Print #4, ceddx(va); ",";
       Print #4, ceddy(va); ",";
       Print #4, ceddBUN(va); ",";        ' ----  0  to  2.0
       Print #4, ceddDIR(va); ",";
       Print #4, ceconXb(va); ",";   ' 
       Print #4, ceconYb(va); ",";     
       Print #4, ceddcoL(va); ",";
       Print #4, cedsoko(va); ",";
       Print #4, ceddhi(va)
   Next va




Return

'/////
jjaabb:


'  --   All rights reserved to Eiichi YAGI --------

'-----   EPI1.exe -------
'-- Made by Eiichi YAGI MD 1999-----
'---- Dermatologist, Akita, Japan -----
'---- yagi-ext@nisiq.net -------