流动.frm

微生物膜生长的模拟

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   9525
   ClientLeft      =   165
   ClientTop       =   825
   ClientWidth     =   9885
   LinkTopic       =   "Form1"
   ScaleHeight     =   9525
   ScaleWidth      =   9885
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000007&
      Height          =   10000
      Left            =   0
      ScaleHeight     =   9945
      ScaleWidth      =   9945
      TabIndex        =   0
      Top             =   0
      Width           =   10000
      Begin MSComDlg.CommonDialog CommonDialog1 
         Left            =   3720
         Top             =   4560
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
   End
   Begin VB.Menu menu_edit 
      Caption         =   "edit"
      Begin VB.Menu menu_do 
         Caption         =   "do"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const tip = 1000
Const dodo = 1000
Dim x1 As Single, y1 As Single, x As Single, y As Single, j As Double, i As Single, m As Single


Private Sub Form_Load()
Me.CommonDialog1.InitDir = App.Path
Me.CommonDialog1.Filter = "所有文件|*.*|bmp文件|*.bmp"
Me.CommonDialog1.DefaultExt = "*.bmp"
FileName = " "
End Sub

Private Sub menu_copy_Click()
Clipboard.SetData Me.Picture1.Image
End Sub

Private Sub menu_do_Click()
Me.Picture1.Cls
Picture1.Scale (0, 0)-(tip, tip)
For i = 0 To 9
Randomize
x1 = Int(Rnd * tip)
Randomize
y1 = Int(Rnd * tip)
Me.Picture1.PSet (x1, y1), vbGreen '画起始点
Next i

  Randomize Timer
For i = 1 To 10000
Call psetdo
 Next i
 For x = 0 To tip
 For y = 0 To tip
 If Me.Picture1.Point(x, y) = vbRed Then Picture1.PSet (x, y), vbBlack
 Next y
 Next x
 
 
 
End Sub

Private Sub psetdo()

  Randomize Timer
  

For j = 1 To dodo
  
  
   x = Int(Rnd * tip)
   y = Int(Rnd * tip)

If Me.Picture1.Point(x, y) = vbBlack Then Me.Picture1.PSet (x, y), vbBlack
      'n1 = Me.Picture1.Point(x - 1, y - 1)
     ' n2 = Me.Picture1.Point(x, y - 1)
     ' n3 = Me.Picture1.Point(x + 1, y - 1)
      n4 = Me.Picture1.Point(x - 1, y)
      n5 = Me.Picture1.Point(x + 1, y)
      n6 = Me.Picture1.Point(x - 1, y + 1)
      n7 = Me.Picture1.Point(x, y + 1)
      n8 = Me.Picture1.Point(x + 1, y + 1)
      
      m = (n4 + n5 + n6 + n7 + n8) / 65280
      
Select Case m
               Case 0
               Me.Picture1.PSet (x, y), vbBlack
               Case 1
               If Picture1.Point(x - 1, y) = vbGreen And Picture1.Point(x + 1, y) + Picture1.Point(x + 2, y) + Picture1.Point(x + 3, y) + Picture1.Point(x + 4, y) + Picture1.Point(x + 5, y) = 0 Or _
                  Picture1.Point(x + 1, y) = vbGreen And Picture1.Point(x - 1, y) + Picture1.Point(x - 2, y) + Picture1.Point(x - 3, y) + Picture1.Point(x - 4, y) + Picture1.Point(x - 5, y) = 0 Or _
                  Picture1.Point(x - 1, y + 1) = vbGreen And Picture1.Point(x + 1, y - 1) + Picture1.Point(x + 2, y - 2) + Picture1.Point(x + 3, y - 3) + Picture1.Point(x + 4, y - 4) + Picture1.Point(x + 5, y - 5) = 0 Or _
                  Picture1.Point(x, y + 1) = vbGreen And Picture1.Point(x, y - 1) + Picture1.Point(x, y - 2) + Picture1.Point(x, y - 3) + Picture1.Point(x, y - 4) + Picture1.Point(x, y - 5) = 0 Or _
                  Picture1.Point(x + 1, y + 1) = vbGreen And Picture1.Point(x - 1, y - 1) + Picture1.Point(x - 2, y - 2) + Picture1.Point(x - 3, y - 3) + Picture1.Point(x - 4, y - 4) + Picture1.Point(x - 5, y - 5) = 0 Then
                  Me.Picture1.PSet (x, y), vbGreen
                 
               End If
               Case 2
               If Picture1.Point(x - 1, y) = vbGreen And Picture1.Point(x + 1, y) + Picture1.Point(x + 2, y) + Picture1.Point(x + 3, y) + Picture1.Point(x + 4, y) + Picture1.Point(x + 5, y) = 0 Or _
                  Picture1.Point(x + 1, y) = vbGreen And Picture1.Point(x - 1, y) + Picture1.Point(x - 2, y) + Picture1.Point(x - 3, y) + Picture1.Point(x - 4, y) + Picture1.Point(x - 5, y) = 0 Or _
                  Picture1.Point(x - 1, y + 1) = vbGreen And Picture1.Point(x + 1, y - 1) + Picture1.Point(x + 2, y - 2) + Picture1.Point(x + 3, y - 3) + Picture1.Point(x + 4, y - 4) + Picture1.Point(x + 5, y - 5) = 0 Or _
                  Picture1.Point(x, y + 1) = vbGreen And Picture1.Point(x, y - 1) + Picture1.Point(x, y - 2) + Picture1.Point(x, y - 3) + Picture1.Point(x, y - 4) + Picture1.Point(x, y - 5) = 0 Or _
                  Picture1.Point(x + 1, y + 1) = vbGreen And Picture1.Point(x - 1, y - 1) + Picture1.Point(x - 2, y - 2) + Picture1.Point(x - 3, y - 3) + Picture1.Point(x - 4, y - 4) + Picture1.Point(x - 5, y - 5) = 0 Then
                  Me.Picture1.PSet (x, y), vbGreen
                 
               End If
               Case 3
              If Picture1.Point(x - 1, y) = vbGreen And Picture1.Point(x + 1, y) + Picture1.Point(x + 2, y) + Picture1.Point(x + 3, y) + Picture1.Point(x + 4, y) + Picture1.Point(x + 5, y) = 0 Or _
                  Picture1.Point(x + 1, y) = vbGreen And Picture1.Point(x - 1, y) + Picture1.Point(x - 2, y) + Picture1.Point(x - 3, y) + Picture1.Point(x - 4, y) + Picture1.Point(x - 5, y) = 0 Or _
                  Picture1.Point(x - 1, y + 1) = vbGreen And Picture1.Point(x + 1, y - 1) + Picture1.Point(x + 2, y - 2) + Picture1.Point(x + 3, y - 3) + Picture1.Point(x + 4, y - 4) + Picture1.Point(x + 5, y - 5) = 0 Or _
                  Picture1.Point(x, y + 1) = vbGreen And Picture1.Point(x, y - 1) + Picture1.Point(x, y - 2) + Picture1.Point(x, y - 3) + Picture1.Point(x, y - 4) + Picture1.Point(x, y - 5) = 0 Or _
                  Picture1.Point(x + 1, y + 1) = vbGreen And Picture1.Point(x - 1, y - 1) + Picture1.Point(x - 2, y - 2) + Picture1.Point(x - 3, y - 3) + Picture1.Point(x - 4, y - 4) + Picture1.Point(x - 5, y - 5) = 0 Then
                  Me.Picture1.PSet (x, y), vbGreen
                 
               End If
               Case 4
             Me.Picture1.PSet (x, y), vbRed
                 
               
               Case 5
               Me.Picture1.PSet (x, y), vbRed
               'Case 6
               'Me.Picture1.PSet (x, y), vbRed
              ' Case 7
              ' Me.Picture1.PSet (x, y), vbRed
              ' Case 8
              ' Me.Picture1.PSet (x, y), vbRed
               
l:             End Select
     m = 0
    'If j Mod 1000000 = 1 Then FileName = j
  
   ' SavePicture Me.Picture1.Image, FileName
  
 Next j
     
 
End Sub

Private Sub menu_paste_Click()
Picture1.Picture = Clipboard.GetData
End Sub

Private Sub menu_save_Click()
Me.CommonDialog1.ShowSave
FileName = Me.CommonDialog1.FileName
SavePicture Me.Picture1.Image, FileName

End Sub