form1.frm

放大一百万亿倍的mandelbrot set。z初始值可修改。

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Mandelbrot"
   ClientHeight    =   2970
   ClientLeft      =   1020
   ClientTop       =   1695
   ClientWidth     =   3075
   DrawMode        =   6  'Mask Pen Not
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MousePointer    =   2  'Cross
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   198
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   205
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Visible         =   0   'False
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuScale 
      Caption         =   "&Scale"
      Visible         =   0   'False
      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"
      Visible         =   0   'False
      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_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'2007-7-27, 根据www.vb-helper.com源码改编。
'可放大一百万亿倍
'z=z^2+c

Option Explicit

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

' Used for zooming.
Dim DrawingBox As Boolean
Dim StartX As Double
Dim StartY As Double
Dim CurX As Double
Dim CurY As Double

Dim mrate As Double
Dim zoomr As Double

Private Sub Form_Load()
    Show
    MaxIterations = 200
    ScaleFull
    mrate = 0.25
    zoomr = 1
    
    Form_add.Left = Form1.Left
    Form_add.Top = Form1.Top + Form1.Height
    Form_add.Show
End Sub

Private Sub movem(d As Integer)
Dim tx As Double
Dim ty As Double
tx = (Xmax - Xmin) * mrate
ty = (Ymax - Ymin) * mrate

Select Case d
    Case 1 'up
        Ymin = Ymin - ty
        Ymax = Ymax - ty
    Case 2 'down
        Ymin = Ymin + ty
        Ymax = Ymax + ty
    Case 3 'left
        Xmin = Xmin - tx
        Xmax = Xmax - tx
    Case 4 'right
        Xmin = Xmin + tx
        Xmax = Xmax + tx
    Case 5 'middle
        Xmin = Xmin + tx / mrate * 0.25
        Xmax = Xmax - tx / mrate * 0.25
        Ymin = Ymin + ty / mrate * 0.25
        Ymax = Ymax - ty / mrate * 0.25
End Select

DrawMandelbrot

End Sub

Private Sub ScaleFactor(fact As Integer)
Dim size As Double
Dim mid As Double

    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_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyUp Then
    KeyCode = 0
    Call movem(1)
End If
If KeyCode = vbKeyDown Then
    KeyCode = 0
    Call movem(2)
End If
If KeyCode = vbKeyLeft Then
    KeyCode = 0
    Call movem(3)
End If
If KeyCode = vbKeyRight Then
    KeyCode = 0
    Call movem(4)
End If

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
    KeyAscii = 0
    zoomr = zoomr * 0.5
    Call mnuSetScale_Click(1)
End If
If KeyAscii = vbKeySpace Then
    KeyAscii = 0
    'Call ScaleFull
    zoomr = zoomr * 2
    Call movem(5)
End If

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

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

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


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim factor As Double

    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

    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

Public Sub ScaleFull()
    Xmin = -2
    Xmax = 1.2
    Ymin = -1.2
    Ymax = 1.2
    
    DrawMandelbrot
End Sub


Private Sub AdjustAspect()
Dim want_aspect As Double
Dim canvas_aspect As Double
Dim hgt As Double
Dim wid As Double
Dim mid As Double

    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

Private Sub DrawMandelbrot()

Form_add.Label_f.Caption = "from " & Trim(Xmin) & ", " & Trim(Ymin)
Form_add.Label_t.Caption = "from " & Trim(Xmax) & ", " & Trim(Ymax)
Form_add.Label_r.Caption = "zoom rate: " & Trim(3.2 / (Xmax - Xmin))

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
        '首先初始化z
            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)
            'Dim tc As Integer
            'If clr = MaxIterations Then tc = 0 Else tc = 7
            'PSet (i, j), QBColor(tc)
            ImaC = ImaC + dImaC
        Next j
        DoEvents
        ReaC = ReaC + dReaC
    Next i
    
    Refresh
    Picture = Image

    MousePointer = vbCrosshair
    DrawMode = vbInvert
End Sub