⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 模拟蜜蜂采蜜的具有人工生命特性的VB程序 可以作为学习人工生命的一个不错的入门
💻 FRM
📖 第 1 页 / 共 3 页
字号:
End With
With PicG
.Height = 8360
.Width = 7564
.Top = 20
.Left = 50
.Cls
End With
Stat1.Panels(1) = "Waiting..."
ReDim Qbs(Hsum)
clr(1, 0) = RGB(200, 100, 0)
clr(1, 1) = RGB(200, 100, 100)
clr(1, 2) = RGB(200, 100, 200)
clr(1, 3) = RGB(250, 100, 50)
clr(1, 4) = RGB(250, 100, 150)
clr(2, 0) = RGB(200, 150, 0)
clr(2, 1) = RGB(100, 200, 200)
clr(2, 2) = RGB(200, 0, 250)
clr(2, 3) = RGB(150, 150, 50)
clr(2, 4) = RGB(150, 0, 150)
clr(0, 0) = RGB(50, 200, 0)
clr(0, 1) = RGB(240, 240, 240)
clr(0, 2) = RGB(250, 50, 150)
Creator
Frmrefresh

End Sub

Private Sub mnuC_Click()
ComC_Click
End Sub

Private Sub mnuE_Click()
End
End Sub

Private Sub mnuR_Click()
Form_Load
End Sub

Private Sub mnuS_Click()
TimeInl = Int(100 / InputBox("Enter the speed(h/s):", Speed, 1) + 0.99)
 Timer1.Interval = TimeInl
End Sub

Private Sub mnuSP_Click()
ComS_Click
End Sub

Private Sub Timer1_Timer()
Static f As Long
Static Radd As Boolean
Dim i As Long, j As Integer
Dim aX As Integer, aY As Integer, hX As Integer, hY As Integer, s As Integer
Dim Dadd As Boolean
Dim flag As Boolean
'Dim B As New Bee
Ntime.m = Ntime.m + 1
If Ntime.m = 10 Then
Ntime.h = Ntime.h + 1
Ntime.m = 0
If Ntime.h = 24 Then Ntime.d = Ntime.d + 1: Ntime.h = 0: Dadd = True
End If
If Rsum < LowRate Then Radd = True
If Dadd Then
    For i = 1 To Hsum
      If Qbs(i).Alive Then
        For j = 1 To 2
        Bsum = Bsum + 1
        Creatbee (i)
        Bees(Bsum).Age = 0
        Next j
      End If
    Next i


If Radd Then
j = Int(Rnd * 500 / AvyRate + 0.99)
    For i = 1 To j
    Fsum = Fsum + 1
    CreatFlower (Fsum)
    Next i
End If
End If
If Rsum > UpRate Then Radd = False
''''''''''''bee.move

'flag = True
'If b.Age < 21 And Hives(b.Hive).iRsum > iLowRate And b.rate = False Then
'aX = b.X: aY = b.Y
'    Do While flag
'    b.X = aX + (7 - 14 * Rnd)
'    b.Y = aY + (7 - 14 * Rnd)
'    If Sqr((b.Y - Hives(b.Hive).Y) ^ 2 + (b.X - Hives(b.Hive).X) ^ 2) < 2.5 * Hives(b.Hive).R Then flag = False
'    Loop
'
'Else
'    If b.rate Then
'    hX = Hives(b.Hive).X
'    hY = Hives(b.Hive).Y
'        If Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2) < Hives(b.Hive).R Then
'        b.rate = False
'        Hives(b.Hive).iRsum = Hives(b.Hive).iRsum + 1
'        Else
'        S = Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2)
'        aY = b.Y
'        aX = b.X
'        b.Y = b.Y + (hY - b.Y) * 7 / S
'        b.X = b.X + (hX - b.X) * 7 / S
'        j = 1: flag = True
'            Do While flag
'            flag = False
'                If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'                Do While j <= Tsum And flag = False
'                If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'                j = j + 1
'                Loop
'                If flag Then
'                b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'                b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'                End If
'            Loop
'        End If
'    Else
'    flag = True: i = Tsum + 1: S = 10000
'        Do While flag And i <= Fsum + Tsum
'
'        If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < FTs(i).R Then flag = False: j = i: Exit Do
'        If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < S Then S = Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2): j = i
'
'        i = i + 1
'        Loop
'
'        If flag Then
'        aY = b.Y
'        aX = b.X
'        b.Y = b.Y + (FTs(j).Y - b.Y) * 7 / S
'        b.X = b.X + (FTs(j).X - b.X) * 7 / S
'        j = 1: flag = True
'            Do While flag
'            flag = False
'                If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'                Do While j <= Tsum And flag = False
'                If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'                j = j + 1
'                Loop
'                If flag Then
'                b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'                b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'                End If
'            Loop
'        Else
'        b.rate = True
'        FTs(j).rate = FTs(j).rate - 1
'        Rsum = Rsum - 1
'            If FTs(j).rate = 0 Then
'            FTs.Remove (j)
'            Fsum = Fsum - 1
'            End If
'        End If
'    End If
'
'
'End If

'If b.Age >= 21 Then
'  If b.rate = True Then
'    hX = Hives(b.Hive).X
'    hY = Hives(b.Hive).Y
'     If Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2) < Hives(b.Hive).R Then
'       b.rate = False
'       Hives(b.Hive).iRsum = Hives(b.Hive).iRsum + 1
'     Else
'       s = Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2)
'       aY = b.Y
'       aX = b.X
'       b.Y = b.Y + (hY - b.Y) * 7 / s
'       b.X = b.X + (hX - b.X) * 7 / s
'       j = 1: flag = True
'        Do While flag
'          flag = False
'          If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'            Do While j <= Tsum And flag = False
'              If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'              j = j + 1
'             Loop
'               If flag Then
'               b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'               b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'               End If
'        Loop
'     End If
'  Else
'    flag = True: i = Tsum + 1: s = 10000
'      Do While flag And i <= Fsum + Tsum
'
'      If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < FTs(i).R Then flag = False: j = i: Exit Do
'      If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < s Then s = Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2): j = i
'
'      i = i + 1
'      Loop
'
'      If flag Then
'      aY = b.Y
'      aX = b.X
'      b.Y = b.Y + (FTs(j).Y - b.Y) * 7 / s
'      b.X = b.X + (FTs(j).X - b.X) * 7 / s
'      j = 1: flag = True
'         Do While flag
'          flag = False
'             If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'             Do While j <= Tsum And flag = False
'             If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'             j = j + 1
'             Loop
'             If flag Then
'             b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'             b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'             End If
'         Loop
'      Else
'      b.rate = True
'      FTs(j).rate = FTs(j).rate - 1
'      Rsum = Rsum - 1
'         If FTs(j).rate = 0 Then
'         FTs.Remove (j)
'         Fsum = Fsum - 1
'         End If
'      End If
'  End If
'Else
'  If Hives(b.Hive).iRsum < iLowRate Then
'    If b.rate = True Then
'      hX = Hives(b.Hive).X
'      hY = Hives(b.Hive).Y
'       If Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2) < Hives(b.Hive).R Then
'       b.rate = False
'       Hives(b.Hive).iRsum = Hives(b.Hive).iRsum + 1
'       Else
'       s = Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2)
'       aY = b.Y
'       aX = b.X
'       b.Y = b.Y + (hY - b.Y) * 7 / s
'       b.X = b.X + (hX - b.X) * 7 / s
'       j = 1: flag = True
'        Do While flag
'          flag = False
'          If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'            Do While j <= Tsum And flag = False
'              If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'              j = j + 1
'             Loop
'               If flag Then
'               b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'               b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'               End If
'        Loop
'        End If
'    Else
'       flag = True: i = Tsum + 1: s = 10000
'        Do While flag And i <= Fsum + Tsum
'
'        If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < FTs(i).R Then flag = False: j = i: Exit Do
'        If Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2) < s Then s = Sqr((FTs(i).X - b.X) ^ 2 + (FTs(i).Y - b.Y) ^ 2): j = i
'
'        i = i + 1
'        Loop
'
'        If flag Then
'         aY = b.Y
'         aX = b.X
'         b.Y = b.Y + (FTs(j).Y - b.Y) * 7 / s
'         b.X = b.X + (FTs(j).X - b.X) * 7 / s
'         j = 1: flag = True
'         Do While flag
'          flag = False
'             If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'             Do While j <= Tsum And flag = False
'             If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'             j = j + 1
'             Loop
'             If flag Then
'             b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'             b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'             End If
'         Loop
'        Else
'           b.rate = True
'           FTs(j).rate = FTs(j).rate - 1
'           Rsum = Rsum - 1
'          If FTs(j).rate = 0 Then
'            FTs.Remove (j)
'            Fsum = Fsum - 1
'          End If
'        End If
'    End If
'
'  Else
'    If b.rate = True Then
'      hX = Hives(b.Hive).X
'      hY = Hives(b.Hive).Y
'     If Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2) < Hives(b.Hive).R Then
'      b.rate = False
'      Hives(b.Hive).iRsum = Hives(b.Hive).iRsum + 1
'     Else
'       s = Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2)
'       aY = b.Y
'       aX = b.X
'       b.Y = b.Y + (hY - b.Y) * 7 / s
'       b.X = b.X + (hX - b.X) * 7 / s
'       j = 1: flag = True
'        Do While flag
'          flag = False
'          If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'            Do While j <= Tsum And flag = False
'              If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'              j = j + 1
'             Loop
'               If flag Then
'               b.X = aX + Int(Rnd * 7) * (3750 - b.X) / Abs(3750 - b.X)
'               b.Y = aY + Int(Sqr(49 - (b.X - aX) ^ 2)) * (Round(Rnd) * 2 - 1)
'               End If
'        Loop
'     End If
'    Else
'      If Sqr((b.Y - Hives(b.Hive).Y) ^ 2 + (b.X - Hives(b.Hive).X) ^ 2) > 2.5 * Hives(b.Hive).R Then
'       s = Sqr((b.Y - hY) ^ 2 + (b.X - hX) ^ 2)
'       aY = b.Y
'       aX = b.X
'       b.Y = b.Y + (hY - b.Y) * 7 / s
'       b.X = b.X + (hX - b.X) * 7 / s
'       j = 1: flag = True
'        Do While flag
'          flag = False
'          If b.X < 0 Or b.X > 7500 Or b.Y < 0 Or b.Y > 7500 Then flag = True
'            Do While j <= Tsum And flag = False
'              If Sqr((FTs(j).X - b.X) ^ 2 + (FTs(j).Y - b.Y) ^ 2) < FTs(j).R + 20 Then flag = True
'              j = j + 1
'            Loop

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -