Анимация отрисовки циклоиды - Visual Basic .NET
Формулировка задачи:
есть задача-на Vb.net используя только GDI+ смоделировать движение колеса и точки на нем.
фактически нужно анимировать отрисовку циклоиды.
используемый метод анимации топорен, но с ходу ничего лучше не придумалось.как следствие при отрисовке элипса и последующем его затирании траектория затирается тоже.
прошу подсказать возможность исправления этого кода или другой способ анимации
Решение задачи: «Анимация отрисовки циклоиды»
textual
Листинг программы
Imports System.Drawing.Drawing2D Public Class Form1 Private WithEvents timer As New Timer() With {.Interval = 50} Private cyclPoints As PointF() = New PointF(0) {} 'Массив точек для построения циклоиды Private wheel As GraphicsPath 'Движущееся колесо Private origWheel As GraphicsPath 'Исходное колесо Private CycloidPen As Pen = New Pen(Brushes.Red, 2) 'Перо для рисования циклоиды Private phi As Single = 15 'Приращение угла поворота колеса Private deltaX As Single 'Приращение линейного перемещения колеса Private diam As Single = 75.0F 'Диаметр колеса Private Sub Start_Click(sender As Object, e As EventArgs) With DirectCast(sender, Button) RemoveHandler .Click, AddressOf Start_Click AddHandler .Click, AddressOf Stop_Click .Text = "Стоп" End With timer.Start() End Sub Private Sub Stop_Click(sender As Object, e As EventArgs) With DirectCast(sender, Button) RemoveHandler .Click, AddressOf Stop_Click AddHandler .Click, AddressOf Start_Click .Text = "Старт" End With timer.Stop() End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load AddHandler Button1.Click, AddressOf Start_Click Button1.Text = "Старт" TextBox1.Text = timer.Interval.ToString() 'Рисование колеса origWheel = New GraphicsPath() 'Опорная точка Dim pt As PointF = New PointF() 'Обод origWheel.AddEllipse(New RectangleF(pt, New SizeF(diam, diam))) pt.Y += diam / 2 'Точка на ободе origWheel.AddEllipse(pt.X - 2.0F, pt.Y - 2.0F, 4.0F, 4.0F) 'Спица. Спицу добавляем так, чтобы метод GetLastPoint() всегда возвращал её конец origWheel.AddLine(pt.X + diam / 2, pt.Y, pt.X, pt.Y) 'Смещаем колесо так, чтобы обод касался нижней границы формы origWheel.Transform(New Matrix(1, 0, 0, 1, 0, Me.ClientRectangle.Bottom - diam)) 'Первая точка циклоиды cyclPoints(0) = origWheel.GetLastPoint() 'Приращение линейного перемещения deltaX = phi * Math.PI * (diam / 2) / 180 'Копия оригинального колеса, чтобы можно было сбрасывать его местоположение wheel = origWheel.Clone() End Sub Private Sub timer_Tick(sender As Object, e As EventArgs) Handles timer.Tick Dim m As New Matrix() 'Матрица афинных преобразований Dim rect As RectangleF = wheel.GetBounds() 'Пределы колеса 'линейное смещение колеса m.Translate(deltaX, 0) 'Поворот относительно центра на заданный угол (угол в градусах) m.RotateAt(phi, New PointF(rect.Left + rect.Width / 2, rect.Top + rect.Height / 2)) 'Применение афинных преобразований к колесу wheel.Transform(m) : m.Dispose() 'Если колесо вышло за пределы формы, то начинаем сначала If wheel.GetBounds().Right > Me.ClientRectangle.Right Then wheel = origWheel.Clone() cyclPoints = New PointF(0) {} cyclPoints(0) = wheel.GetLastPoint() Else 'Новое положение точки циклоиды добавляется в массив точек Array.Resize(Of PointF)(cyclPoints, cyclPoints.Length + 1) cyclPoints(cyclPoints.GetUpperBound(0)) = wheel.GetLastPoint() End If Me.Refresh() End Sub Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint e.Graphics.SmoothingMode = SmoothingMode.HighQuality e.Graphics.DrawPath(New Pen(Brushes.Black, 2), wheel) If (timer.Enabled) AndAlso cyclPoints.Length > 1 Then e.Graphics.DrawCurve(CycloidPen, cyclPoints) End If End Sub Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged If (timer IsNot Nothing) Then timer.Interval = Integer.Parse(DirectCast(sender, TextBox).Text) End Sub End Class