form1.frm

mandebrot 研究混沌用的程序很好的下吧

VERSION 4.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Mandelbrot"
   ClientHeight    =   2295
   ClientLeft      =   1020
   ClientTop       =   1995
   ClientWidth     =   2685
   DrawMode        =   6  'Mask Pen Not
   Height          =   2985
   Left            =   960
   LinkTopic       =   "Form1"
   MousePointer    =   2  'Cross
   ScaleHeight     =   153
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   179
   Top             =   1365
   Width           =   2805
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuScale 
      Caption         =   "&Scale"
      Begin VB.Menu mnuSetScale 
         Caption         =   "x &2"
         Index           =   1
      End
      Begin VB.Menu mnuSetScale 
         Caption         =   "x &4"
         Index           =   2
      End
      Begin VB.Menu mnuSetScale 
         Caption         =   "x &8"
         Index           =   3
      End
      Begin VB.Menu mnuScaleFull 
         Caption         =   "&Full"
      End
   End
   Begin VB.Menu mnuIter 
      Caption         =   "&Iterations"
      Begin VB.Menu mnuSetIter 
         Caption         =   "&64"
         Index           =   1
      End
      Begin VB.Menu mnuSetIter 
         Caption         =   "&32"
         Index           =   2
      End
      Begin VB.Menu mnuSetIter 
         Caption         =   "&16"
         Checked         =   -1  'True
         Index           =   3
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim MaxIterations As Integer
Dim VisibleXmin As Single
Dim VisibleXmax As Single
Dim VisibleYmin As Single
Dim VisibleYmax As Single
Dim Xmin As Single
Dim Xmax As Single
Dim Ymin As Single
Dim Ymax As Single

' Used for zooming.
Dim DrawingBox As Boolean
Dim StartX As Single
Dim StartY As Single
Dim CurX As Single
Dim CurY As Single
' *********************************************
' Increase the area shown by a factor of fact.
' *********************************************
Private Sub ScaleFactor(fact As Integer)
Dim size As Single
Dim mid As Single

    size = fact * (Xmax - Xmin)
    If size > 3.2 Then
        ScaleFull
        Exit Sub
    End If
    mid = (Xmin + Xmax) / 2
    Xmin = mid - size / 2
    Xmax = mid + size / 2
    
    size = fact * (Ymax - Ymin)
    If size > 2.4 Then
        ScaleFull
        Exit Sub
    End If
    mid = (Ymin + Ymax) / 2
    Ymin = mid - size / 2
    Ymax = mid + size / 2
    
    DrawMandelbrot
End Sub

Private Sub Form_Load()
    Show
    MaxIterations = 16
    ScaleFull
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub


Private Sub mnuFileExit_Click()
    Unload Me
End Sub


Private Sub mnuScaleFull_Click()
    ScaleFull
End Sub

' ************************************************
' Start a rubberband box to select a zoom area.
' ************************************************
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' See if it's the right button.
    If Button And vbRightButton Then
        ' If we are in the middle of a zoom,
        ' cancel the zoom.
        If DrawingBox Then
            ' Erase the old box.
            Line (StartX, StartY)-(CurX, CurY), , B
            DrawingBox = False
        End If
        Exit Sub
    End If
    
    ' Otherwise start a zoom.
    DrawingBox = True
    StartX = X
    StartY = Y
    CurX = X
    CurY = Y
    Line (StartX, StartY)-(CurX, CurY), , B
End Sub
' ************************************************
' Continue the zoom area rubberband box.
' ************************************************
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not DrawingBox Then Exit Sub

    Line (StartX, StartY)-(CurX, CurY), , B
    CurX = X
    CurY = Y
    Line (StartX, StartY)-(CurX, CurY), , B
End Sub


' ************************************************
' Zoom in on the selected area.
' ************************************************
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim x1 As Single
Dim x2 As Single
Dim y1 As Single
Dim y2 As Single
Dim factor As Single

    If Not DrawingBox Then Exit Sub
    DrawingBox = False
    
    Line (StartX, StartY)-(CurX, CurY), , B
    CurX = X
    CurY = Y
    
    ' Put the coordinates in proper order.
    If CurX < StartX Then
        x1 = CurX
        x2 = StartX
    Else
        x1 = StartX
        x2 = CurX
    End If
    If x1 = x2 Then x2 = x1 + 1
    If CurY < StartY Then
        y1 = CurY
        y2 = StartY
    Else
        y1 = StartY
        y2 = CurY
    End If
    If y1 = y2 Then y2 = y1 + 1

    ' Convert screen coords into drawing coords.
    factor = (Xmax - Xmin) / ScaleWidth
    Xmax = Xmin + x2 * factor
    Xmin = Xmin + x1 * factor

    factor = (Ymax - Ymin) / ScaleHeight
    Ymax = Ymin + y2 * factor
    Ymin = Ymin + y1 * factor

    DrawMandelbrot
End Sub

Private Sub mnuSetIter_Click(Index As Integer)
Dim i As Integer

    Select Case Index
        Case 1
            MaxIterations = 64
        Case 2
            MaxIterations = 32
        Case 3
            MaxIterations = 16
    End Select
    
    For i = 1 To 3
        mnuSetIter(i).Checked = False
    Next i
    mnuSetIter(Index).Checked = True
    DrawMandelbrot
End Sub

Private Sub mnuSetScale_Click(Index As Integer)
    Select Case Index
        Case 1
            ScaleFactor 2
        Case 2
            ScaleFactor 4
        Case 3
            ScaleFactor 8
    End Select
End Sub
' ************************************************
' Zoom out to full scale.
' ************************************************
Public Sub ScaleFull()
    Xmin = -2
    Xmax = 1.2
    Ymin = -1.2
    Ymax = 1.2
    
    DrawMandelbrot
End Sub

' ************************************************
' Adjust the aspect ratio of the selected
' coordinates so they fit the window properly.
' ************************************************
Private Sub AdjustAspect()
Dim want_aspect As Single
Dim canvas_aspect As Single
Dim hgt As Single
Dim wid As Single
Dim mid As Single

    want_aspect = (Ymax - Ymin) / (Xmax - Xmin)
    canvas_aspect = ScaleHeight / ScaleWidth
    If want_aspect > canvas_aspect Then
        ' The selected area is too tall and thin.
        ' Make it wider.
        wid = (Ymax - Ymin) / canvas_aspect
        mid = (Xmin + Xmax) / 2
        VisibleXmin = mid - wid / 2
        VisibleXmax = mid + wid / 2
        VisibleYmin = Ymin
        VisibleYmax = Ymax
    Else
        ' The selected area is too short and wide.
        ' Make it taller.
        hgt = (Xmax - Xmin) * canvas_aspect
        mid = (Ymin + Ymax) / 2
        VisibleYmin = mid - hgt / 2
        VisibleYmax = mid + hgt / 2
        VisibleXmin = Xmin
        VisibleXmax = Xmax
    End If
End Sub
' ************************************************
' Draw the Mandelbrot set.
' ************************************************
Private Sub DrawMandelbrot()
Const MAX_MAG_SQUARED = 4  ' Work until the magnitude squared > 4.

Dim clr As Long
Dim i As Integer
Dim j As Integer
Dim ReaC As Double
Dim ImaC As Double
Dim dReaC As Double
Dim dImaC As Double
Dim ReaZ As Double
Dim ImaZ As Double
Dim ReaZ2 As Double
Dim ImaZ2 As Double
Dim wid As Integer
Dim hgt As Integer

    DrawMode = vbCopyPen
    Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
    MousePointer = vbHourglass
    DoEvents
    
    ' Adjust the aspect ratio.
    AdjustAspect
    
    ' dReaC is the change in the real part
    ' (X value) for C. dImaC is the change in the
    ' imaginary part (Y value).
    wid = ScaleWidth
    hgt = ScaleHeight
    dReaC = (VisibleXmax - VisibleXmin) / (wid - 1)
    dImaC = (VisibleYmax - VisibleYmin) / (hgt - 1)
    
    ' Calculate the values.
    ReaC = VisibleXmin
    For i = 1 To wid
        ImaC = VisibleYmin
        For j = 1 To hgt
            ReaZ = 0
            ImaZ = 0
            ReaZ2 = 0
            ImaZ2 = 0
            clr = 1
            Do While clr < MaxIterations And _
                    ReaZ2 + ImaZ2 < MAX_MAG_SQUARED
                ' Calculate Z(clr).
                ReaZ2 = ReaZ * ReaZ
                ImaZ2 = ImaZ * ImaZ
                ImaZ = 2 * ImaZ * ReaZ + ImaC
                ReaZ = ReaZ2 - ImaZ2 + ReaC
                clr = clr + 1
            Loop
            PSet (i, j), QBColor(clr Mod 16)
            ImaC = ImaC + dImaC
        Next j
        DoEvents
        ReaC = ReaC + dReaC
    Next i
    
    Refresh
    Picture = Image

    MousePointer = vbCrosshair
    DrawMode = vbInvert
End Sub