Duplicateで旋回運動の続き：初めてのSleep関数 - Infomentのブログ～Excel VBA奮闘記～

昨日は、円を旋回運動させるマクロにおいて、旋回角度に連動して旋回半径と旋回中心が変化する不具合を何とか解消した。
infoment.hatenablog.com
すると、別の問題が見えてきた。旋回角度が大きくなっても、一瞬止まる時間は変わらないため、早く回りきってしまうのだ。今日は、その辺りの調整に挑戦する。
f:id:Infoment:20190124223828p:plain
旋回角度に連動して一時停止時間を変化させるには、今までの方法では少し煩雑だ。そこで、初めての「Sleep関数」に挑戦した。参考書を片手に、さっそく入力してみる。入力先は、クラスモジュール。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

すると、早速叱られた。
f:id:Infoment:20190124224214p:plain
そうなのか。Publicがダメなら、Privateならいいのか？安易に試してみると、上手くいった（ように見える）。

次いで、今までの「１０ミリ秒」（つまり１０００分の１０秒）を、Sleep関数で指定してみた。

変更前：Application.Wait [now()+"0:00:00.01"]
変更後：Sleep 10

今までと同じ動きが再現された。置き換えは順調だ。

ところが、残像を消す部分もSleep関数に置き換えたところ、シート上に何も描画されなくなった。待ち時間が短すぎるのかと思ったが、Sleep 1000（つまり１秒）にしても変わらない。どうやら、どこかでWaitを挟んでおかないと、描画結果は全部終わってからでないと反映してくれないらしい。残像を消さずに試してみると、こんな感じになる。
f:id:Infoment:20190124225008g:plain
途中経過が一切現れず、最終結果だけが突然現れる。仕方ないので、ループの折り返し地点に１ミリ秒の停止時間を設けることにした。

旋回角度に比例して、どれぐらい一旦停止するかについては、試行錯誤の結果

旋回角度（degrees）の1.3乗

に落ち着いた。とりあえず。

以上を踏まえた結果がこちら。

クラスモジュール（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

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() 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) + r / 2
        y = y0 - RotateRadius * Sin(StartAngle) + 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 Double = 10)

    Dim iMax As Long
        iMax = rotation_number * 360 / rotation_angle
    Dim Shapes() As Shape
    ReDim Shapes(iMax)
    
    Set Shapes(0) = SetStartShape
        Shapes(0).ShapeStyle = msoShapeStylePreset37
    
    Dim x1 As Double: x1 = Shapes(0).Left
    Dim y1 As Double: y1 = Shapes(0).Top
        
    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
    
    Dim i As Long
        For i = 1 To iMax + after_image

            ' 一時停止時間を設定。
            Sleep rotation_angle ^ 1.3
            If i <= iMax Then
                Set Shapes(i) = Shapes(i - 1).Duplicate
                Shapes(i - 1).Fill.Transparency = 0.8
                
                dx = RotateRadius * (Cos(θ2) - Cos(θ1))
                dy = RotateRadius * (Sin(θ2) - Sin(θ1))
            
                Shapes(i).Left = Shapes(i - 1).Left + dx
                Shapes(i).Top = Shapes(i - 1).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