Circle Gradient Pattern Generator v2.0 - Visual Basic Source Code

Back to: Main Programming Page

This is a program I wrote to play around with graphics. It uses the Brightness Demo ©2005 by Tanner "DemonSpectre" Helland as the method to display the graphics, while the actual creation of the pattern is my original code. Basically, it creates circular gradients about points, and overlays all these gradients to generate the patterns. There are two methods of gradients - a simple linear method, which generates fairly smooth gradients, and a power based method, which generates sharper gradients.

There is also a method for creating animations of these gradients. Currently, the animations are set up to make a looping video, but it would be easy to edit the code to make any type of animation.

To see some examples of the images made with this program, take a look at my artwork page.

 

Previous Versions:

 

Source Code:

FormMain:
FormMain Screenshot
Option Explicit
'Circular Gradient Patterns
'Written by Jeff Lewis, making heavy use of Brightness Demo ©2005 by Tanner "DemonSpectre" Helland
'I downloaded the sample code to display raster graphics from tannerhelland.com,
'as decribed in the writeup below.  I kept parts of that program, added my own relatively
'simple methods of generating gradients, and made some related changes to the form to
'make it work for this application.



'Brightness Demo ©2005 by Tanner "DemonSpectre" Helland

'Source code for "Graphics Programming in Visual Basic - Part 3: Advanced API Pixel Routines"

'This simple program demonstrates how to adjust an image's brightness using the API calls of
'GetDIBits and StretchDIBits (I've also included GetBitmapBits and SetBitmapBits
'for reference' sake).  This program demonstrates some pretty fast graphics
'routines, but they can be made even faster!  Read Tutorial 4 for more information
'about optimizing graphics functions.

'The CG graphic in the picture box is ©1998 by SquareSoft
'(it's from Final Fantasy VIII, if you care)

'For additional cool code, check out the students of game design website at
'http://www.studentsofgamedesign.com

'Listen to sweet original VG music at
'www.tannerhelland.com

'All of the DIB types
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbAlpha As Byte
End Type
 
Private Type BITMAPINFOHEADER
    bmSize As Long
    bmWidth As Long
    bmHeight As Long
    bmPlanes As Integer
    bmBitCount As Integer
    bmCompression As Long
    bmSizeImage As Long
    bmXPelsPerMeter As Long
    bmYPelsPerMeter As Long
    bmClrUsed As Long
    bmClrImportant As Long
End Type
 
Private Type BITMAPINFO
    bmHeader As BITMAPINFOHEADER
    bmColors(0 To 255) As RGBQUAD
End Type

'The GetObject API call gives us the bitmap variables we need for the other API calls
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long

'The GetBitmapBits and SetBitmapBits API calls (use ONLY in 24/32-bit color mode!!)
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long

'The magical API DIB function calls (they're long!)
Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dWidth As Long, ByVal dHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long, ByVal RasterOp As Long) As Long

'The array that will hold our pixel data
Dim ImageData() As Byte

'Temporary brightness variable
Dim tBrightness As Single

Private Sub ChkAutoRedraw_Click()
    'Change the AutoRedraw property of the picture box based on the check box's value
    If ChkAutoRedraw.Value = vbChecked Then Picture1.AutoRedraw = True Else Picture1.AutoRedraw = False
End Sub

Private Sub CmdBrightness_Click()
    'Get the text value, convert it to type 'Single,' and send it to the sub
    'tBrightness = CSng(Val(TxtBrightness)) / 100
    DrawDIBBrightness Picture1, Picture1, tBrightness
End Sub

Private Sub Command1_Click()
    DrawRandomCirclesLinearMethod Picture1, Picture1, tBrightness
End Sub

Private Sub Command2_Click()
    SetImageData Picture1, ImageData()
End Sub

Private Sub Command3_Click()
    DrawRandomCirclesPowerMethod Picture1, Picture1, tBrightness
End Sub

Private Sub Command4_Click()
    DrawThreeCirclesPowerMethod Picture1, Picture1, tBrightness
End Sub

Private Sub Command6_Click()
  Dim x As Single
  
  x = Cos(180)
  TextDisplay.Text = x
End Sub

Private Sub CommandDrawFromText_Click()
  DrawCirclesFromText Picture1, Picture1, tBrightness
End Sub

Private Sub CommandGenerateAnimation_Click()
  Call ModuleAnimation.GenerateAnimation
End Sub

Private Sub CommandSaveImage_Click()
  Dim ImageName As String
  ImageName = TextPath.Text & "\" & TextSeries.Text & TextFrame.Text & ".bmp"
  SavePicture Picture1.Image, ImageName
End Sub


'************************************************************************************************************
'************************************************************************************************************
'Power Method - Set of 3
'************************************************************************************************************
'************************************************************************************************************

'A simple subroutine that will change the brightness of a picturebox using DIB sections.
Public Sub DrawThreeCirclesPowerMethod(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
    'Coordinate variables
    Dim x As Long, y As Long
    Dim xTemp As Single
    Dim yTemp As Single
    Dim red As Integer
    Dim green As Integer
    Dim blue As Integer
    Dim RedTemp As Single
    Dim GreenTemp As Single
    Dim BlueTemp As Single
    Dim RedScalar As Single
    Dim RedMag As Single
    Dim RedX As Single
    Dim RedY As Single
    Dim GreenScalar As Single
    Dim GreenMag As Single
    Dim GreenX As Single
    Dim GreenY As Single
    Dim BlueScalar As Single
    Dim BlueMag As Single
    Dim BlueX As Single
    Dim BlueY As Single
    Dim Dist As Single
    Dim Power As Single
    
    Power = TextPowerIndPower.Text
    
    RedScalar = TextPowerIndRScalar.Text ^ Power
    RedMag = TextPowerIndRMag.Text
    RedX = TextPowerIndRX.Text
    RedY = TextPowerIndRY.Text
    GreenScalar = TextPowerIndGScalar.Text ^ Power
    GreenMag = TextPowerIndGMag.Text
    GreenX = TextPowerIndGX.Text
    GreenY = TextPowerIndGY.Text
    BlueScalar = TextPowerIndBScalar.Text ^ Power
    BlueMag = TextPowerIndBMag.Text
    BlueX = TextPowerIndBX.Text
    BlueY = TextPowerIndBY.Text
    
    'Get the pixel data into our ImageData array
    GetImageData SrcPicture, ImageData()
    'Temporary width and height variables are faster than accessing the Scale properties over and over again
    Dim TempWidth As Long, TempHeight As Long
    TempWidth = DstPicture.ScaleWidth - 1
    TempHeight = DstPicture.ScaleHeight - 1
    'run a loop through the picture to change every pixel
    For x = 0 To TempWidth
    For y = 0 To TempHeight

        xTemp = x
        yTemp = y

        'Red
        Dist = Sqr((xTemp - RedX) * (xTemp - RedX) + (yTemp - RedY) * (yTemp - RedY))
        If Dist > 0 Then
          RedTemp = RedMag * RedScalar / Dist ^ Power
        Else
          RedTemp = 255
        End If
        
        If RedTemp > 255 Then
          RedTemp = 255
        ElseIf RedTemp < 0 Then
          RedTemp = 0
        End If

        'Green
        Dist = Sqr((xTemp - GreenX) * (xTemp - GreenX) + (yTemp - GreenY) * (yTemp - GreenY))
        If Dist > 0 Then
          GreenTemp = GreenMag * GreenScalar / Dist ^ Power
        Else
          GreenTemp = 255
        End If

        If GreenTemp > 255 Then
          GreenTemp = 255
        ElseIf GreenTemp < 0 Then
          GreenTemp = 0
        End If
        
        'Blue
        Dist = Sqr((xTemp - BlueX) * (xTemp - BlueX) + (yTemp - BlueY) * (yTemp - BlueY))
        If Dist > 0 Then
          BlueTemp = BlueMag * BlueScalar / Dist ^ Power
        Else
          BlueTemp = 255
        End If
        
        If BlueTemp > 255 Then
          BlueTemp = 255
        ElseIf BlueTemp < 0 Then
          BlueTemp = 0
        End If
        
        red = Int(RedTemp)
        green = Int(GreenTemp)
        blue = Int(BlueTemp)
        
        'If x < 255 Then
        '  red = x
        'Else
        '  red = 255
        'End If
        
        'If y < 255 Then
        '  green = y
        'Else
        '  green = 255
        'End If

        'blue = 0
        
        ImageData(2, x, y) = red   'Change the red
        ImageData(1, x, y) = green   'Change the green
        ImageData(0, x, y) = blue   'Change the blue
    Next y
        'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
        If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
    Next x
    'final picture refresh
    SetImageData DstPicture, ImageData()
End Sub

'************************************************************************************************************
'************************************************************************************************************
'Linear Method - Set of 3
'************************************************************************************************************
'************************************************************************************************************

Public Sub DrawDIBBrightness(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
    'Coordinate variables
    Dim x As Long, y As Long
    Dim xTemp As Single
    Dim yTemp As Single
    Dim red As Integer
    Dim green As Integer
    Dim blue As Integer
    Dim RedTemp As Single
    Dim GreenTemp As Single
    Dim BlueTemp As Single
    Dim RedScalar As Single
    Dim RedMag As Single
    Dim RedX As Single
    Dim RedY As Single
    Dim GreenScalar As Single
    Dim GreenMag As Single
    Dim GreenX As Single
    Dim GreenY As Single
    Dim BlueScalar As Single
    Dim BlueMag As Single
    Dim BlueX As Single
    Dim BlueY As Single

    RedScalar = TextLinIndRScalar.Text
    RedMag = TextLinIndRMag.Text
    RedX = TextLinIndRX.Text
    RedY = TextLinIndRY.Text
    GreenScalar = TextLinIndGScalar.Text
    GreenMag = TextLinIndGMag.Text
    GreenX = TextLinIndGX.Text
    GreenY = TextLinIndGY.Text
    BlueScalar = TextLinIndBScalar.Text
    BlueMag = TextLinIndBMag.Text
    BlueX = TextLinIndBX.Text
    BlueY = TextLinIndBY.Text
    
    'Get the pixel data into our ImageData array
    GetImageData SrcPicture, ImageData()
    'Temporary width and height variables are faster than accessing the Scale properties over and over again
    Dim TempWidth As Long, TempHeight As Long
    TempWidth = DstPicture.ScaleWidth - 1
    TempHeight = DstPicture.ScaleHeight - 1
    'run a loop through the picture to change every pixel
    For x = 0 To TempWidth
    For y = 0 To TempHeight

        xTemp = x
        yTemp = y

        RedTemp = RedMag - RedScalar * ((xTemp - RedX) ^ 2 + (yTemp - RedY) ^ 2) ^ 0.5
        GreenTemp = GreenMag - GreenScalar * ((xTemp - GreenX) ^ 2 + (yTemp - GreenY) ^ 2) ^ 0.5
        BlueTemp = BlueMag - BlueScalar * ((xTemp - BlueX) ^ 2 + (yTemp - BlueY) ^ 2) ^ 0.5
        
        If RedTemp > 255 Then
          RedTemp = 255
        ElseIf RedTemp < 0 Then
          RedTemp = 0
        End If
        
        If GreenTemp > 255 Then
          GreenTemp = 255
        ElseIf GreenTemp < 0 Then
          GreenTemp = 0
        End If
        
        If BlueTemp > 255 Then
          BlueTemp = 255
        ElseIf BlueTemp < 0 Then
          BlueTemp = 0
        End If
        
        red = Int(RedTemp)
        green = Int(GreenTemp)
        blue = Int(BlueTemp)
        
        ImageData(2, x, y) = red   'Change the red
        ImageData(1, x, y) = green   'Change the green
        ImageData(0, x, y) = blue   'Change the blue
    Next y
        'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
        If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
    Next x
    'final picture refresh
    SetImageData DstPicture, ImageData()
End Sub

'************************************************************************************************************
'************************************************************************************************************
'Power Method - Generate List & Call Drawing Subroutine
'************************************************************************************************************
'************************************************************************************************************

Public Sub DrawRandomCirclesPowerMethod(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
    'Coordinate variables
    Dim Power As Single
    Dim NumberPoints As Long
    Dim MaxPoints As Long
    Dim MinPoints As Long
    Dim ctr As Long
    
    Dim TempVal As Single
    
    Dim MinXLimit As Single
    Dim MaxXLimit As Single
    Dim MinYLimit As Single
    Dim MaxYLimit As Single
    Dim MinScalarLimit As Single
    Dim MaxScalarLimit As Single
    Dim MinMagLimit As Single
    Dim MaxMagLimit As Single
    
    Randomize Timer
    
    MinXLimit = TextPowerMinX.Text
    MaxXLimit = TextPowerMaxX.Text
    MinYLimit = TextPowerMinY.Text
    MaxYLimit = TextPowerMaxY.Text
    
    Power = TextPowerPower.Text
    
    MinScalarLimit = TextPowerMinScalar.Text ^ Power
    MaxScalarLimit = TextPowerMaxScalar.Text ^ Power
    MinMagLimit = TextPowerMinMag.Text
    MaxMagLimit = TextPowerMaxMag.Text
    
    MaxPoints = TextPowerMaxPoints.Text
    NumberPoints = (TextPowerMaxPoints.Text - TextPowerMinPoints.Text) * Rnd + TextPowerMinPoints.Text
    
    TextDisplay.Text = "Number Points = " & Str(NumberPoints)
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Frame         = " & TextFrame.Text
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Series        = " & TextSeries.Text
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Path          = " & TextPath.Text
    
    For ctr = 1 To NumberPoints
      TextDisplay.Text = TextDisplay.Text & vbCrLf & vbCrLf & "Point " & Str(ctr)
      'Method Type
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Method       = Power"
      'X Coord
      TempVal = (MaxXLimit - MinXLimit) * Rnd + MinXLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "XCoord       = " & Str(TempVal)
      'Y Coord
      TempVal = (MaxYLimit - MinYLimit) * Rnd + MinYLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "YCoord       = " & Str(TempVal)
      'Red Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Mag      = " & Str(TempVal)
      'Green Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Mag    = " & Str(TempVal)
      'Blue Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Mag     = " & Str(TempVal)
      'Red Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Scalar   = " & Str(TempVal)
      'Green Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Scalar = " & Str(TempVal)
      'Blue Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Scalar  = " & Str(TempVal)
      'Power - for now will be a constant
      TempVal = Power
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Power        = " & Str(TempVal)
    
    Next ctr
    
    TextDisplay.Text = TextDisplay.Text & vbCrLf & vbCrLf & "END"
    
    Call DrawCirclesFromText(DstPicture, SrcPicture, ByVal Brightness)
End Sub

'************************************************************************************************************
'************************************************************************************************************
'Linear Method - Generate List & Call Drawing Subroutine
'************************************************************************************************************
'************************************************************************************************************

Public Sub DrawRandomCirclesLinearMethod(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
    'Defines variables, creates list for text box, then calls the general routine to draw the image
    
    'Coordinate variables
    Dim NumberPoints As Long
    Dim MaxPoints As Long
    Dim ctr As Long
    
    Dim TempVal As Single
    
    Dim MinXLimit As Single
    Dim MaxXLimit As Single
    Dim MinYLimit As Single
    Dim MaxYLimit As Single
    Dim MinScalarLimit As Single
    Dim MaxScalarLimit As Single
    Dim MinMagLimit As Single
    Dim MaxMagLimit As Single
    
    Randomize Timer
    
    MinXLimit = TextLinMinx.Text
    MaxXLimit = TextLinMaxX.Text
    MinYLimit = TextLinMinY.Text
    MaxYLimit = TextLinMaxY.Text
    
    MinScalarLimit = TextLinMinScalar.Text
    MaxScalarLimit = TextLinMaxScalar.Text
    MinMagLimit = TextLinMinMag.Text
    MaxMagLimit = TextLinMaxMag.Text
    
    MaxPoints = TextLinMaxPoints.Text
    NumberPoints = (TextLinMaxPoints.Text - TextLinMinPoints.Text) * Rnd + TextLinMinPoints.Text
    
    TextDisplay.Text = "Number Points = " & Str(NumberPoints)
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Frame         = " & TextFrame.Text
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Series        = " & TextSeries.Text
    TextDisplay.Text = TextDisplay.Text & vbCrLf & "Path          = " & TextPath.Text
    
    
    For ctr = 1 To NumberPoints
      TextDisplay.Text = TextDisplay.Text & vbCrLf & vbCrLf & "Point" & Str(ctr)
      'Method Type
      TempVal = 2 '1 for Power Method, 2 for Linear Method
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Method       = Linear"
      'X Coord
      TempVal = (MaxXLimit - MinXLimit) * Rnd + MinXLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "XCoord       = " & Str(TempVal)
      'Y Coord
      TempVal = (MaxYLimit - MinYLimit) * Rnd + MinYLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "YCoord       = " & Str(TempVal)
      'Red Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Mag      = " & Str(TempVal)
      'Green Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Mag    = " & Str(TempVal)
      'Blue Mag
      TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Mag     = " & Str(TempVal)
      'Red Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Scalar   = " & Str(TempVal)
      'Green Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Scalar = " & Str(TempVal)
      'Blue Scalar
      TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Scalar  = " & Str(TempVal)
      'Power - not used for linear
      TempVal = 0
      TextDisplay.Text = TextDisplay.Text & vbCrLf & "Power        =  0"
    
    Next ctr
    
    TextDisplay.Text = TextDisplay.Text & vbCrLf & vbCrLf & "END"
    
    Call DrawCirclesFromText(DstPicture, SrcPicture, ByVal Brightness)

End Sub

'************************************************************************************************************
'************************************************************************************************************
'Drawing Routine, Combined Linear or Power Method - Based on Data in Text Box
'************************************************************************************************************
'************************************************************************************************************

Public Sub DrawCirclesFromText(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)

    'Coordinate variables
    Dim x As Long, y As Long
    Dim xTemp As Single
    Dim yTemp As Single
    Dim red As Integer
    Dim green As Integer
    Dim blue As Integer
    Dim RedTemp As Single
    Dim GreenTemp As Single
    Dim BlueTemp As Single
    Dim RedScalar As Single
    Dim RedX As Single
    Dim RedY As Single
    Dim GreenScalar As Single
    Dim GreenX As Single
    Dim GreenY As Single
    Dim BlueScalar As Single
    Dim BlueX As Single
    Dim BlueY As Single
    Dim Power As Single
    
    Dim NumberPoints As Long
    Dim ctr As Long
    Dim ctr2 As Integer
    
    Dim PointList As String
    Dim PointListTest As Boolean
    Dim TestChar As String
    Dim TempString As String
    
    Dim TempColor As Single
    Dim Dist As Single
    
    Dim Points() As Single
    
    Dim ImageFrame As String
    Dim ImageSeries As String
    Dim ImagePath As String
    Dim ImageName As String
    Dim ImageFrameInt As Integer
    Dim NewImageFrame As String
    
    Randomize Timer

    'Input Info from Text Box
    PointList = TextDisplay.Text
    
    'Run tests to determine valid list
    PointListTest = False
    If Len(PointList) > 19 Then
      If Left(PointList, 13) = "Number Points" Then
        PointListTest = True
      End If
    End If
    
    If PointListTest Then
      'Read in Number Points
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(PointList, ctr, 1)
        ctr = ctr + 1
      Loop
      TempString = Mid(PointList, 16, ctr - 17)
      PointList = Right(PointList, Len(PointList) - ctr)
      
      NumberPoints = TempString

      ReDim Points(NumberPoints, 9) As Single
      
      'Read in Frame
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(PointList, ctr, 1)
        ctr = ctr + 1
      Loop
      TempString = Mid(PointList, 17, ctr - 18)
      PointList = Right(PointList, Len(PointList) - ctr)
      
      ImageFrame = TempString
    
      'Read in Series
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(PointList, ctr, 1)
        ctr = ctr + 1
      Loop
      TempString = Mid(PointList, 17, ctr - 18)
      PointList = Right(PointList, Len(PointList) - ctr)
      
      ImageSeries = TempString
      
      'Read in Path
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(PointList, ctr, 1)
        ctr = ctr + 1
      Loop
      TempString = Mid(PointList, 17, ctr - 18)
      PointList = Right(PointList, Len(PointList) - ctr)
      
      ImagePath = TempString

      'Read in List
      For ctr2 = 1 To NumberPoints
        'Remove Two Lines to get to actual data
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        PointList = Right(PointList, Len(PointList) - ctr)
        
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        PointList = Right(PointList, Len(PointList) - ctr)
        
        'Method Type
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        If TempString = " Power" Then
          Points(ctr2, 0) = 1 '1 for Power Method, 2 for Linear Method
        Else
          Points(ctr2, 0) = 2
        End If

        'X Coord
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 1) = TempString

        'Y Coord
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 2) = TempString

        'Red Mag
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 3) = TempString

        'Green Mag
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 4) = TempString

        'Blue Mag
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 5) = TempString

        'Red Scalar
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 6) = TempString

        'Green Scalar
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 7) = TempString

        'Blue Scalar
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 8) = TempString
        
        'Power
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(PointList, ctr, 1)
          ctr = ctr + 1
        Loop
        TempString = Mid(PointList, 15, ctr - 16)
        PointList = Right(PointList, Len(PointList) - ctr)
        Points(ctr2, 9) = TempString
      Next ctr2
    
      If CheckIncrementFrame.Value = Checked Then
        ImageFrameInt = Val(ImageFrame)
        NewImageFrame = Str(ImageFrameInt + 1)
        NewImageFrame = Mid(NewImageFrame, 2, Len(NewImageFrame) - 1)
        If Len(NewImageFrame) = 1 Then
          NewImageFrame = "00" & NewImageFrame
        ElseIf Len(NewImageFrame) = 2 Then
          NewImageFrame = "0" & NewImageFrame
        End If
  
        TextFrame.Text = NewImageFrame
      End If
    
    End If


    'Get the pixel data into our ImageData array
    GetImageData SrcPicture, ImageData()
    'Temporary width and height variables are faster than accessing the Scale properties over and over again
    Dim TempWidth As Long, TempHeight As Long
    TempWidth = DstPicture.ScaleWidth - 1
    TempHeight = DstPicture.ScaleHeight - 1
    
    'run a loop through the picture to change every pixel
    For x = 0 To TempWidth
      Text1.Text = Str(x)
      DoEvents
      For y = 0 To TempHeight
        xTemp = x
        yTemp = y

        RedTemp = 0
        GreenTemp = 0
        BlueTemp = 0

        For ctr = 1 To NumberPoints
          Dist = Sqr((xTemp - Points(ctr, 1)) * (xTemp - Points(ctr, 1)) + (yTemp - Points(ctr, 2)) * (yTemp - Points(ctr, 2)))
          Power = Points(ctr, 9)

          If Points(ctr, 0) = 1 Then 'Power Method
  If Dist > 0 Then
    'Red
    TempColor = Points(ctr, 3) * Points(ctr, 6) / Dist ^ Power
    RedTemp = RedTemp + TempColor
  
    'Green
    TempColor = Points(ctr, 4) * Points(ctr, 7) / Dist ^ Power
    GreenTemp = GreenTemp + TempColor
    
    'Blue
    TempColor = Points(ctr, 5) * Points(ctr, 8) / Dist ^ Power
    BlueTemp = BlueTemp + TempColor
  Else
    RedTemp = RedTemp + Points(ctr, 3)
    GreenTemp = GreenTemp + Points(ctr, 4)
    BlueTemp = BlueTemp + Points(ctr, 5)
  End If

          Else 'Linear Method

          'Red
          TempColor = Points(ctr, 3) - Points(ctr, 6) * Dist
          If TempColor < 0 Then
  TempColor = 0
          End If
          RedTemp = RedTemp + TempColor
          
          'Green
          TempColor = Points(ctr, 4) - Points(ctr, 7) * Dist
          If TempColor < 0 Then
  TempColor = 0
          End If
          GreenTemp = GreenTemp + TempColor
          
          'Blue
          TempColor = Points(ctr, 5) - Points(ctr, 8) * Dist
          If TempColor < 0 Then
  TempColor = 0
          End If
          BlueTemp = BlueTemp + TempColor
          End If
          
        Next ctr
        
        If RedTemp > 255 Then
          RedTemp = 255
        ElseIf RedTemp < 0 Then
          RedTemp = 0
        End If
        
        If GreenTemp > 255 Then
          GreenTemp = 255
        ElseIf GreenTemp < 0 Then
          GreenTemp = 0
        End If
        
        If BlueTemp > 255 Then
          BlueTemp = 255
        ElseIf BlueTemp < 0 Then
          BlueTemp = 0
        End If
        
        red = Int(RedTemp)
        green = Int(GreenTemp)
        blue = Int(BlueTemp)
        
        'If x < 255 Then
        '  red = x
        'Else
        '  red = 255
        'End If
        
        'If y < 255 Then
        '  green = y
        'Else
        '  green = 255
        'End If

        'blue = 0
        
        ImageData(2, x, y) = red   'Change the red
        ImageData(1, x, y) = green   'Change the green
        ImageData(0, x, y) = blue   'Change the blue
      Next y
      'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
      If (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
    Next x
    'final picture refresh
    SetImageData DstPicture, ImageData()
    
    'Save Final Picture to Bitmap
    ImageName = ImagePath & "\" & ImageSeries & "-" & ImageFrame & ".bmp"
    SavePicture Picture1.Image, ImageName
End Sub


'************************************************************************************************************
'************************************************************************************************************
'API Subroutines
'************************************************************************************************************
'************************************************************************************************************


'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Sub GetImageData(ByRef SrcPictureBox As PictureBox, ByRef ImageData() As Byte)
    'Declare us some variables of the necessary bitmap types
    Dim bm As BITMAP
    Dim bmi As BITMAPINFO
    'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
    bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
    bmi.bmHeader.bmPlanes = 1 'Number of planes (always one for this instance)
    bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for this instance)
    bmi.bmHeader.bmCompression = 0 'Compression: standard/none or RLE
    'Calculate the size of the bitmap type (in bytes)
    Dim bmLen As Long
    bmLen = Len(bm)
    'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
    GetObject SrcPictureBox.Image, bmLen, bm
    'Build a correctly sized array
    ReDim ImageData(0 To 2, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
    'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same one we used above)
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight
    'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from
    'SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
    GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Sub

'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte)
    'Declare us some variables of the necessary bitmap types
    Dim bm As BITMAP
    Dim bmi As BITMAPINFO
    'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
    bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
    bmi.bmHeader.bmPlanes = 1 'Number of planes (always one for this instance)
    bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for this instance)
    bmi.bmHeader.bmCompression = 0 'Compression: standard/none or RLE
    'Calculate the size of the bitmap type (in bytes)
    Dim bmLen As Long
    bmLen = Len(bm)
    'Get the picture box information from DstPictureBox and put it into our 'bm' variable
    GetObject DstPictureBox.Image, bmLen, bm
    'Now that we know the object's size, finish building the temporary header to pass to the StretchDIBits call
    '(continuing to use the 'bmi' we used above)
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight
    'Now that we've built the temporary header, we use StretchDIBits to take the data from the
    'ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the
    'StretchDIBits call should be on one continuous line)
    StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
    'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
    'Note: Always set AutoRedraw to true when using DIB sections; when AutoRedraw is false
    'you will get unpredictable results.
    If DstPictureBox.AutoRedraw = True Then
        DstPictureBox.Picture = DstPictureBox.Image
        DstPictureBox.Refresh
    End If
End Sub

'Standardized routine for converting to absolute byte values
Public Sub ByteMe(ByRef TempVar As Long)
    If TempVar > 255 Then TempVar = 255: Exit Sub
    If TempVar < 0 Then TempVar = 0: Exit Sub
End Sub

Private Sub CmdBrightnessBB_Click()
    'Get the text value, convert it to type 'Single,' and send it to the sub
    tBrightness = CSng(Val(TxtBrightness)) / 100
    DrawBitmapBitsBrightness Picture1, Picture1, tBrightness
End Sub

'A subroutine for changing the brightness of a picturebox IN 24/32-BIT COLOR MODES ONLY!!
Public Sub DrawBitmapBitsBrightness(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
    'Coordinate variables
    Dim x As Long, y As Long
    'Build a look-up table for all possible brightness values
    Dim bTable(0 To 255) As Long
    Dim TempColor As Long
    For x = 0 To 255
        'Calculate the brightness for pixel value x
        TempColor = Int(CSng(x) * Brightness)
        'Make sure that the calculated value is between 0 and 255 (so we don't get an error)
        ByteMe TempColor
        'Place the corrected value into its array spot
        bTable(x) = TempColor
    Next x
    'Create a bitmap variable and copy the basic information from 'PictureBox.Image' into it
    Dim bm As BITMAP
    GetObject DstPicture.Image, Len(bm), bm
    'Create an array of bytes and fill it with the information from 'bm' (i.e. PictureBox.image)
    Dim ImageData() As Byte
    ReDim ImageData(0 To (bm.bmBitsPixel \ 8) - 1, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
    GetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)

    'Temporary width and height variables are faster than accessing the Scale properties over and over again
    Dim TempWidth As Long, TempHeight As Long
    TempWidth = DstPicture.ScaleWidth - 1
    TempHeight = DstPicture.ScaleHeight - 1
    'run a loop through the picture to change every pixel
    For x = 0 To TempWidth
    For y = 0 To TempHeight
        'Use the values in the look-up table to quickly change the brightness values
        'of each color.  The look-up table is much faster than doing the math
        'over and over for each individual pixel.
        ImageData(2, x, y) = bTable(ImageData(2, x, y))   'Change the red
        ImageData(1, x, y) = bTable(ImageData(1, x, y))   'Change the green
        ImageData(0, x, y) = bTable(ImageData(0, x, y))   'Change the blue
    Next y
        'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
        If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then
  SetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
  DstPicture.Picture = DstPicture.Image
  DstPicture.Refresh
        End If
    Next x
    'final picture refresh
    SetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
    DstPicture.Picture = DstPicture.Image
    DstPicture.Refresh
End Sub


Private Sub Command5_Click()
  TextDisplay.Text = ""
End Sub
ModuleAnimation:
Dim CodeTextFile As String
Dim NumberPoints As Long
Dim AnimationPoints() As Single
   '(N,0) - Unused
   'Circular Motion Variables
   ' (N,1) - Xo
   ' (N,2) - Yo
   ' (N,3) - R
   ' (N,4) - Qo
   ' (N,5) - N - number revolutions per animation
   'Red Color Variables
   ' (N,6) - Mag Baseline
   ' (N,7) - Mag Ampl 1/2 Variation
   ' (N,8) - Mag Qo
   ' (N,9) - Mag N
   ' (N,10) - Scalar Baseline
   ' (N,11) - Scalar Ampl 1/2 Variation
   ' (N,12) - Scalar Qo
   ' (N,13) - Scalar N
   'Green Color Variables
   ' (N,14) - Mag Baseline
   ' (N,15) - Mag Ampl 1/2 Variation
   ' (N,16) - Mag Qo
   ' (N,17) - Mag N
   ' (N,18) - Scalar Baseline
   ' (N,19) - Scalar Ampl 1/2 Variation
   ' (N,20) - Scalar Qo
   ' (N,21) - Scalar N
   'Blue Color Variables
   ' (N,22) - Mag Baseline
   ' (N,23) - Mag Ampl 1/2 Variation
   ' (N,24) - Mag Qo
   ' (N,25) - Mag N
   ' (N,26) - Scalar Baseline
   ' (N,27) - Scalar Ampl 1/2 Variation
   ' (N,28) - Scalar Qo
   ' (N,29) - Scalar N
   'Power
   ' (N,30) - Baseline
   ' (N,31) - Ampl 1/2 Variation
   ' (N,32) - Qo
   ' (N,33) - N

'************************************************************************************************************
'************************************************************************************************************
'Generate Animaiton
'************************************************************************************************************
'************************************************************************************************************

Public Sub GenerateAnimation()
  'This subroutine will generate an animation.  It is hard coded - no random variability.  It is
  'up to the user to reprogram this subroutine to generate different animations.
  
  'The current animation has two modies of variability.
  '1. It moves each point in a circular orbit.  This is accomplished with a center of rotation x & y,
  '   a radius, an angular velocity, and a starting angle.  The angular velocity will be chose such that
  '   all points return to their starting position at the end of the animation - looping it will result
  '   in a continuous video.
  '2. R,G, & B Scalars and Mags will vary as a sine wave.  This will be accomplished with a baseline, max
  '   amplitude, frequency, and initial phase offset.  Like for the circular motion, the frequency will
  '   be chose such that the the animation will be able to be played in a loop.
  
  

  Dim Points() As Single
  Dim ctr As Integer
  Dim FrameCtr As Integer
  Dim NumberFrames As Integer
  Dim FrameText As String
  Dim SeriesText As String
  Dim PathText As String
  Dim Xo As Single
  Dim Yo As Single
  Dim R As Single
  Dim Qo As Single
  Dim N As Single
  Dim Baseline As Single
  Dim Amp As Single
  
  Const Pi = 3.14159265359
  
  '************************************************************************************************************
  '************************************************************************************************************
  'Set Animation Variables
  '************************************************************************************************************
  '************************************************************************************************************
  NumberPoints = 18
  NumberFrames = 60
  ReDim AnimationPoints(NumberPoints, 33)
  ReDim Points(NumberPoints, 9)
  
  'Define Series & Path initially - even if user accidentally changes while animation is being created, it
  'won't affect the animation.
  SeriesText = "Animation04"
  FormMain.TextSeries.Text = SeriesText
  PathText = FormMain.TextPath.Text
  CodeTextFile = PathText & "\" & SeriesText & "-Code.txt"
  ctr = 0
  
  'Call GenerateRandomAnimationPoints
  Call GenerateManualAnimationPoints
  
 
  '************************************************************************************************************
  '************************************************************************************************************
  'Generate Animation Frames
  '************************************************************************************************************
  '************************************************************************************************************
  
  For FrameCtr = 1 To NumberFrames
    'Define the frame text & force to 3 digits long
    FrameText = Str(FrameCtr)
    'Remove leading space
    FrameText = Mid(FrameText, 2, Len(FrameText) - 1)
    'Add leading zeros to force to 3 digits long
    If Len(FrameText) = 1 Then
      FrameText = "00" & FrameText
    ElseIf Len(FrameText) = 2 Then
      FrameText = "0" & FrameText
    End If
  
    FormMain.TextDisplay.Text = "Number Points = " & Str(NumberPoints)
    FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Frame         = " & FrameText
    FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Series        = " & SeriesText
    FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Path          = " & PathText
    
    For ctr = 1 To NumberPoints
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & vbCrLf & "Point " & Str(ctr)
      
      'Method Type
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Method       = Linear"
      
      'X & Y animation control variables
      Xo = AnimationPoints(ctr, 1)
      Yo = AnimationPoints(ctr, 2)
      R = AnimationPoints(ctr, 3)
      Qo = AnimationPoints(ctr, 4)
      N = AnimationPoints(ctr, 5)
      
      'X Coord
      TempVal = Xo + R * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "XCoord       = " & Str(TempVal)
      
      'Y Coord
      TempVal = Yo + R * Sin(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "YCoord       = " & Str(TempVal)
      
      'Red Mag
      Baseline = AnimationPoints(ctr, 6)
      Amp = AnimationPoints(ctr, 7)
      Qo = AnimationPoints(ctr, 8)
      N = AnimationPoints(ctr, 9)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Red Mag      = " & Str(TempVal)
      
      'Green Mag
      Baseline = AnimationPoints(ctr, 14)
      Amp = AnimationPoints(ctr, 15)
      Qo = AnimationPoints(ctr, 16)
      N = AnimationPoints(ctr, 17)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Green Mag    = " & Str(TempVal)
      
      'Blue Mag
      Baseline = AnimationPoints(ctr, 22)
      Amp = AnimationPoints(ctr, 23)
      Qo = AnimationPoints(ctr, 24)
      N = AnimationPoints(ctr, 25)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Blue Mag     = " & Str(TempVal)
      
      'Red Scalar
      Baseline = AnimationPoints(ctr, 10)
      Amp = AnimationPoints(ctr, 11)
      Qo = AnimationPoints(ctr, 12)
      N = AnimationPoints(ctr, 13)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Red Scalar   = " & Str(TempVal)
      
      'Green Scalar
      Baseline = AnimationPoints(ctr, 18)
      Amp = AnimationPoints(ctr, 19)
      Qo = AnimationPoints(ctr, 20)
      N = AnimationPoints(ctr, 21)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Green Scalar = " & Str(TempVal)
      
      'Blue Scalar
      Baseline = AnimationPoints(ctr, 26)
      Amp = AnimationPoints(ctr, 27)
      Qo = AnimationPoints(ctr, 28)
      N = AnimationPoints(ctr, 29)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Blue Scalar  = " & Str(TempVal)
      
      'Power - for now will be a constant
      Baseline = AnimationPoints(ctr, 30)
      Amp = AnimationPoints(ctr, 31)
      Qo = AnimationPoints(ctr, 32)
      N = AnimationPoints(ctr, 33)
      
      TempVal = Baseline + Amp * Cos(FrameCtr * N * 2 * Pi / NumberFrames + Qo)
      TempVal = 0 'Power
      FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & "Power        = " & Str(TempVal)
    
    Next ctr
    
    FormMain.TextDisplay.Text = FormMain.TextDisplay.Text & vbCrLf & vbCrLf & "END"
    
    Call FormMain.DrawCirclesFromText(FormMain.Picture1, FormMain.Picture1, ByVal Brightness)
  Next FrameCtr
 
End Sub

Private Sub GenerateRandomAnimationPoints()
  Dim MinXLimit As Single
  Dim MaxXLimit As Single
  Dim MinYLimit As Single
  Dim MaxYLimit As Single
  Dim MinRLimit As Single
  Dim MaxRLimit As Single
  Dim MinQLimit As Single
  Dim MaxQLimit As Single
  Dim MinScalarLimit As Single
  Dim MaxScalarLimit As Single
  Dim MinMagLimit As Single
  Dim MaxMagLimit As Single
  Dim MinMagAmpLimit As Single
  Dim MaxMagAmpLimit As Single
  Dim MinScalarAmpLimit As Single
  Dim MaxScalarAmpLimit As Single
  Dim MinNLimit As Single
  Dim MaxNLimit As Single
  Dim AllowNZero As Boolean

  MinXLimit = 0
  MaxXLimit = 800
  MinYLimit = 0
  MaxYLimit = 600
  MinRLimit = 0
  MaxRLimit = 300
  MinQLimit = 0
  MaxQLimit = 360
  MinScalarLimit = 0.75
  MaxScalarLimit = 1.25
  MinMagLimit = 127
  MaxMagLimit = 255
  MinMagAmpLimit = 0
  MaxMagAmpLimit = 60
  MinScalarAmpLimit = 0
  MaxScalarAmpLimit = 0.25
  MinNLimit = -1
  MaxNLimit = 1
  AllowNZero = False

  Open CodeTextFile For Output As #1

  '************************************************************************************************************
  'Define Animation Variables Randomly, & Record Code to recreate animation later
  For ctr = 1 To NumberPoints
  Print #1, ""
  Print #1, "  '************************************************************************************************************"
  Print #1, "  'New Point"
  Print #1, "  ctr = ctr + 1"
  Print #1, ""
  'Circular Motion Variables
  Print #1, "  'Circular Motion Variables"
    'Xo
    TempVal = (MaxXLimit - MinXLimit) * Rnd + MinXLimit
    Print #1, "    AnimationPoints(ctr, 1) = " & Str(TempVal) & "   'Xo"
    AnimationPoints(ctr, 1) = TempVal   'Xo

    'Yo
    TempVal = (MaxYLimit - MinYLimit) * Rnd + MinYLimit
    Print #1, "    AnimationPoints(ctr, 2) = " & Str(TempVal) & "   'Yo"
    AnimationPoints(ctr, 2) = TempVal   'Yo

    'R
    TempVal = (MaxRLimit - MinRLimit) * Rnd + MinRLimit
    Print #1, "    AnimationPoints(ctr, 3) = " & Str(TempVal) & "   'R"
    AnimationPoints(ctr, 3) = TempVal   'R
    
    'Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 4) = " & Str(TempVal) & "   'Qo"
    AnimationPoints(ctr, 4) = TempVal     'Qo
    
    'N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 5) = " & Str(TempVal) & "   'N - number revolutions per animation"
    AnimationPoints(ctr, 5) = TempVal     'N - number revolutions per animation
  'Red Color Variables
  Print #1, "  'Red Color Variables"
    'Mag Baseline
    TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
    Print #1, "    AnimationPoints(ctr, 6) = " & Str(TempVal) & "   'Mag Baseline"
    AnimationPoints(ctr, 6) = TempVal   'Mag Baseline
    
    'Mag Ampl 1/2 Variation
    TempVal = (MaxMagAmpLimit - MinMagAmpLimit) * Rnd + MinMagAmpLimit
    Print #1, "    AnimationPoints(ctr, 7) = " & Str(TempVal) & "   'Mag Ampl 1/2 Variation"
    AnimationPoints(ctr, 7) = TempVal    'Mag Ampl 1/2 Variation
    
    'Mag Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 8) = " & Str(TempVal) & "   'Mag Qo"
    AnimationPoints(ctr, 8) = TempVal     'Mag Qo
    
    'Mag N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 9) = " & Str(TempVal) & "   'Mag N"
    AnimationPoints(ctr, 9) = TempVal     'Mag N
    
    'Scalar Baseline
    TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
    Print #1, "    AnimationPoints(ctr, 10) = " & Str(TempVal) & "   'Scalar Baseline"
    AnimationPoints(ctr, 10) = TempVal 'Scalar Baseline
    
    'Scalar Ampl 1/2 Variation
    TempVal = (MaxScalarAmpLimit - MinScalarAmpLimit) * Rnd + MinScalarAmpLimit
    Print #1, "    AnimationPoints(ctr, 11) = " & Str(TempVal) & "   'Scalar Ampl 1/2 Variation"
    AnimationPoints(ctr, 11) = TempVal    'Scalar Ampl 1/2 Variation
    
    'Scalar Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 12) = " & Str(TempVal) & "   'Scalar Qo"
    AnimationPoints(ctr, 12) = TempVal    'Scalar Qo
    
    'Scalar N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 13) = " & Str(TempVal) & "   'Scalar N"
    AnimationPoints(ctr, 13) = TempVal    'Scalar N
    
  'Green Color Variables
  Print #1, "  'Green Color Variables"
    'Mag Baseline
    TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
    Print #1, "    AnimationPoints(ctr, 14) = " & Str(TempVal) & "   'Mag Baseline"
    AnimationPoints(ctr, 14) = TempVal   'Mag Baseline
    
    'Mag Ampl 1/2 Variation
    TempVal = (MaxMagAmpLimit - MinMagAmpLimit) * Rnd + MinMagAmpLimit
    Print #1, "    AnimationPoints(ctr, 15) = " & Str(TempVal) & "   'Mag Ampl 1/2 Variation"
    AnimationPoints(ctr, 15) = TempVal    'Mag Ampl 1/2 Variation
    
    'Mag Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 16) = " & Str(TempVal) & "   'Mag Qo"
    AnimationPoints(ctr, 16) = TempVal     'Mag Qo
    
    'Mag N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 17) = " & Str(TempVal) & "   'Mag N"
    AnimationPoints(ctr, 17) = TempVal     'Mag N
    
    'Scalar Baseline
    TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
    Print #1, "    AnimationPoints(ctr, 18) = " & Str(TempVal) & "   'Scalar Baseline"
    AnimationPoints(ctr, 18) = TempVal 'Scalar Baseline
    
    'Scalar Ampl 1/2 Variation
    TempVal = (MaxScalarAmpLimit - MinScalarAmpLimit) * Rnd + MinScalarAmpLimit
    Print #1, "    AnimationPoints(ctr, 19) = " & Str(TempVal) & "   'Scalar Ampl 1/2 Variation"
    AnimationPoints(ctr, 19) = TempVal    'Scalar Ampl 1/2 Variation
    
    'Scalar Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 20) = " & Str(TempVal) & "   'Scalar Qo"
    AnimationPoints(ctr, 20) = TempVal    'Scalar Qo
    
    'Scalar N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 21) = " & Str(TempVal) & "   'Scalar N"
    AnimationPoints(ctr, 21) = TempVal    'Scalar N
    
  'Blue Color Variables
  Print #1, "  'Blue Color Variables"
    'Mag Baseline
    TempVal = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
    Print #1, "    AnimationPoints(ctr, 22) = " & Str(TempVal) & "   'Mag Baseline"
    AnimationPoints(ctr, 22) = TempVal   'Mag Baseline
    
    'Mag Ampl 1/2 Variation
    TempVal = (MaxMagAmpLimit - MinMagAmpLimit) * Rnd + MinMagAmpLimit
    Print #1, "    AnimationPoints(ctr, 23) = " & Str(TempVal) & "   'Mag Ampl 1/2 Variation"
    AnimationPoints(ctr, 23) = TempVal    'Mag Ampl 1/2 Variation
    
    'Mag Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 24) = " & Str(TempVal) & "   'Mag Qo"
    AnimationPoints(ctr, 24) = TempVal     'Mag Qo
    
    'Mag N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 25) = " & Str(TempVal) & "   'Mag N"
    AnimationPoints(ctr, 25) = TempVal     'Mag N
    
    'Scalar Baseline
    TempVal = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
    Print #1, "    AnimationPoints(ctr, 26) = " & Str(TempVal) & "   'Scalar Baseline"
    AnimationPoints(ctr, 26) = TempVal 'Scalar Baseline
    
    'Scalar Ampl 1/2 Variation
    TempVal = (MaxScalarAmpLimit - MinScalarAmpLimit) * Rnd + MinScalarAmpLimit
    Print #1, "    AnimationPoints(ctr, 27) = " & Str(TempVal) & "   'Scalar Ampl 1/2 Variation"
    AnimationPoints(ctr, 27) = TempVal    'Scalar Ampl 1/2 Variation
    
    'Scalar Qo
    TempVal = (MaxQLimit - MinQLimit) * Rnd + MinQLimit
    Print #1, "    AnimationPoints(ctr, 28) = " & Str(TempVal) & "   'Scalar Qo"
    AnimationPoints(ctr, 28) = TempVal    'Scalar Qo
    
    'Scalar N
    TempVal = 0
    If AllowNZero Then
      TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
    Else
      Do Until TempVal <> 0
        TempVal = Round((MaxNLimit - MinNLimit) * Rnd + MinNLimit, 0)
      Loop
    End If
    Print #1, "    AnimationPoints(ctr, 29) = " & Str(TempVal) & "   'Scalar N"
    AnimationPoints(ctr, 29) = TempVal    'Scalar N
    
  'Power
  Print #1, "  'Power"
    AnimationPoints(ctr, 30) = 0    'Baseline
    AnimationPoints(ctr, 31) = 0    'Ampl 1/2 Variation
    AnimationPoints(ctr, 32) = 0    'Qo
    AnimationPoints(ctr, 33) = 1    'N
  Next ctr

  Close #1
End Sub

Private Sub GenerateManualAnimationPoints()
  ctr = 0
  

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 767.8045    'Xo
    AnimationPoints(ctr, 2) = 408.8666    'Yo
    AnimationPoints(ctr, 3) = 271.0573    'R
    AnimationPoints(ctr, 4) = 184.8047    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 141.3344    'Mag Baseline
    AnimationPoints(ctr, 7) = 19.6007    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 13.333    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 0.8078252   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.2130163   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 36.62788    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 252.9094    'Mag Baseline
    AnimationPoints(ctr, 15) = 41.67294    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 174.4896    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.236649    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.21007   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 28.3063    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 244.4416    'Mag Baseline
    AnimationPoints(ctr, 23) = 49.11302    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 30.98812    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.015309    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1408507   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 103.1466    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 357.8344    'Xo
    AnimationPoints(ctr, 2) = 305.3592    'Yo
    AnimationPoints(ctr, 3) = 183.9782    'R
    AnimationPoints(ctr, 4) = 223.2137    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 249.5153    'Mag Baseline
    AnimationPoints(ctr, 7) = 29.90047    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 189.2115    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.225666    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.03110954      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 25.69275    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 195.9264    'Mag Baseline
    AnimationPoints(ctr, 15) = 10.74445    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 52.79678    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 1.127873    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1630588   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 104.3489    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 209.522    'Mag Baseline
    AnimationPoints(ctr, 23) = 5.380587    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 171.7584    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 0.8184767   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.07272573      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 32.21698    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 158.0498    'Xo
    AnimationPoints(ctr, 2) = 13.22433    'Yo
    AnimationPoints(ctr, 3) = 9.656132    'R
    AnimationPoints(ctr, 4) = 265.861    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 194.5491    'Mag Baseline
    AnimationPoints(ctr, 7) = 24.30112    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 72.11891    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.189988    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1073931   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 47.79836    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 160.1813    'Mag Baseline
    AnimationPoints(ctr, 15) = 8.291248    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 55.90942    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 1.033939    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.06435139      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 328.3746    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 133.1263    'Mag Baseline
    AnimationPoints(ctr, 23) = 48.9265    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 65.37095    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 1.205858    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.117798   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 260.0608    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 539.1854    'Xo
    AnimationPoints(ctr, 2) = 130.1199    'Yo
    AnimationPoints(ctr, 3) = 191.3867    'R
    AnimationPoints(ctr, 4) = 58.66446    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 194.4306    'Mag Baseline
    AnimationPoints(ctr, 7) = 19.72901    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 284.7147    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 1.208936    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1212232   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 188.0253    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 162.2303    'Mag Baseline
    AnimationPoints(ctr, 15) = 34.87527    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 82.02113    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 0.7884362   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.002155468     'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 251.6069    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 176.1543    'Mag Baseline
    AnimationPoints(ctr, 23) = 31.94247    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 240.1484    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 1.08595    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.0495673   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 119.0778    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 700.8114    'Xo
    AnimationPoints(ctr, 2) = 231.3662    'Yo
    AnimationPoints(ctr, 3) = 73.41016    'R
    AnimationPoints(ctr, 4) = 248.866    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 237.4318    'Mag Baseline
    AnimationPoints(ctr, 7) = 38.64212    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 247.8749    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 0.890539   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1866782   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 200.7038    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 131.843    'Mag Baseline
    AnimationPoints(ctr, 15) = 26.84318    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 285.3536    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 0.8944205   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1445248   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 247.2576    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 145.9264    'Mag Baseline
    AnimationPoints(ctr, 23) = 20.41607    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 272.7433    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.090126    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1191852   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 143.0185    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 56.34742    'Xo
    AnimationPoints(ctr, 2) = 438.7465    'Yo
    AnimationPoints(ctr, 3) = 182.585    'R
    AnimationPoints(ctr, 4) = 300.4533    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 226.9949    'Mag Baseline
    AnimationPoints(ctr, 7) = 35.89475    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 115.9654    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.145112    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.04911171      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 324.6446    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 190.2347    'Mag Baseline
    AnimationPoints(ctr, 15) = 43.78994    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 222.2308    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 1.177177    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.2373272   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 268.1819    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 235.5621    'Mag Baseline
    AnimationPoints(ctr, 23) = 15.22645    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 238.1656    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 0.9964899   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.07516092      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 185.1515    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 676.9379    'Xo
    AnimationPoints(ctr, 2) = 79.74701    'Yo
    AnimationPoints(ctr, 3) = 177.5906    'R
    AnimationPoints(ctr, 4) = 70.01025    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 192.0644    'Mag Baseline
    AnimationPoints(ctr, 7) = 6.057007    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 71.80202    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 0.7590069   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1630597   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 222.0963    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 221.3195    'Mag Baseline
    AnimationPoints(ctr, 15) = 16.81644    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 293.9427    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 0.7652762   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1738431   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 335.8025    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 169.9243    'Mag Baseline
    AnimationPoints(ctr, 23) = 46.11243    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 0.2282453   'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 1.184177    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.040243   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 35.63074    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 185.576    'Xo
    AnimationPoints(ctr, 2) = 18.81949    'Yo
    AnimationPoints(ctr, 3) = 274.9695    'R
    AnimationPoints(ctr, 4) = 215.3913    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 158.8585    'Mag Baseline
    AnimationPoints(ctr, 7) = 8.529175    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 193.3284    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 0.8072065   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.157136   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 275.9434    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 165.3595    'Mag Baseline
    AnimationPoints(ctr, 15) = 35.43328    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 207.7238    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 1.143915    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1010942   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 85.77608    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 221.5171    'Mag Baseline
    AnimationPoints(ctr, 23) = 37.38694    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 200.9027    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 1.001751    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1679619   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 226.7585    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 458.5958    'Xo
    AnimationPoints(ctr, 2) = 351.0705    'Yo
    AnimationPoints(ctr, 3) = 288.0248    'R
    AnimationPoints(ctr, 4) = 14.73704    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 141.3743    'Mag Baseline
    AnimationPoints(ctr, 7) = 23.31282    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 351.1852    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 1.168655    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1117137   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 13.70834    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 176.0668    'Mag Baseline
    AnimationPoints(ctr, 15) = 2.193689    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 300.8193    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.005408    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.02613968      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 190.9077    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 187.5491    'Mag Baseline
    AnimationPoints(ctr, 23) = 36.70839    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 72.64548    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 0.9180057   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1305399   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 80.25532    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 652.6464    'Xo
    AnimationPoints(ctr, 2) = 314.066    'Yo
    AnimationPoints(ctr, 3) = 44.11749    'R
    AnimationPoints(ctr, 4) = 170.6942    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 148.2958    'Mag Baseline
    AnimationPoints(ctr, 7) = 10.04557    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 181.1066    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 0.8591324   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.01348172      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 325.6364    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 135.2717    'Mag Baseline
    AnimationPoints(ctr, 15) = 12.22544    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 297.3034    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 0.9604322   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1554622   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 220.0031    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 238.9538    'Mag Baseline
    AnimationPoints(ctr, 23) = 45.67168    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 136.2842    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.198433    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1464982   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 37.70452    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 407.1968    'Xo
    AnimationPoints(ctr, 2) = 91.31538    'Yo
    AnimationPoints(ctr, 3) = 134.5117    'R
    AnimationPoints(ctr, 4) = 25.20892    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 248.9625    'Mag Baseline
    AnimationPoints(ctr, 7) = 28.05581    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 359.6126    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.237484    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.09729023      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 344.8093    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 139.9158    'Mag Baseline
    AnimationPoints(ctr, 15) = 22.2401    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 314.2221    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.197868    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.09009586      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 348.6868    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 214.1134    'Mag Baseline
    AnimationPoints(ctr, 23) = 0.6707454   'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 157.5926    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.245239    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.2446544   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 191.3307    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 86.16533    'Xo
    AnimationPoints(ctr, 2) = 243.8852    'Yo
    AnimationPoints(ctr, 3) = 47.78345    'R
    AnimationPoints(ctr, 4) = 230.7755    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 144.1818    'Mag Baseline
    AnimationPoints(ctr, 7) = 47.85229    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 184.1987    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 1.17851    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.04334158      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 0.5798507   'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 143.6807    'Mag Baseline
    AnimationPoints(ctr, 15) = 25.96916    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 84.67719    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.078262    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.133273   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 30.67722    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 207.0391    'Mag Baseline
    AnimationPoints(ctr, 23) = 6.916505    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 44.31202    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.167902    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.01358365      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 303.9266    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 382.8043    'Xo
    AnimationPoints(ctr, 2) = 105.8788    'Yo
    AnimationPoints(ctr, 3) = 229.3963    'R
    AnimationPoints(ctr, 4) = 140.8973    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 193.7123    'Mag Baseline
    AnimationPoints(ctr, 7) = 1.773123    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 341.8099    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.228278    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.01115488      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 293.6767    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 152.8903    'Mag Baseline
    AnimationPoints(ctr, 15) = 41.29322    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 222.3915    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 0.9182217   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.02329747      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 307.9297    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 149.3553    'Mag Baseline
    AnimationPoints(ctr, 23) = 44.6493    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 348.552    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 1.169775    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.002596483     'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 206.7232    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 482.1011    'Xo
    AnimationPoints(ctr, 2) = 191.4332    'Yo
    AnimationPoints(ctr, 3) = 31.35656    'R
    AnimationPoints(ctr, 4) = 47.29024    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 167.4693    'Mag Baseline
    AnimationPoints(ctr, 7) = 51.00034    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 66.40594    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 1.115402    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1279025   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 263.9145    'Scalar Qo
    AnimationPoints(ctr, 13) = 1    'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 129.6327    'Mag Baseline
    AnimationPoints(ctr, 15) = 59.35456    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 183.3933    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.011827    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1452042   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 245.597    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 240.1418    'Mag Baseline
    AnimationPoints(ctr, 23) = 40.03513    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 61.63135    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 0.9285894   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.06258602      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 126.2939    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 310.3928    'Xo
    AnimationPoints(ctr, 2) = 366.5829    'Yo
    AnimationPoints(ctr, 3) = 254.1728    'R
    AnimationPoints(ctr, 4) = 129.7052    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 202.5848    'Mag Baseline
    AnimationPoints(ctr, 7) = 18.21949    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 110.1552    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 1.223363    'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1310758   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 9.407172    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 134.1    'Mag Baseline
    AnimationPoints(ctr, 15) = 37.91492    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 234.6414    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.169034    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1343993   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 265.2476    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 242.055    'Mag Baseline
    AnimationPoints(ctr, 23) = 1.463227    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 186.7899    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 1.135878    'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.2284298   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 185.1758    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 13.26313    'Xo
    AnimationPoints(ctr, 2) = 463.9454    'Yo
    AnimationPoints(ctr, 3) = 121.1477    'R
    AnimationPoints(ctr, 4) = 359.2277    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 171.6351    'Mag Baseline
    AnimationPoints(ctr, 7) = 35.2105    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 349.3926    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 0.871974   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1411158   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 107.1651    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 196.076    'Mag Baseline
    AnimationPoints(ctr, 15) = 47.57637    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 230.562    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 0.9179628   'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.2204784   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 68.46394    'Scalar Qo
    AnimationPoints(ctr, 21) = 1    'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 165.4194    'Mag Baseline
    AnimationPoints(ctr, 23) = 45.80807    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 12.71599    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 0.7967556   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.06807597      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 33.14378    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 797.4492    'Xo
    AnimationPoints(ctr, 2) = 97.17093    'Yo
    AnimationPoints(ctr, 3) = 168.5934    'R
    AnimationPoints(ctr, 4) = 220.701    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 150.9276    'Mag Baseline
    AnimationPoints(ctr, 7) = 35.3302    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 171.7425    'Mag Qo
    AnimationPoints(ctr, 9) = -1   'Mag N
    AnimationPoints(ctr, 10) = 0.7526811   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.2125569   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 150.4314    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 236.7213    'Mag Baseline
    AnimationPoints(ctr, 15) = 22.50261    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 306.8823    'Mag Qo
    AnimationPoints(ctr, 17) = -1   'Mag N
    AnimationPoints(ctr, 18) = 1.090534    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.1023843   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 173.0373    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 159.6852    'Mag Baseline
    AnimationPoints(ctr, 23) = 40.86388    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 335.8521    'Mag Qo
    AnimationPoints(ctr, 25) = 1    'Mag N
    AnimationPoints(ctr, 26) = 0.9277292   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.1310607   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 327.7467    'Scalar Qo
    AnimationPoints(ctr, 29) = -1   'Scalar N
  'Power

  '************************************************************************************************************
  'New Point
  ctr = ctr + 1

  'Circular Motion Variables
    AnimationPoints(ctr, 1) = 92.12231    'Xo
    AnimationPoints(ctr, 2) = 11.8907    'Yo
    AnimationPoints(ctr, 3) = 104.9122    'R
    AnimationPoints(ctr, 4) = 59.71898    'Qo
    AnimationPoints(ctr, 5) = 1    'N - number revolutions per animation
  'Red Color Variables
    AnimationPoints(ctr, 6) = 181.0079    'Mag Baseline
    AnimationPoints(ctr, 7) = 22.75503    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 8) = 335.5393    'Mag Qo
    AnimationPoints(ctr, 9) = 1    'Mag N
    AnimationPoints(ctr, 10) = 0.8100139   'Scalar Baseline
    AnimationPoints(ctr, 11) = 0.1037763   'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 12) = 246.2793    'Scalar Qo
    AnimationPoints(ctr, 13) = -1   'Scalar N
  'Green Color Variables
    AnimationPoints(ctr, 14) = 252.4987    'Mag Baseline
    AnimationPoints(ctr, 15) = 37.03192    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 16) = 329.4612    'Mag Qo
    AnimationPoints(ctr, 17) = 1    'Mag N
    AnimationPoints(ctr, 18) = 1.247903    'Scalar Baseline
    AnimationPoints(ctr, 19) = 0.09701304      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 20) = 234.6933    'Scalar Qo
    AnimationPoints(ctr, 21) = -1   'Scalar N
  'Blue Color Variables
    AnimationPoints(ctr, 22) = 192.1685    'Mag Baseline
    AnimationPoints(ctr, 23) = 18.04679    'Mag Ampl 1/2 Variation
    AnimationPoints(ctr, 24) = 42.53381    'Mag Qo
    AnimationPoints(ctr, 25) = -1   'Mag N
    AnimationPoints(ctr, 26) = 0.9535969   'Scalar Baseline
    AnimationPoints(ctr, 27) = 0.09628743      'Scalar Ampl 1/2 Variation
    AnimationPoints(ctr, 28) = 280.5647    'Scalar Qo
    AnimationPoints(ctr, 29) = 1    'Scalar N
  'Power
End Sub