Duplicateで旋回運動の続き：残像＋分身（道半ば）

昨日は、円を旋回運動させるマクロにおいて、旋回角度に関わらず一周の時間が一定になるよう工夫してみた。
infoment.hatenablog.com
今日は更に、残像ではなく分身させることに挑戦する。

ということで、新たな引数「PhantomNumber」を設けた。ところが、なかなか思った通りの動きにならない。あれこれ変えている内に、この時間になってしまった。今日は、時間切れ。道半ばだが、できたところまで公開する。

クラスモジュール（DuplicateShapeClass）

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Enum AngleType
    myDeg   ' ※１回転で360°
    myRad   ' ※１回転で2π
End Enum

Public x0 As Double
Public y0 As Double
Public RotateRadius As Double
Public RotateShapeRadius As Double
Public PhantomNumber As Long

Dim StartAngle As Double

Public Sub GetStartAngle(angle_value As Double, angle_type As AngleType)
    Select Case angle_type
        Case myDeg
            StartAngle = angle_value * WorksheetFunction.Pi / 180
        Case myRad
            StartAngle = angle_value
    End Select
End Sub

Private Function SetStartShape(phantom_index As Long) As Shape
    Dim r As Double
        r = RotateShapeRadius
        If r = 0 Then r = 30
    
    Dim x As Double
    Dim y As Double
        x = x0 - RotateRadius * Cos(StartAngle - 2 * WorksheetFunction.Pi / PhantomNumber * phantom_index) + r / 2
        y = y0 + RotateRadius * Sin(StartAngle - 2 * WorksheetFunction.Pi / PhantomNumber * phantom_index) + r / 2
        
        Set SetStartShape = ActiveSheet.Shapes.AddShape(msoShapeOval, x, y, r, r)
End Function

Sub RotateShape(Optional rotation_number As Long = 1, _
                Optional rotation_angle As Double = 5, _
                Optional after_image As Long = 10)

    Dim iMax As Long
        iMax = rotation_number * 360 / rotation_angle
    Dim Shapes() As Shape
    ReDim Shapes(iMax)
    
    If PhantomNumber = 0 Then PhantomNumber = 3
    
    Dim i As Long
        For i = 0 To PhantomNumber - 1
            Set Shapes(i) = SetStartShape(i)
                Shapes(i).ShapeStyle = msoShapeStylePreset37
        Next i
        
    Dim θ1 As Double
        θ1 = StartAngle

        If RotateRadius = 0 Then
            RotateRadius = 200
        End If

    Dim θ2 As Double
        θ2 = θ1 - rotation_angle * WorksheetFunction.Pi / 180
        
    Dim dx As Double
    Dim dy As Double

        For i = PhantomNumber To iMax + after_image

            ' 一時停止時間を設定。
            Sleep rotation_angle / PhantomNumber
            If i <= iMax Then
                Set Shapes(i) = Shapes(i - PhantomNumber).Duplicate
                Shapes(i - PhantomNumber).Fill.Transparency = 0.8
                
                dx = RotateRadius * (Cos(θ2) - Cos(θ1))
                dy = RotateRadius * (Sin(θ2) - Sin(θ1))
            
                Shapes(i).Left = Shapes(i - PhantomNumber).Left + dx
                Shapes(i).Top = Shapes(i - PhantomNumber).Top + dy
                
                θ1 = θ2
                θ2 = θ1 - rotation_angle * WorksheetFunction.Pi / 180
                
            End If
            
            If i >= after_image Then
                Shapes(i - after_image).Delete
            End If
            
            ' 描画させるための１ミリ秒停止。
            Application.Wait [now()+"0:00:00.001"]
        Next

End Sub

その動きが、こちら。

でも、これは意図した動きではない。未だ、道半ば。

明日に続きます。

参考まで。