contrib - maht - mandlebrot.vb

VERSION 5.00
Begin VB.Form Form1
   AutoRedraw = -1 'True
   Caption = "No Frills Fractals"
   ClientHeight = 6105
   ClientLeft = 60
   ClientTop = 345
   ClientWidth = 5250
   LinkTopic = "Form1"
   ScaleHeight = 6105
   ScaleWidth = 5250
   StartUpPosition = 3 'Windows Default
   Begin VB.Frame Frame1
      Caption = "Julia Parameters"
      Height = 1215
      Left = 2280
      TabIndex = 14
      Top = 3360
      Width = 2175
      Begin VB.TextBox Text7
	 Height = 285
	 Left = 960
	 TabIndex = 18
	 Text = "0.6"
	 Top = 720
	 Width = 855
      End
      Begin VB.TextBox Text6
	 Height = 285
	 Left = 960
	 TabIndex = 16
	 Text = "0.3"
	 Top = 360
	 Width = 855
      End
      Begin VB.Label Label7
	 Caption = "Imaginary"
	 Height = 255
	 Left = 120
	 TabIndex = 17
	 Top = 720
	 Width = 735
      End
      Begin VB.Label Label6
	 Caption = "Real"
	 Height = 255
	 Left = 120
	 TabIndex = 15
	 Top = 360
	 Width = 615
      End
   End
   Begin VB.OptionButton Option2
      Caption = "Julia"
      Height = 255
      Left = 2280
      TabIndex = 13
      Top = 5040
      Width = 855
   End
   Begin VB.OptionButton Option1
      Caption = "Mandelbrot"
      Height = 255
      Left = 2280
      TabIndex = 12
      Top = 4680
      Value = -1 'True
      Width = 1215
   End
   Begin VB.TextBox Text5
      Height = 285
      Left = 1200
      TabIndex = 11
      Text = "100"
      Top = 4920
      Width = 735
   End
   Begin VB.TextBox Text4
      Height = 285
      Left = 1200
      TabIndex = 9
      Text = "1.5"
      Top = 4560
      Width = 735
   End
   Begin VB.TextBox Text3
      Height = 285
      Left = 1200
      TabIndex = 8
      Text = "-1.5"
      Top = 4200
      Width = 735
   End
   Begin VB.TextBox Text2
      Height = 285
      Left = 1200
      TabIndex = 7
      Text = "1.5"
      Top = 3840
      Width = 735
   End
   Begin VB.TextBox Text1
      Height = 285
      Left = 1200
      TabIndex = 6
      Text = "-2.5"
      Top = 3480
      Width = 735
   End
   Begin VB.CommandButton Command1
      Caption = "Draw"
      Height = 495
      Left = 1560
      TabIndex = 1
      Top = 5400
      Width = 1575
   End
   Begin VB.PictureBox Picture1
      Height = 3060
      Left = 120
      ScaleHeight = 200
      ScaleMode = 3 'Pixel
      ScaleWidth = 320
      TabIndex = 0
      Top = 120
      Width = 4860
   End
   Begin VB.Label Label5
      Caption = "Iterations"
      Height = 255
      Left = 120
      TabIndex = 10
      Top = 4920
      Width = 735
   End
   Begin VB.Label Label4
      Caption = "Y Max"
      Height = 255
      Left = 120
      TabIndex = 5
      Top = 4560
      Width = 855
   End
   Begin VB.Label Label3
      Caption = "Y Min"
      Height = 255
      Left = 120
      TabIndex = 4
      Top = 4200
      Width = 855
   End
   Begin VB.Label Label2
      Caption = "X Max"
      Height = 255
      Left = 120
      TabIndex = 3
      Top = 3840
      Width = 855
   End
   Begin VB.Label Label1
      Caption = "X Min"
      Height = 255
      Left = 120
      TabIndex = 2
      Top = 3480
      Width = 855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' This program draws no frills fractals
' It's designed to show how to draw fractals rather than to be a fast
' or useful program

Option Explicit

Private Sub Command1_Click()
Dim Xmin As Single
Dim Xmax As Single
Dim Ymin As Single
Dim Ymax As Single
Dim MaxIter As Integer
Dim P As Single
Dim Q As Single
Dim initx As Single
Dim inity As Single
Dim xs As Single
Dim ys As Single
Dim x As Integer
Dim y As Integer
Dim i As Integer

' Read the paramters fro m the text boxes
Xmin = Val(Text1.Text)
Xmax = Val(Text2.Text)
Ymin = Val(Text3.Text)
Ymax = Val(Text4.Text)
MaxIter = Val(Text5.Text)
P = Val(Text6.Text)
Q = Val(Text7.Text)

' This works out the scaling factor for each pixel
xs = (Xmax - Xmin) / Picture1.ScaleWidth
ys = (Ymax - Ymin) / Picture1.ScaleHeight

' now draw the fractal

If Option1.Value = True Then
    ' Mandelbrot set
    For y = 0 To Picture1.ScaleHeight - 1
	For x = 0 To Picture1.ScaleWidth - 1
	    ' work out the coordinate of the pixel
	    initx = Xmin + xs * x
	    inity = Ymin + ys * y
	    ' iterate with these parameters
	    i = IterateM(initx, inity, MaxIter)
	    ' plot the pixel
	    Picture1.PSet (x, y), QBColor((i Mod 15) + 1)
	Next
    Next

    Else

    ' Julia set
    For y = 0 To Picture1.ScaleHeight - 1
	For x = 0 To Picture1.ScaleWidth - 1
	    ' work out the coordinate of the pixel
	    initx = Xmin + xs * x
	    inity = Ymin + ys * y
	    ' iterate with these parameters
	    i = IterateJ(initx, inity, MaxIter, P, Q)
	    ' plot the pixel
	    Picture1.PSet (x, y), QBColor((i Mod 15) + 1)
	Next
    Next
End If
End Sub


Public Function IterateM(initx As Single, inity As Single, MaxIter As Integer) As
Integer
' this function works out how many iterations are needed for a given point on the
' mandelbrot set

' x->x*x-y*y+x0
' y->2*x*y+y0


Dim x As Single
Dim y As Single
Dim xsq As Single
Dim ysq As Single
Dim i As Integer

' precalculate the first iteration
x = initx + initx * initx - inity * inity
y = inity + initx * inity + initx * inity
ysq = y * y
xsq = x * x

For i = 2 To MaxIter
    ' new imaginary value
    y = inity + x * y + x * y
    ' new real value
    x = initx - ysq + xsq
    ' work out the squared values
    ysq = y * y
    xsq = x * x
    ' check the bailout condition
    If (xsq + ysq) > 4 Then Exit For
Next i
IterateM = i
End Function

Public Function IterateJ(initx As Single, inity As Single, MaxIter As Integer, P
As Single, Q As Single) As Integer
' this function works out how many iterations are needed for a given point on the
' julia set

' x->x*x-y*y+P
' y->2*x*y+Q

Dim x As Single
Dim y As Single
Dim xsq As Single
Dim ysq As Single
Dim i As Integer

' get the initial values of x and y ready
x = initx
y = inity
xsq = x * x
ysq = y * y

For i = 1 To MaxIter
    'new imaginary value
    y = Q + x * y + x * y
    ' new real value
    x = P - ysq + xsq
    ' work out the squared values
    ysq = y * y
    xsq = x * x
    ' check the bailout condition
    If (xsq + ysq) > 4 Then Exit For
Next i

IterateJ = i

End Function

Private Sub Option1_Click()
'if mandelbrot set is clicked, then put in some
' sensible starting coordinates
Text1.Text = -2.5
Text2.Text = 1.5
Text3.Text = -1.5
Text4.Text = 1.5

End Sub

Private Sub Option2_Click()
'if julia set is clicked, then put in some
' sensible starting coordinates

Text1.Text = -1.5
Text2.Text = 1.5
Text3.Text = -1.5
Text4.Text = 1.5

End Sub
sources.postnix Mirror of the Plan 9 sources taken 07/16/2017
