INABIS '98 - A Method of Getting Stable Results in Measuring the Texture of Skin Eruption

' Cell growth program type 1 ver1.5 beta by Eiichi Yagi MD

' These codes are available for Visual Basic 2.0 or later (4.0,5.0,6.0).
' Some objects and setting of these properties are needed to run this program
' as follows.
' -- Object ---
' Form1
' Picture1-- scalemode=user or pixel, scaleheight > 320, scalewidth > 520
' command1
' Text1 to 6 , text2.text=0.3
'++++++ These codes are hard to read, because text file of Basic codes were
' transformed to html file.
'++++++ Sorce codes after removing HTML BR codes are available for Basic compiler.

'  -----  general   

Dim jaja As Integer  

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

'//////////////////  Main /////////////////////////////  

Sub_code for command1.click  

  

   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      '  X coordinate of each cell  

   ReDim ceddy(0 To 500) As Single      '  Y coordinate of each cell  

   ReDim ceddrr(0 To 500) As Single     '  Radius of each cell  

   ReDim ceddBUN(0 To 500) As Single    '  Division determination of each cell  

   ReDim ceddDIR(0 To 500) As Single    '  Direction of each divided cell  

  

   ReDim ceV(0 To 100) As Single    'The history of continuous division of each cell  

  

   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  

  

'**************  Initial configuration  ************  

r = 5         ' radius  

tate = 50     ' height  

yoko = 200    ' width  

allcelL = 17  ' cell number -- initial   

basee = 14  

squat = 30    ' distance to horny layer  

buNRET = 0    ' frequency of division --  0 to 1  

PRP = 4       'difference of cell size in division   

              '3 accords in modification amplitude of -1.5 to +1.5   

kakkak = 360     'Division angle  180= 0 to 180  Preferences  

kakkakA = 360    'Division angle after division  180= 0 to 180  set  

  

GoSub kakrt   'Division angle -- routine  

  

ddj = 5 * Rnd + 10    'Division frequency with the same range  

LAT = .1    'forbidden to divide after successive division  

kakNN = .7   ' elasticity of horny layer -- 0 to 1 , max=1  

corn = .3    ' elimination frequency of horny layer - at squat level : 0 to 1  max=1  

cornda = .1   'elimination frequency of horny layer - not relation to squat level :0 to 1 max=1  

mazx = 1      '	number of horny layer of tornning off  

gzg = .85    '  frequency of division in only basal layer : 0 to 1  :max= 1   

fasx = 2       'location of next deviding cell after previous division  

' Open "d:\testfr.txt" For Output As #1  

  

' Preferences  

uh = 1  

       ' ceddx(1) = 250  

       ' ceddy(1) = 0  

'*******************  ******************** *****  **********  

   For va = 1 To allcelL  

         ceddrr(va) = r + Rnd / 5  

         ceddx(va) = 70 + 2 * ceddrr(va) * va  

         ceddy(va) = Rnd  

         ceddBUN(va) = Rnd + Rnd     ' ----  0  to  2.0  

              GoSub kakrt  

         ceddDIR(va) = kakkak * Rnd  

   Next va  

      ' allcell = va  

GoTo jjkkabb  

'*******************************  *****************  **********  

Randomize  

BU = 0  

          ceddx(1) = 50  

          ceddy(1) = 25  

  kq = 0  

  UA = 0  

 'Determination of the first cell -------------  

   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  ****************************************  

   gagaga = 1  

   qap = 0  

   ggaa = allcelL  

Do Until allcelL >= 500 Or jaja = 1  

   text1.Text = allcelL  

 ' Processing in division of the same pars -----------  

   qap = qap + 1  

   If qap > ddj Then  

     qap = 0  

   End If  

                                   

'Beep  

    'ggaa = Int(allcell * Rnd) + 1  'Division cell is decided  

        'ggaa = 5  

    'If ggaa > allcell Then  

     '  ggaa = allcell  

    'End If  

  'Division cell is decided  

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  

      maxBun = -suti2(1)  

            For sa = 1 To allcelL  

          If maxBun = ceddBUN(sa) Then  

               NUB = sa  

               Exit For  

          End If  

       Next sa  

       ggaa = NUB  

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:  

'---  Determination of direction of division cell --亅亅亅亅亅亅亅亅亅亅亅  

'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  

'Determination of radius   

 If Rnd > (1 - buNRET) Then  

   RRGR = r + (Rnd - .5) * PRP  

 Else  

    RRGR = r  

 End If  

   ' RRGR = r  

 RMOTO = ceddrr(ggaa)      '  Original r  

  'text8.Text = ggaa  

  'text9.Text = Int(ggaa)  

'^^^^^^^^^^^^^^^^^^  

   '  For ryr = 1 To 100  

    '    text1.Text = ryr  

    ' Next ryr  

  

'**************************** start of division ************************  

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  

  

    '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  

       Else  

         ceFFx(nz) = ceddx(nz)  

         ceFFy(nz) = ceddy(nz)  

         ceFFR(nz) = ceddrr(nz)  

         ceFFBU(nz) = ceddBUN(nz)  

         ceFFDR(nz) = ceddDIR(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  

  

  ' 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))  

     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))  

  

       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  

                   

                 If LJ < (RTR + RTRA) Then  

                        

                    gx = xaga + (RTR + RTRA) * Cos(siita)  

                    gy = yaga + (RTR + RTRA) * Sin(siita)  

            'Processing in horny layer   

                If kakNN > Rnd Then  

                  If gy > squat Then  

                     gy = squat  

                  yyyb = yyyb - (gy - squat)  

                   ' yyyb = yyyb - (gy - squat)  

                    text5.Text = yyyb  

                    ceFFy(celjj(nax)) = yaga - (gy - squat)  

                  Else  

                  gy = gy  

                   End If  

                 End If  

              

                    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)  

    Next maa  

      ceddx(allcelL) = xxxb  

      ceddy(allcelL) = yyyb  

      ceddrr(allcelL) = RMOTO  

      ceddBUN(allcelL) = maxBun  

      ceddDIR(allcelL) = kaku  

    ' 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)       ' Adjustment of division frequency  

        GoSub kakrt  

     ceddDIR(maa) = kakkakA '* Rnd     'Adjustment of division angle  

  

    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 '  Adjustment of division frequency  

         GoSub kakrt  

       ceddDIR(ggaa) = kakkakA   '* Rnd      ' Adjustment of division angle  

       ceddBUN(allcelL) = (Rnd + Rnd) * LAT  '  Adjustment of division frequency  

         GoSub kakrt  

       ceddDIR(allcelL) = kakkakA   '* Rnd     ' Adjustment of division angle  

              'Division of basal layer   

           If gzg > Rnd Then  

               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  

                            If sayd <= 3 And vaty < 1 Then  

                             ceddBUN(maa) = ceddBUN(maa) + maxBun + Rnd  

                             'text6.Text = vaty  

                            End If  

                  Next maa  

               End If  

                 

      Else  

       ceddBUN(ggaa) = maxBun                'Adjustment of division frequency  

          GoSub kakrt  

       ceddDIR(ggaa) = kakkakA '* Rnd        'Adjustment of division angle  

       ceddBUN(allcelL) = (Rnd + Rnd) * LAT  'Adjustment of division frequency  

          GoSub kakrt  

       ceddDIR(allcelL) = kakkakA   '* Rnd   'Adjustment of division angle  

       ceV(qap) = allcelL  

      End If  

  

 'Prior division processing of distance region  

 If qap = 0 Then  

 ReDim kyoW(1 To 500) As Single  

   Xbig = ceddx(ggaa)  

   ybig = ceddy(ggaa)  

          For jr = 1 To allcelL  

              jxa = ceddx(jr) - Xbig  

              jya = ceddy(jr) - ybig  

              Xytt = Sqr(jxa * jxa + jya * jya)  

              kyoW(jr) = Xytt  

          Next jr  

For Rt = 1 To allcelL  '    min of kyor  

  suti2(Rt) = 0  

Next Rt  

For Rt = 1 To allcelL  

  suti2(Rt) = -kyoW(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  

      toi = Int((allcelL / fasx) * Rnd + 1)  

      maxzz = -suti2(toi)  

       For saa = 1 To allcelL  

          If maxzz = kyoW(saa) Then  

               NUBa = saa  

               Exit For  

          End If  

       Next saa  

       ceddBUN(NUBa) = maxBun + (.5 - Rnd)  

End If  

  

' -------- Display processing----------  

  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) / uh, QBColor(haaa)  

    Next maa  

       picture1.Circle (ceddx(ggaa), 150 - ceddy(ggaa)), ceddrr(ggaa) / 3, QBColor(12)  

     ' picture1.Line (20, 150 - squat)-(300, 150 - squat)  

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

 'GoTo MAKK  

  

'-----  Elimination processing of arrival in horny layer  ------------------------------  

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  

         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  

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

'-----  Elimination processing in horny layer--------------------------------  

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(kap)  

     For uu = 1 To allcelL  

          If maxyty = ceddy(uu) Then  

              nubb = uu  

              Exit For  

          End If  

      Next uu  

      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  

  

   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  

'*******************************************************************  

kakrt:  

'Randomize  

If Rnd > .5 Then  

kakkak = 20 * Rnd + 80    'Division angle  180= 0 to 180   Initial  

kakkakA = 20 * Rnd + 80   'Division angle after division 180= 0 to 180  Initial  

Else  

  

kakkak = 30 * Rnd + 255   'Division angle  180= 0 to 180   Initial  

kakkakA = 30 * Rnd + 255  'Division angle after division 180= 0 to 180   Initial  

End If  

Return  

'*******************************************************************  

jjaabb:  

End

Retuen
'////////////////////////////////////////////////////////////////////
'All codes were written by Eiichi Yagi
'Eiichi Yagi MD
'Depatment of Dermatology
'Akita Red Cross Hospital, Akita, JAPAN

back
' Cell growth program type 1 ver1.5 beta by Eiichi Yagi MD

'++++++ These codes are hard to read, because text file of Basic codes were ' transformed to html file. '++++++ Sorce codes after removing HTML BR codes are available for Basic compiler.

'All codes were written by Eiichi Yagi 'Eiichi Yagi MD 'Depatment of Dermatology 'Akita Red Cross Hospital, Akita, JAPAN

'++++++ These codes are hard to read, because text file of Basic codes were
' transformed to html file.
'++++++ Sorce codes after removing HTML BR codes are available for Basic compiler.

'All codes were written by Eiichi Yagi
'Eiichi Yagi MD
'Depatment of Dermatology
'Akita Red Cross Hospital, Akita, JAPAN
