HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Drawing Fractals with MS Excel VBA

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
fractalsexcelwithdrawingvba

Problem

I've made Excel VBA code that draws and fills a fractal pattern. I know there's a few more ways to optimize the code, just glad it works right now.

```
Dim lng As Integer 'length of drawn lines
Dim pi As Double 'pi
Dim qpi As Double 'quarter pi
Dim rnpt() As Double 'list of avaialble points to draw from
Dim cx As Integer 'center of drawing
Dim cy As Integer
Dim stpt() As Double 'placeholder for new endpoints drawn
Dim fspt() As Double 'temp endpoints
Dim cc As Integer 'counter

'draws a 2-d bidirectional dividing fractal given a set of coordinates created in pattern()
Sub draw()

For cnt = 1 To lng 'draws each set of lines

t = Timer 'timer loop to prevent system freezes and lets run in background
Do While Timer lim Or c3 > 80 Then 'end loop at drawing limit
Exit For
End If
Loop

rte = Math.Round(Sqr(x2 ^ 2 + y2 ^ 2), 0) 'set final distance

tim = Timer 'loop to prevent freezing and allow background processes
Do While Timer lim Then y3 = lim 'check for drawing limits
If x3 > lim Then x3 = lim
If y3 0 Or t3 = 1 Then 'check if none remain or only one direction
If t2 = 0 Then 'check for remaining directions
If Not cnt = 1 Then 'remove dead fill pixels

For del = UBound(box(), 2) - cnt To UBound(box(), 2) - 2

box(0, del) = box(0, del + 1)
box(1, del) = box(1, del + 1)

Next del

ReDim Preserve box(2, UBound(box(), 2) - 1)

Else:
ReDim Preserve box(2, UBound(box(), 2) - 1)
End If

Exit For 'check next pixel
Else:
ReDim Preserve box(

Solution

Public

Why are all of these variables declared Public?

Dim lng As Integer 'length of drawn lines
Dim pi As Double 'pi
Dim qpi As Double 'quarter pi
Dim rnpt() As Double 'list of avaialble points to draw from
Dim cx As Integer 'center of drawing
Dim cy As Integer
Dim stpt() As Double 'placeholder for new endpoints drawn
Dim fspt() As Double 'temp endpoints
Dim cc As Integer 'counter


It seems unnecessary; if need be, pass values between subs. Public declarations should be Const in general.

Integers

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

Variable Names

Your variable names aren't telling me very much about them. I see there's a bunch of comments explaining them - it's much easier to name them descriptively and completely avoid comments.

lng → lineLength
Const pi as Double = 3.14159
Const quarterPi as Double = ..
cx → centerHorizontal
cy → centerVertical
cc → index


So now when I see For cnt = 1 to lineLength I know we're drawing lines.

Option Explicit

You have several variables undeclared - cnt and t for instance. It's best practice to always declare your variables and give them a type. You can have Option Explicit on automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Comments

As I said, Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

Repeating Code

I see you're getting ypt, ypt2 ... ypt10. If you don't want to make a Class for these, at least put them in an array for easier access -

Dim yPoints As Variant
        ReDim yPoints(1 To 10)
        For Index = 1 To 10
            If i Mod 2 = 0 Then
                yPoints(Index) = Round(Cos(Z + qpi), 0) * counter
            Else
                yPoints(Index) = Round(Sin(Z + qpi), 0) * counter
            End If
        Next


Or something similar. It looks like you can definitely shorten the code to an if loop or even a select case in this scenario. Or better yet, make a Function that does the calculation and use it to assign values.

Shader2

In Sub Shader2() I see you calling on c2 but I don't see c2 defined anywhere. Option Explicit would catch this, but instead you might want to use arguments in your sub

Private Sub Shader(ByVal firstPoint as Double, ByVal secondPoint as Double, etc)


For your color:

Dim r As Integer 'color variables
Dim g As Integer
Dim b As Integer
r = 255
g = 0
b = 0


Good idea using RGB instead of Color or ColorIndex. But, since color is stored as an integer, you can use it as a function instead

Dim myColor As Long
myColor = GetColor(r, g, b)
...
.Cells(x,y).Color = myColor


It looks a lot cleaner separated like that.

Spacing

Maybe it's from copy/paste, but you aren't indenting all of your code.It's good practice to indent all of your code that way Labels will stick out as obvious. Even the variable declarations.

Calling

Call draw 'draws next set
Next c1
Call Shader2


You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument or in your case, just Shader2.

Pattern

I saw this piece of code

rnpt(2, 0) = pi / 4


And I thought, wait isn't there a quarterPi variable? Yes, there is. It's a constant. Perfect!

Sheets

Worksheets("sheet1").Rows.RowHeight = 8


Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

Arrow code

I think I see a pretty big "arrow" in Shader2. You might want to try to flatten that.

Refactoring

On this If code

If rte < cx / 6 Then 'set color based on distance from center
            g = var * rte
        ElseIf rte < 2 * cx / 6 Then
            r = 255 - var * (rte - cx / 6)
        ElseIf rte < 3 * cx / 6 Then
            b = var * (rte - 2 * cx / 6)
        ElseIf rte < 4 * cx / 6 Then
            g = 255 - var * (rte - 3 * cx / 6)
        ElseIf rte < 5 * cx / 6 Then
            r = var * (rte - 4 * cx / 6)
        ElseIf rte < cx Then
            b = 255 - var * (rte - 5 * cx / 6)
        End If


It's the perfect opportunity to use a Select Case. Or, call a function -

```
g = ColorBasedOnDistance(radius, horizontalCenter)

Private Function ColorBasedOnDistance(ByVal radius As Long, ByVal horizontalCenter As Long) As Double
Select Case radius
Case radius < (horizontalCenter / 6)
Case radius < (horizontalCenter * 2)
Case radius < (horizontalCenter * 3) / 6
Case radius < (horizontalCenter * 4) /

Code Snippets

Dim lng As Integer 'length of drawn lines
Dim pi As Double 'pi
Dim qpi As Double 'quarter pi
Dim rnpt() As Double 'list of avaialble points to draw from
Dim cx As Integer 'center of drawing
Dim cy As Integer
Dim stpt() As Double 'placeholder for new endpoints drawn
Dim fspt() As Double 'temp endpoints
Dim cc As Integer 'counter
lng → lineLength
Const pi as Double = 3.14159
Const quarterPi as Double = ..
cx → centerHorizontal
cy → centerVertical
cc → index
Dim yPoints As Variant
        ReDim yPoints(1 To 10)
        For Index = 1 To 10
            If i Mod 2 = 0 Then
                yPoints(Index) = Round(Cos(Z + qpi), 0) * counter
            Else
                yPoints(Index) = Round(Sin(Z + qpi), 0) * counter
            End If
        Next
Private Sub Shader(ByVal firstPoint as Double, ByVal secondPoint as Double, etc)
Dim r As Integer 'color variables
Dim g As Integer
Dim b As Integer
r = 255
g = 0
b = 0

Context

StackExchange Code Review Q#161471, answer score: 3

Revisions (0)

No revisions yet.