form1.frm

内含生长出来的sierpinski垫片源代码。双击F_move04.exe文件

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H8000000A&
   Caption         =   "IFS动画（分形频道：fractal.cn）2004"
   ClientHeight    =   7260
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10155
   LinkTopic       =   "Form1"
   ScaleHeight     =   7260
   ScaleWidth      =   10155
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退  出"
      Height          =   375
      Left            =   9000
      TabIndex        =   2
      Top             =   960
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "绘  制"
      Height          =   375
      Left            =   9000
      TabIndex        =   1
      Top             =   360
      Width           =   975
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000017&
      Height          =   6975
      Left            =   120
      ScaleHeight     =   6915
      ScaleWidth      =   8595
      TabIndex        =   0
      Top             =   120
      Width           =   8655
   End
   Begin VB.PictureBox Picture2 
      Height          =   1455
      Left            =   5040
      ScaleHeight     =   1395
      ScaleWidth      =   555
      TabIndex        =   3
      Top             =   2520
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Dim PixelToTwip_X As Single
Dim PixelToTwip_Y As Single

Private Sub ifs(k As Single, n As Long, pic As PictureBox)
  Dim x As Single, y As Single '仿射变换中的自变量
  Dim newx As Single, newy As Single '仿射变换产生的新点
  Dim a As Single, b As Single, c As Single, d As Single, e As Single, f As Single '仿射变幻中的系数

  Dim R As Single '随机变量
  Dim m(7, 7) '存放IFS码
  Dim s(7) As Single
  
  Randomize Timer
  x = 0: y = 0
 
 
 'IFS码赋值
  m(0, 0) = 0.5:     m(0, 1) = 0#:  m(0, 2) = 0#:  m(0, 3) = 0.5:  m(0, 4) = 0#:   m(0, 5) = 0#:  m(0, 6) = 0.333
  m(1, 0) = 0.5:   m(1, 1) = 0#:  m(1, 2) = 0#:  m(1, 3) = k:    m(1, 4) = k:    m(1, 5) = 0#:  m(1, 6) = 0.333
  m(2, 0) = k:   m(2, 1) = 0:   m(2, 2) = 0#:  m(2, 3) = 0.5:  m(2, 4) = 0.25: m(2, 5) = k:   m(2, 6) = 0.334
   
  s(1) = m(0, 6)
  s(2) = m(0, 6) + m(1, 6)
  s(3) = m(0, 6) + m(1, 6) + m(2, 6)
 
 '循环迭代，在不同的概率空间下，赋不同的IFS码值

  While n > 0
        R = Rnd
    Select Case R
     Case Is <= s(1)
       
         a = m(0, 0): b = m(0, 1): c = m(0, 2): d = m(0, 3): e = m(0, 4): f = m(0, 5)
        
      Case Is <= s(2)
        
         a = m(1, 0): b = m(1, 1): c = m(1, 2): d = m(1, 3): e = m(1, 4): f = m(1, 5)
      
      Case Is <= s(3)
         
         a = m(2, 0): b = m(2, 1): c = m(2, 2): d = m(2, 3): e = m(2, 4): f = m(2, 5)
        
    End Select
      newx = (a * x) + (b * y) + e
      newy = (c * x) + (d * y) + f
      x = newx: y = newy
      DoEvents
     
     
      SetPixelV pic.hdc, (1200 + 5900 * x) / PixelToTwip_X, (6000 - 5000 * y) / PixelToTwip_Y, _
       RGB(Abs(k * 100) Mod 256, Abs(x * 150) Mod 256, Abs(y * 200) Mod 256)
      n = n - 1
      
  Wend
  
End Sub


Private Sub Command1_Click()
 Dim k As Single, n As Long, i As Integer, j As Integer
 Dim MemDC As Long
 
 k = -0.01
 
 
 Call ifs(k, n, Picture1)

  For i = 0 To 50
    
    k = k + 0.01
    n = n + 5000
    
    Call ifs(k, n, Picture2)
    Picture1.PaintPicture Picture2.Image, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
    0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
    Picture2.Cls
  Next

  n = 50000
  Call ifs(k, n, Picture1)
  
  
 
 
End Sub

Private Sub Command2_Click()
  End
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = False
With Picture2
.Left = Picture1.Left
.Top = Picture1.Top
.Height = Picture1.Height
.Width = Picture1.Width
.AutoRedraw = True
.BackColor = Picture1.BackColor
End With

PixelToTwip_X = Screen.TwipsPerPixelX
PixelToTwip_Y = Screen.TwipsPerPixelY
End Sub