Как "уговорить" Visual Basic 6.0 нарисовать такую Картинку? - VB

Формулировка задачи:

Здравствуйте!

Прошу помощи. Подскажите, пожалуйста, как "уговорить" Visual Basic 6.0 нарисовать такую Картинку, ниже.

Какие изменения надо внести в исходный код?

Сам код появился в 2007 году. Возможно, в ту пору не хватало умельцев, чтобы дать сюжету Вторую Жизнь. Исходный код

                    Листинг программы
                
 
                            
                        
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3030
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   4560
   LinkTopic       =   "Form1"
   ScaleHeight     =   3030
   ScaleWidth      =   4560
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 
Option Base 0
Dim Chislo_periodov As Single
 
Sub TwelveNodes()
If ThisDocument.Shapes.Count > 0 Then ThisDocument.Shapes(1).Delete 'удаление фигуры 1
If ThisDocument.Shapes.Count > 0 Then ThisDocument.Shapes(1).Delete 'удаление фигуры 1 (оставшейся)
' Макрос записан 30.06.2007 User; запуск в документе Word: альт-D.
Const pi = 3.1415926535898
Dim k As Integer: k = 49  'количество приближающих дугу циклоиды сегментов
If k < 1 Then Exit Sub
Dim ShiftX: ShiftX = 50             'сдвиг (точек) вправо от угла листа
Dim ShiftY: ShiftY = 10             'сдвиг (точек) вниз от угла листа
Dim fi As Single                    'полярная коодината (радиан)
Dim A As Integer                    'радиус неподвижного круга
Dim x() As Single, y() As Single    'Декартовы коорд. точек (x: вправо, y: вниз от угла)
Dim Nn As Single, N As Single, nS As String, begpoint, finpoint
 
If Chislo_periodov <= 0 Then Chislo_periodov = 32 '31.6667
nS = InputBox(vbLf & "Число периодов:", "Например: 42", Chislo_periodov)
If IsNumeric(nS) = False Then Exit Sub
N = CSng(nS) 'Val(nS)
    If N > 333 Then _
    If MsgBox(N & " требует долгого ожидания, боитесь?", vbYesNo) = vbYes Then Exit Sub
Chislo_periodov = N
If N < 0.01 Then Chislo_periodov = 55: Exit Sub
                            ReDim x(k * N - 1)
                            ReDim y(k * N - 1)
fi = 8 * pi / N / k
A = 43 * N
'A = 31 * N
 
For Nn = 0 To k * N - 1
x(Nn) = (A * Cos(Nn * fi) + A * Sin(A * Nn * fi)) / 3 + ShiftX + (1 - Cos(Nn * fi / 6)) * Nn * Cos(Nn * fi)
y(Nn) = (A * Sin(Nn * fi) - A * Cos(A * Nn * fi)) / 3 + ShiftY + (1 - Cos(Nn * fi / 6)) * Nn * Sin(Nn * fi)
'    If Nn = 0 Then InputBox vbCr & vbCr & vbCr & "начальная точка:", "(X; Y)", x(0) & ",  " & y(0)
Next Nn
 
With ActiveDocument.Shapes.BuildFreeform(msoEditingAuto, x(0), y(0))
    For Nn = 1 To k * N - 1
    .AddNodes msoSegmentCurve, msoEditingAuto, x(Nn), y(Nn)
    Next Nn
'    .AddNodes msoSegmentCurve, msoEditingAuto, x(0), y(0)
    .ConvertToShape.Select
End With
 
begpoint = Array(x(0), y(0))                'начало полилинии
finpoint = Array(x(k * N - 1), y(k * N - 1)) 'конец полилинии
 
With ActiveDocument.Shapes
    .AddPolyline Array(begpoint, finpoint)
    .SelectAll
'    .Range(.Item(1), .Item(2)).Group 'группировка фигур 1 и 2
    Selection.ShapeRange.Group.Select 'группировка выделенных фигур
End With
'
With Selection.ShapeRange
    .Width = 240
    .Height = 240
    .Left = CentimetersToPoints(0)
    .Top = CentimetersToPoints(0)
End With
        Chislo_periodov = Chislo_periodov - 1.5
        ActiveDocument.UndoClear    'это очистка списка откатов (он чудовищно велик)
End Sub

Решение задачи: «Как "уговорить" Visual Basic 6.0 нарисовать такую Картинку?»

textual
                            Листинг программы 
                        
 
                            
                        
Dim A, fi
Dim Nn, k, N
Dim X(), y()
Dim x0, y0
Sub TwelveNodes()
 
ReDim X(k * N - 1)
ReDim y(k * N - 1)
 
A = 43 * N
 
For Nn = 0 To k * N - 1
X(Nn) = (A * Sin(A * Nn * fi)) / 3 + (1 - Cos(Nn * fi / 6)) * Nn * Cos(Nn * fi)
y(Nn) = (-A * Cos(A * Nn * fi)) / 3 + (1 - Cos(Nn * fi / 6)) * Nn * Sin(Nn * fi)
Next Nn
 
 Nn = 0
 'Timer1.Enabled = True
 
    'For Nn = 1 To k * N - 1
    'Me.Line (x0 + x(Nn - 1), y0 + y(Nn - 1))-(x0 + x(Nn), y0 + y(Nn)), RGB(0, Nn * 255 / (k * N), (k * N - 1 - Nn) * 255 / (k * N))
    'Next Nn
 
End Sub
 
Private Sub Draw_3d()
Dim X
Randomize
Z1 = Int(100 * Rnd)
 For X = 0 To 200
        Draw3dTxt 300 + X - X1, X - Y1, " Sasha Smirnov, kliknite levoy knokoy myshki po ekranu!", X, X, X, Z1
 Next X
End Sub
 
Private Sub Draw3dTxt(ByVal start_x As Single, ByVal start_y As Single, ByVal txt As String, r, g, b, Z)
    CurrentX = start_x
    CurrentY = start_y
    Font.Size = 28
        ForeColor = RGB(r + Z, g + Z, b + Z)
        Print txt
End Sub
 
Private Sub Form_Activate()
Timer1.Enabled = False
Timer1.Interval = 1
AutoRedraw = True
WindowState = 2
Print ".............Sasha_Smirnov...kliknite levoy knokoy myshki po ekranu..! "
End Sub
 
Private Sub Form_Click()
Dim Pi
Cls
 
Draw_3d ' Г¤Г®ГЎГ*ГўГЎ Г±ГІГ°Г®Г·ГЄГі ГўГ»Г§Г®ГўГ* ГЇГ°Г®Г¶ГҐГ¤ГіГ°Г»
Me.Print ".............Sasha_Smirnov "
x0 = Me.Width / 2: y0 = Me.Height / 2
Pi = 4 * Atn(1)
k = Int(Rnd * 5) + 47
N = 54 'Int(Rnd * 10) + 50
fi = 8 * Pi / N / k
TwelveNodes
Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
 If Nn < k * N - 10 Then
 
cl = Nn * 255 / (k * N)
 
 For i = Nn + 1 To Nn + 10
    Me.Line (x0 + X(i - 1), y0 + y(i - 1))-(x0 + X(i), y0 + y(i)), RGB(cl, 0, 255 - cl)
Next i
   Nn = Nn + 10
Else
    Timer1.Enabled = False
 End If
End Sub