Fractale Mandelbrot Fractale programmieren mit Visual Basic mit SourceCode Author D. Selzer-McKenzie YoutubeVideo: https://youtu.be/ZvWxCkyDwD0 In diesem Video sehen Sie den kompletten SourceCode für eine Programmierung von Fractalen, die in allen Mustern, Farben und Grössen ausgestaltet sind. Den SourceCode habe ich zeilenweise und vergrössert abgefilmt, Sie müssten also das Video jeweils anhalten, um es im Original abschreiben zu können. Den SourceCode habe auch im Forum http://Outbackbrumby.Blogspot.com veröffentlicht, dort könnten Sie ihn abschreiben bzw. abkopieren. Natürlich kann es sein, dass einige Steuerzeichen sich dort nicht einschrieben liessen, aber das können Sie leicht korrigieren. Im Film sehen Sie aber das Original zeilenweise, geschrieben mit VidualBasic 2013-2017, aber jede andere Version z.B. 2008, 2010,2012 usw. funktionieren genauso. Hier nun der SourceCode, komplett 'mit VisualBasic 2013-2017 Mandelbrot-Fractale erstellen 'Author Dr. D. Selzer-McKenzie Imports System.Math Public Class Form1 Inherits System.Windows.Forms.Form #Region " Windows Form Designer generated code " Public Sub New() MyBase.New() 'This call is required by the Windows Form Designer. InitializeComponent() 'Add any initialization after the InitializeComponent() call End Sub 'Form overrides dispose to clean up the component list. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub 'Required by the Windows Form Designer Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Public WithEvents MainMenu1 As System.Windows.Forms.MainMenu Public WithEvents mnuFile As System.Windows.Forms.MenuItem Public WithEvents mnuFileSaveAs As System.Windows.Forms.MenuItem Public WithEvents mnuScaleMnu As System.Windows.Forms.MenuItem Public WithEvents mnuScale_2 As System.Windows.Forms.MenuItem Public WithEvents mnuScale_4 As System.Windows.Forms.MenuItem Public WithEvents mnuScale_8 As System.Windows.Forms.MenuItem Public WithEvents mnuScaleFull As System.Windows.Forms.MenuItem Public WithEvents mnuScaleRefreshSep As System.Windows.Forms.MenuItem Public WithEvents mnuScaleRefresh As System.Windows.Forms.MenuItem Public WithEvents mnuOpt As System.Windows.Forms.MenuItem Public WithEvents mnuOptOptions As System.Windows.Forms.MenuItem Friend WithEvents dlgSaveFile As System.Windows.Forms.SaveFileDialog Friend WithEvents BildflaecheFractal As System.Windows.Forms.PictureBox Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Me.MainMenu1 = New System.Windows.Forms.MainMenu(Me.components) Me.mnuFile = New System.Windows.Forms.MenuItem() Me.mnuFileSaveAs = New System.Windows.Forms.MenuItem() Me.mnuScaleMnu = New System.Windows.Forms.MenuItem() Me.mnuScale_2 = New System.Windows.Forms.MenuItem() Me.mnuScale_4 = New System.Windows.Forms.MenuItem() Me.mnuScale_8 = New System.Windows.Forms.MenuItem() Me.mnuScaleFull = New System.Windows.Forms.MenuItem() Me.mnuScaleRefreshSep = New System.Windows.Forms.MenuItem() Me.mnuScaleRefresh = New System.Windows.Forms.MenuItem() Me.mnuOpt = New System.Windows.Forms.MenuItem() Me.mnuOptOptions = New System.Windows.Forms.MenuItem() Me.dlgSaveFile = New System.Windows.Forms.SaveFileDialog() Me.BildflaecheFractal = New System.Windows.Forms.PictureBox() CType(Me.BildflaecheFractal, System.ComponentModel.ISupportInitialize).BeginInit() Me.SuspendLayout() ' 'MainMenu1 ' Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuFile, Me.mnuScaleMnu, Me.mnuOpt}) ' 'mnuFile ' Me.mnuFile.Index = 0 Me.mnuFile.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuFileSaveAs}) Me.mnuFile.Text = "&File" ' 'mnuFileSaveAs ' Me.mnuFileSaveAs.Index = 0 Me.mnuFileSaveAs.Shortcut = System.Windows.Forms.Shortcut.CtrlA Me.mnuFileSaveAs.Text = "&Save As..." ' 'mnuScaleMnu ' Me.mnuScaleMnu.Index = 1 Me.mnuScaleMnu.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuScale_2, Me.mnuScale_4, Me.mnuScale_8, Me.mnuScaleFull, Me.mnuScaleRefreshSep, Me.mnuScaleRefresh}) Me.mnuScaleMnu.Text = "&Scale" ' 'mnuScale_2 ' Me.mnuScale_2.Index = 0 Me.mnuScale_2.Text = "x&2" ' 'mnuScale_4 ' Me.mnuScale_4.Index = 1 Me.mnuScale_4.Text = "x&4" ' 'mnuScale_8 ' Me.mnuScale_8.Index = 2 Me.mnuScale_8.Text = "x&8" ' 'mnuScaleFull ' Me.mnuScaleFull.Index = 3 Me.mnuScaleFull.Text = "&Full Scale" ' 'mnuScaleRefreshSep ' Me.mnuScaleRefreshSep.Index = 4 Me.mnuScaleRefreshSep.Text = "-" ' 'mnuScaleRefresh ' Me.mnuScaleRefresh.Index = 5 Me.mnuScaleRefresh.Shortcut = System.Windows.Forms.Shortcut.F5 Me.mnuScaleRefresh.Text = "&Refresh" ' 'mnuOpt ' Me.mnuOpt.Index = 2 Me.mnuOpt.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuOptOptions}) Me.mnuOpt.Text = "&Options" ' 'mnuOptOptions ' Me.mnuOptOptions.Index = 0 Me.mnuOptOptions.Text = "&Set Options" ' 'dlgSaveFile ' Me.dlgSaveFile.DefaultExt = "bmp" Me.dlgSaveFile.Filter = "Image Files|*.bmp;*.jpg;*.jpeg;*.gif;*.png;*.tif;*.tiff|BMP|*.bmp|JPEG|*.jpg;*.jp" & _ "eg|GIF|*.gif|PNG|*.png|TIFF|*.tif;*.tiff|All Files|*.*" ' 'BildflaecheFractal ' Me.BildflaecheFractal.BackColor = System.Drawing.Color.Black Me.BildflaecheFractal.Dock = System.Windows.Forms.DockStyle.Fill Me.BildflaecheFractal.Location = New System.Drawing.Point(0, 0) Me.BildflaecheFractal.Name = "BildflaecheFractal" Me.BildflaecheFractal.Size = New System.Drawing.Size(1012, 368) Me.BildflaecheFractal.TabIndex = 0 Me.BildflaecheFractal.TabStop = False ' 'Form1 ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(1012, 368) Me.Controls.Add(Me.BildflaecheFractal) Me.Cursor = System.Windows.Forms.Cursors.Cross Me.Menu = Me.MainMenu1 Me.Name = "Form1" Me.Text = "Mandelbrot" CType(Me.BildflaecheFractal, System.ComponentModel.ISupportInitialize).EndInit() Me.ResumeLayout(False) End Sub #End Region Private m_DrawingBox As Boolean Private m_StartX As Double Private m_StartY As Double Private m_CurX As Double Private m_CurY As Double Private m_Xmin As Double Private m_Xmax As Double Private m_Ymin As Double Private m_Ymax As Double Public MaxIterations As Integer Public Zr As Double Public Zim As Double Public Z2r As Double Public Z2im As Double Public NumColors As Integer Private m_Colors() As Color Private m_Bm As Bitmap Private Const MIN_X As Double = -2.2 Private Const MAX_X As Double = 1 Private Const MIN_Y As Double = -1.2 Private Const MAX_Y As Double = 1.2 ' Rücksetzung der Farbwerte ReadOnly Property Color(ByVal Index As Integer) As Color Get Color = m_Colors(Index) End Get End Property ' Erstellen der Farbwerte Public Sub ResetColors() NumColors = 0 Erase m_Colors End Sub ' Eintragen der Farbwerte Public Sub AddColor(ByVal new_color As Color) NumColors += 1 ReDim Preserve m_Colors(NumColors - 1) m_Colors(NumColors - 1) = new_color End Sub Private Sub AdjustAspect() Dim want_aspect As Double Dim picCanvas_aspect As Double Dim hgt As Double Dim wid As Double Dim mid As Double want_aspect = (m_Ymax - m_Ymin) / (m_Xmax - m_Xmin) picCanvas_aspect = BildflaecheFractal.ClientSize.Height / BildflaecheFractal.ClientSize.Width If want_aspect > picCanvas_aspect Then wid = (m_Ymax - m_Ymin) / picCanvas_aspect mid = (m_Xmin + m_Xmax) / 2 m_Xmin = mid - wid / 2 m_Xmax = mid + wid / 2 Else hgt = (m_Xmax - m_Xmin) * picCanvas_aspect mid = (m_Ymin + m_Ymax) / 2 m_Ymin = mid - hgt / 2 m_Ymax = mid + hgt / 2 End If End Sub 'Zerichnen des Mandelbrot Fractals Private Sub DrawMandelbrot() Const MAX_MAG_SQUARED As Integer = 4 Dim wid As Integer Dim hgt As Integer Dim clr As Integer Dim X As Integer Dim Y 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 ' Draw-Bitmaps erstellen m_Bm = New Bitmap(BildflaecheFractal.ClientSize.Width, BildflaecheFractal.ClientSize.Height) Dim gr As Graphics = Graphics.FromImage(m_Bm) ' Löschen, also zurücksetzen gr.Clear(BildflaecheFractal.BackColor) BildflaecheFractal.Image = m_Bm Application.DoEvents() AdjustAspect() wid = BildflaecheFractal.ClientRectangle.Width hgt = BildflaecheFractal.ClientRectangle.Height dReaC = (m_Xmax - m_Xmin) / (wid - 1) dImaC = (m_Ymax - m_Ymin) / (hgt - 1) ' Kalkulation der Werte ReaC = m_Xmin For X = 0 To wid - 1 ImaC = m_Ymin For Y = 0 To hgt - 1 ReaZ = Zr ImaZ = Zim ReaZ2 = Z2r ImaZ2 = Z2im clr = 1 Do While clr < MaxIterations And ReaZ2 + ImaZ2 < MAX_MAG_SQUARED ' Kalkulation der "Z"s ReaZ2 = ReaZ * ReaZ ImaZ2 = ImaZ * ImaZ ImaZ = 2 * ImaZ * ReaZ + ImaC ReaZ = ReaZ2 - ImaZ2 + ReaC clr = clr + 1 Loop 'Setzen der Pixel-werte m_Bm.SetPixel(X, Y, m_Colors(clr Mod NumColors)) ImaC = ImaC + dImaC Next Y ReaC = ReaC + dReaC If X Mod 10 = 0 Then BildflaecheFractal.Refresh() End If Next X Text = "Mandelbrot (" & _ m_Xmin.ToString("0.000000") & ", " & _ m_Ymin.ToString("0.000000") & ")-(" & _ m_Xmax.ToString("0.000000") & ", " & _ m_Ymax.ToString("0.000000") & ")" End Sub Private Sub ScaleArea(ByVal scale_factor As Integer) Dim size As Double Dim mid As Double size = scale_factor * (m_Xmax - m_Xmin) If size > 3.2 Then mnuScaleFull_Click(Nothing, Nothing) Exit Sub End If mid = (m_Xmin + m_Xmax) / 2 m_Xmin = mid - size / 2 m_Xmax = mid + size / 2 size = scale_factor * (m_Ymax - m_Ymin) If size > 2.4 Then mnuScaleFull_Click(Nothing, Nothing) Exit Sub End If mid = (m_Ymin + m_Ymax) / 2 m_Ymin = mid - size / 2 m_Ymax = mid + size / 2 Me.Cursor = Cursors.WaitCursor Application.DoEvents() DrawMandelbrot() Me.Cursor = Cursors.Default BildflaecheFractal.Cursor = Cursors.Cross End Sub Private Sub mnuScale_2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_2.Click ScaleArea(2) End Sub Private Sub mnuScale_4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_4.Click ScaleArea(4) End Sub Private Sub mnuScale_8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_8.Click ScaleArea(8) End Sub ' Zoomen (also vergrössern) Private Sub mnuScaleFull_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScaleFull.Click m_Xmin = MIN_X m_Xmax = MAX_X m_Ymin = MIN_Y m_Ymax = MAX_Y Me.Cursor = Cursors.WaitCursor Application.DoEvents() DrawMandelbrot() Me.Cursor = Cursors.Default BildflaecheFractal.Cursor = Cursors.Cross End Sub Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Show() Application.DoEvents() MaxIterations = 64 ResetColors() Dim frm As New MandelbrotConfig AddColor(frm.picColor_40.BackColor) AddColor(frm.picColor_17.BackColor) AddColor(frm.picColor_18.BackColor) AddColor(frm.picColor_19.BackColor) AddColor(frm.picColor_20.BackColor) AddColor(frm.picColor_21.BackColor) AddColor(frm.picColor_22.BackColor) AddColor(frm.picColor_23.BackColor) frm.Close() ' auf Bildschirm Fractal setzen mnuScaleFull_Click(Nothing, Nothing) End Sub Private Sub mnuOptOptions_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOptOptions.Click Dim frm As New MandelbrotConfig frm.Initialize(Me) frm.ShowDialog() End Sub Private Sub mnuScaleRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScaleRefresh.Click ScaleArea(1) End Sub Private Sub picCanvas_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseDown m_DrawingBox = True m_StartX = e.X m_StartY = e.Y m_CurX = e.X m_CurY = e.Y End Sub Private Sub picCanvas_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseMove If Not m_DrawingBox Then Exit Sub m_CurX = e.X m_CurY = e.Y Dim bm As New Bitmap(m_Bm) Dim gr As Graphics = Graphics.FromImage(bm) gr.DrawRectangle(Pens.Yellow, _ CInt(Min(m_StartX, m_CurX)), CInt(Min(m_StartY, m_CurY)), _ CInt(Abs(m_StartX - m_CurX)), CInt(Abs(m_StartY - m_CurY))) BildflaecheFractal.Image = bm End Sub Private Sub picCanvas_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseUp If Not m_DrawingBox Then Exit Sub m_DrawingBox = False BildflaecheFractal.Image = m_Bm m_CurX = e.X m_CurY = e.Y Dim x1 As Double Dim x2 As Double Dim y1 As Double Dim y2 As Double Dim factor As Double x1 = Min(m_StartX, m_CurX) x2 = Max(m_StartX, m_CurX) If x1 = x2 Then x2 = x1 + 1 y1 = Min(m_StartY, m_CurY) y2 = Max(m_StartY, m_CurY) If y1 = y2 Then y2 = y1 + 1 factor = (m_Xmax - m_Xmin) / BildflaecheFractal.ClientSize.Width m_Xmax = m_Xmin + x2 * factor m_Xmin = m_Xmin + x1 * factor factor = (m_Ymax - m_Ymin) / BildflaecheFractal.ClientSize.Height m_Ymax = m_Ymin + y2 * factor m_Ymin = m_Ymin + y1 * factor Me.Cursor = Cursors.WaitCursor Application.DoEvents() DrawMandelbrot() Me.Cursor = Cursors.Default BildflaecheFractal.Cursor = Cursors.Cross End Sub End Class

Fractale Mandelbrot Fractale programmieren mit Visual Basic mit SourceCode

Author D. Selzer-McKenzie

YoutubeVideo: https://youtu.be/ZvWxCkyDwD0

In diesem Video sehen Sie den kompletten SourceCode für eine Programmierung von Fractalen, die in allen Mustern, Farben und Grössen ausgestaltet sind. Den SourceCode habe ich zeilenweise und vergrössert abgefilmt, Sie müssten also das Video jeweils anhalten, um es im Original abschreiben zu können.

Den SourceCode habe auch im Forum

http://Outbackbrumby.Blogspot.com

veröffentlicht, dort könnten Sie ihn abschreiben bzw. abkopieren. Natürlich kann es sein, dass einige Steuerzeichen sich dort nicht einschrieben liessen, aber das können Sie leicht korrigieren. Im Film sehen Sie aber das Original zeilenweise, geschrieben mit VidualBasic 2013-2017, aber jede andere Version z.B. 2008, 2010,2012 usw. funktionieren genauso.

Hier nun der SourceCode, komplett

'mit VisualBasic 2013-2017 Mandelbrot-Fractale erstellen

'Author Dr. D. Selzer-McKenzie

Imports System.Math

Public Class Form1

    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()

        MyBase.New()

        'This call is required by the Windows Form Designer.

        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

        If disposing Then

            If Not (components Is Nothing) Then

                components.Dispose()

            End If

        End If

        MyBase.Dispose(disposing)

    End Sub

    'Required by the Windows Form Designer

    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer

    'It can be modified using the Windows Form Designer. 

    'Do not modify it using the code editor.

    Public WithEvents MainMenu1 As System.Windows.Forms.MainMenu

    Public WithEvents mnuFile As System.Windows.Forms.MenuItem

    Public WithEvents mnuFileSaveAs As System.Windows.Forms.MenuItem

    Public WithEvents mnuScaleMnu As System.Windows.Forms.MenuItem

    Public WithEvents mnuScale_2 As System.Windows.Forms.MenuItem

    Public WithEvents mnuScale_4 As System.Windows.Forms.MenuItem

    Public WithEvents mnuScale_8 As System.Windows.Forms.MenuItem

    Public WithEvents mnuScaleFull As System.Windows.Forms.MenuItem

    Public WithEvents mnuScaleRefreshSep As System.Windows.Forms.MenuItem

    Public WithEvents mnuScaleRefresh As System.Windows.Forms.MenuItem

    Public WithEvents mnuOpt As System.Windows.Forms.MenuItem

    Public WithEvents mnuOptOptions As System.Windows.Forms.MenuItem

    Friend WithEvents dlgSaveFile As System.Windows.Forms.SaveFileDialog

    Friend WithEvents BildflaecheFractal As System.Windows.Forms.PictureBox

    Private Sub InitializeComponent()

        Me.components = New System.ComponentModel.Container()

        Me.MainMenu1 = New System.Windows.Forms.MainMenu(Me.components)

        Me.mnuFile = New System.Windows.Forms.MenuItem()

        Me.mnuFileSaveAs = New System.Windows.Forms.MenuItem()

        Me.mnuScaleMnu = New System.Windows.Forms.MenuItem()

        Me.mnuScale_2 = New System.Windows.Forms.MenuItem()

        Me.mnuScale_4 = New System.Windows.Forms.MenuItem()

        Me.mnuScale_8 = New System.Windows.Forms.MenuItem()

        Me.mnuScaleFull = New System.Windows.Forms.MenuItem()

        Me.mnuScaleRefreshSep = New System.Windows.Forms.MenuItem()

        Me.mnuScaleRefresh = New System.Windows.Forms.MenuItem()

        Me.mnuOpt = New System.Windows.Forms.MenuItem()

        Me.mnuOptOptions = New System.Windows.Forms.MenuItem()

        Me.dlgSaveFile = New System.Windows.Forms.SaveFileDialog()

        Me.BildflaecheFractal = New System.Windows.Forms.PictureBox()

        CType(Me.BildflaecheFractal, System.ComponentModel.ISupportInitialize).BeginInit()

        Me.SuspendLayout()

        '

        'MainMenu1

        '

        Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuFile, Me.mnuScaleMnu, Me.mnuOpt})

        '

        'mnuFile

        '

        Me.mnuFile.Index = 0

        Me.mnuFile.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuFileSaveAs})

        Me.mnuFile.Text = "&File"

        '

        'mnuFileSaveAs

        '

        Me.mnuFileSaveAs.Index = 0

        Me.mnuFileSaveAs.Shortcut = System.Windows.Forms.Shortcut.CtrlA

        Me.mnuFileSaveAs.Text = "&Save As..."

        '

        'mnuScaleMnu

        '

        Me.mnuScaleMnu.Index = 1

        Me.mnuScaleMnu.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuScale_2, Me.mnuScale_4, Me.mnuScale_8, Me.mnuScaleFull, Me.mnuScaleRefreshSep, Me.mnuScaleRefresh})

        Me.mnuScaleMnu.Text = "&Scale"

        '

        'mnuScale_2

        '

        Me.mnuScale_2.Index = 0

        Me.mnuScale_2.Text = "x&2"

        '

        'mnuScale_4

        '

        Me.mnuScale_4.Index = 1

        Me.mnuScale_4.Text = "x&4"

        '

        'mnuScale_8

        '

        Me.mnuScale_8.Index = 2

        Me.mnuScale_8.Text = "x&8"

        '

        'mnuScaleFull

        '

        Me.mnuScaleFull.Index = 3

        Me.mnuScaleFull.Text = "&Full Scale"

        '

        'mnuScaleRefreshSep

        '

        Me.mnuScaleRefreshSep.Index = 4

        Me.mnuScaleRefreshSep.Text = "-"

        '

        'mnuScaleRefresh

        '

        Me.mnuScaleRefresh.Index = 5

        Me.mnuScaleRefresh.Shortcut = System.Windows.Forms.Shortcut.F5

        Me.mnuScaleRefresh.Text = "&Refresh"

        '

        'mnuOpt

        '

        Me.mnuOpt.Index = 2

        Me.mnuOpt.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuOptOptions})

        Me.mnuOpt.Text = "&Options"

        '

        'mnuOptOptions

        '

        Me.mnuOptOptions.Index = 0

        Me.mnuOptOptions.Text = "&Set Options"

        '

        'dlgSaveFile

        '

        Me.dlgSaveFile.DefaultExt = "bmp"

        Me.dlgSaveFile.Filter = "Image Files|*.bmp;*.jpg;*.jpeg;*.gif;*.png;*.tif;*.tiff|BMP|*.bmp|JPEG|*.jpg;*.jp" & _

    "eg|GIF|*.gif|PNG|*.png|TIFF|*.tif;*.tiff|All Files|*.*"

        '

        'BildflaecheFractal

        '

        Me.BildflaecheFractal.BackColor = System.Drawing.Color.Black

        Me.BildflaecheFractal.Dock = System.Windows.Forms.DockStyle.Fill

        Me.BildflaecheFractal.Location = New System.Drawing.Point(0, 0)

        Me.BildflaecheFractal.Name = "BildflaecheFractal"

        Me.BildflaecheFractal.Size = New System.Drawing.Size(1012, 368)

        Me.BildflaecheFractal.TabIndex = 0

        Me.BildflaecheFractal.TabStop = False

        '

        'Form1

        '

        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)

        Me.ClientSize = New System.Drawing.Size(1012, 368)

        Me.Controls.Add(Me.BildflaecheFractal)

        Me.Cursor = System.Windows.Forms.Cursors.Cross

        Me.Menu = Me.MainMenu1

        Me.Name = "Form1"

        Me.Text = "Mandelbrot"

        CType(Me.BildflaecheFractal, System.ComponentModel.ISupportInitialize).EndInit()

        Me.ResumeLayout(False)

    End Sub

#End Region

    Private m_DrawingBox As Boolean

    Private m_StartX As Double

    Private m_StartY As Double

    Private m_CurX As Double

    Private m_CurY As Double

    Private m_Xmin As Double

    Private m_Xmax As Double

    Private m_Ymin As Double

    Private m_Ymax As Double

    Public MaxIterations As Integer

    Public Zr As Double

    Public Zim As Double

    Public Z2r As Double

    Public Z2im As Double

    Public NumColors As Integer

    Private m_Colors() As Color

    Private m_Bm As Bitmap

    Private Const MIN_X As Double = -2.2

    Private Const MAX_X As Double = 1

    Private Const MIN_Y As Double = -1.2

    Private Const MAX_Y As Double = 1.2

    ' Rücksetzung der Farbwerte

    ReadOnly Property Color(ByVal Index As Integer) As Color

        Get

            Color = m_Colors(Index)

        End Get

    End Property

    ' Erstellen der Farbwerte

    Public Sub ResetColors()

        NumColors = 0

        Erase m_Colors

    End Sub

    ' Eintragen der Farbwerte

    Public Sub AddColor(ByVal new_color As Color)

        NumColors += 1

        ReDim Preserve m_Colors(NumColors - 1)

        m_Colors(NumColors - 1) = new_color

    End Sub

    Private Sub AdjustAspect()

        Dim want_aspect As Double

        Dim picCanvas_aspect As Double

        Dim hgt As Double

        Dim wid As Double

        Dim mid As Double

        want_aspect = (m_Ymax - m_Ymin) / (m_Xmax - m_Xmin)

        picCanvas_aspect = BildflaecheFractal.ClientSize.Height / BildflaecheFractal.ClientSize.Width

        If want_aspect > picCanvas_aspect Then

            wid = (m_Ymax - m_Ymin) / picCanvas_aspect

            mid = (m_Xmin + m_Xmax) / 2

            m_Xmin = mid - wid / 2

            m_Xmax = mid + wid / 2

        Else

            hgt = (m_Xmax - m_Xmin) * picCanvas_aspect

            mid = (m_Ymin + m_Ymax) / 2

            m_Ymin = mid - hgt / 2

            m_Ymax = mid + hgt / 2

        End If

    End Sub

    'Zerichnen des Mandelbrot Fractals

    Private Sub DrawMandelbrot()

        Const MAX_MAG_SQUARED As Integer = 4

        Dim wid As Integer

        Dim hgt As Integer

        Dim clr As Integer

        Dim X As Integer

        Dim Y 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

        ' Draw-Bitmaps erstellen

        m_Bm = New Bitmap(BildflaecheFractal.ClientSize.Width, BildflaecheFractal.ClientSize.Height)

        Dim gr As Graphics = Graphics.FromImage(m_Bm)

        ' Löschen, also zurücksetzen

        gr.Clear(BildflaecheFractal.BackColor)

        BildflaecheFractal.Image = m_Bm

        Application.DoEvents()

        AdjustAspect()

        wid = BildflaecheFractal.ClientRectangle.Width

        hgt = BildflaecheFractal.ClientRectangle.Height

        dReaC = (m_Xmax - m_Xmin) / (wid - 1)

        dImaC = (m_Ymax - m_Ymin) / (hgt - 1)

        ' Kalkulation der Werte

        ReaC = m_Xmin

        For X = 0 To wid - 1

            ImaC = m_Ymin

            For Y = 0 To hgt - 1

                ReaZ = Zr

                ImaZ = Zim

                ReaZ2 = Z2r

                ImaZ2 = Z2im

                clr = 1

                Do While clr < MaxIterations And ReaZ2 + ImaZ2 < MAX_MAG_SQUARED

                    ' Kalkulation der "Z"s

                    ReaZ2 = ReaZ * ReaZ

                    ImaZ2 = ImaZ * ImaZ

                    ImaZ = 2 * ImaZ * ReaZ + ImaC

                    ReaZ = ReaZ2 - ImaZ2 + ReaC

                    clr = clr + 1

                Loop

                'Setzen der Pixel-werte

                m_Bm.SetPixel(X, Y, m_Colors(clr Mod NumColors))

                ImaC = ImaC + dImaC

            Next Y

            ReaC = ReaC + dReaC

            If X Mod 10 = 0 Then

                BildflaecheFractal.Refresh()

            End If

        Next X

        Text = "Mandelbrot (" & _

            m_Xmin.ToString("0.000000") & ", " & _

            m_Ymin.ToString("0.000000") & ")-(" & _

            m_Xmax.ToString("0.000000") & ", " & _

            m_Ymax.ToString("0.000000") & ")"

    End Sub

    Private Sub ScaleArea(ByVal scale_factor As Integer)

        Dim size As Double

        Dim mid As Double

        size = scale_factor * (m_Xmax - m_Xmin)

        If size > 3.2 Then

            mnuScaleFull_Click(Nothing, Nothing)

            Exit Sub

        End If

        mid = (m_Xmin + m_Xmax) / 2

        m_Xmin = mid - size / 2

        m_Xmax = mid + size / 2

        size = scale_factor * (m_Ymax - m_Ymin)

        If size > 2.4 Then

            mnuScaleFull_Click(Nothing, Nothing)

            Exit Sub

        End If

        mid = (m_Ymin + m_Ymax) / 2

        m_Ymin = mid - size / 2

        m_Ymax = mid + size / 2

        Me.Cursor = Cursors.WaitCursor

        Application.DoEvents()

        DrawMandelbrot()

        Me.Cursor = Cursors.Default

        BildflaecheFractal.Cursor = Cursors.Cross

    End Sub

    Private Sub mnuScale_2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_2.Click

        ScaleArea(2)

    End Sub

    Private Sub mnuScale_4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_4.Click

        ScaleArea(4)

    End Sub

    Private Sub mnuScale_8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScale_8.Click

        ScaleArea(8)

    End Sub

    ' Zoomen (also vergrössern)

    Private Sub mnuScaleFull_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScaleFull.Click

        m_Xmin = MIN_X

        m_Xmax = MAX_X

        m_Ymin = MIN_Y

        m_Ymax = MAX_Y

        Me.Cursor = Cursors.WaitCursor

        Application.DoEvents()

        DrawMandelbrot()

        Me.Cursor = Cursors.Default

        BildflaecheFractal.Cursor = Cursors.Cross

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Me.Show()

        Application.DoEvents()

        MaxIterations = 64

        ResetColors()

        Dim frm As New MandelbrotConfig

        AddColor(frm.picColor_40.BackColor)

        AddColor(frm.picColor_17.BackColor)

        AddColor(frm.picColor_18.BackColor)

        AddColor(frm.picColor_19.BackColor)

        AddColor(frm.picColor_20.BackColor)

        AddColor(frm.picColor_21.BackColor)

        AddColor(frm.picColor_22.BackColor)

        AddColor(frm.picColor_23.BackColor)

        frm.Close()

        ' auf Bildschirm Fractal setzen

        mnuScaleFull_Click(Nothing, Nothing)

    End Sub

    Private Sub mnuOptOptions_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOptOptions.Click

        Dim frm As New MandelbrotConfig

        frm.Initialize(Me)

        frm.ShowDialog()

    End Sub

    Private Sub mnuScaleRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuScaleRefresh.Click

        ScaleArea(1)

    End Sub

    Private Sub picCanvas_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseDown

        m_DrawingBox = True

        m_StartX = e.X

        m_StartY = e.Y

        m_CurX = e.X

        m_CurY = e.Y

    End Sub

    Private Sub picCanvas_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseMove

        If Not m_DrawingBox Then Exit Sub

        m_CurX = e.X

        m_CurY = e.Y

        Dim bm As New Bitmap(m_Bm)

        Dim gr As Graphics = Graphics.FromImage(bm)

        gr.DrawRectangle(Pens.Yellow, _

            CInt(Min(m_StartX, m_CurX)), CInt(Min(m_StartY, m_CurY)), _

            CInt(Abs(m_StartX - m_CurX)), CInt(Abs(m_StartY - m_CurY)))

        BildflaecheFractal.Image = bm

    End Sub

    Private Sub picCanvas_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles BildflaecheFractal.MouseUp

        If Not m_DrawingBox Then Exit Sub

        m_DrawingBox = False

        BildflaecheFractal.Image = m_Bm

        m_CurX = e.X

        m_CurY = e.Y

        Dim x1 As Double

        Dim x2 As Double

        Dim y1 As Double

        Dim y2 As Double

        Dim factor As Double

        x1 = Min(m_StartX, m_CurX)

        x2 = Max(m_StartX, m_CurX)

        If x1 = x2 Then x2 = x1 + 1

        y1 = Min(m_StartY, m_CurY)

        y2 = Max(m_StartY, m_CurY)

        If y1 = y2 Then y2 = y1 + 1

        factor = (m_Xmax - m_Xmin) / BildflaecheFractal.ClientSize.Width

        m_Xmax = m_Xmin + x2 * factor

        m_Xmin = m_Xmin + x1 * factor

        factor = (m_Ymax - m_Ymin) / BildflaecheFractal.ClientSize.Height

        m_Ymax = m_Ymin + y2 * factor

        m_Ymin = m_Ymin + y1 * factor

        Me.Cursor = Cursors.WaitCursor

        Application.DoEvents()

        DrawMandelbrot()

        Me.Cursor = Cursors.Default

        BildflaecheFractal.Cursor = Cursors.Cross

    End Sub

End Class