インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

ShpClsに速度と加速度の概念を追加してみた

つづきです。
chemiphys.hateblo.jp
クラスモジュールは本当に面白いです。いろいろとチャレンジしがいがある。

物体に速度と加速度の概念を付け加えるという作業をしました。

なかなか苦労しましたが,想定通りの動きをしだしました。
物体自身に速度と加速度を持たせ,Moveメソッドで逐次変化していくようになっています。
加速度固定の例ですが,変化させていくこともできる・・つもり。。

f:id:chemiphys:20170121230309g:plain

標準モジュール 今回はシェイプを作るようにしていますので,事前準備はいりません。

Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Const PI = 3.1415

Sub MoveTest()
    ActivePresentation.SlideShowSettings.Run
    
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
    Dim s As ShpCls: Set s = New ShpCls
    
    TSlide.Shapes.Range.Delete
    With TSlide.Shapes.AddShape(msoShapeSun, 30, 100, 30, 30)
        .Name = "shp"
        .Fill.ForeColor.RGB = vbYellow
    End With
    Dim shp As Shape: Set shp = TSlide.Shapes("shp")
    
    s.SetShp shp
    s.SetA 0.3, PI / 2
    s.SetV 10, -PI / 4
    
    Dim i As Long
    Do
        s.Move
        shp.TextFrame.TextRange = " "
        DoEvents
        Sleep 10
        If s.x > 960 Then Exit Do
        If s.y > 540 Then Exit Do
        i = i + 1
    Loop
    
    SlideShowWindows(1).View.Exit
End Sub


ShpCls.cls
SetV以降を今回追加しています。
Moveメソッドで,その段階での速度を追加して移動し,その後加速度分,速度を変化させます。
速度の大きさ,角度が変わりますので,角度の再計算等を行い新しい値を収める。

(追記 速度角度を標準モジュールから取得できるようにプロパティを追加)

Option Explicit
Const PI = 3.1415
Private pShp As Shape
Private pV As Currency
Private pVAngle As Currency
Private pA As Currency
Private pAAngle As Currency

Public Sub SetShp(図形 As Shape)
    Set pShp = 図形
End Sub

Property Get x() As Currency
    x = pShp.Left + pShp.Width / 2
End Property
Property Let x(X座標 As Currency)
    pShp.Left = X座標 - pShp.Width / 2
End Property

Property Get y() As Currency
    y = pShp.Top + pShp.Height / 2
End Property
Property Let y(Y座標 As Currency)
    pShp.Top = Y座標 - pShp.Height / 2
End Property

Property Get Left() As Currency
    Left = pShp.Left
End Property
Property Let Left(pLeft As Currency)
    pShp.Left = pLeft
End Property

Property Get Right() As Currency
    Right = pShp.Left + pShp.Width
End Property
Property Let Right(pRight As Currency)
    pShp.Left = pRight - pShp.Width
End Property

Property Get Top() As Currency
    Top = pShp.Top
End Property
Property Let Top(pTop As Currency)
    pShp.Top = pTop
End Property

Property Get Bottom() As Currency
    Bottom = pShp.Top + pShp.Height
End Property
Property Let Bottom(pBottom As Currency)
    pShp.Top = pBottom - pShp.Height
End Property

Public Sub Delete()
    pShp.Delete
End Sub

Public Sub SetV(速度 As Currency, 速度角度 As Currency)
    pV = 速度
    pVAngle = 速度角度
End Sub

Public Sub SetA(加速度 As Currency, 加速度角度 As Currency)
    pA = 加速度
    pAAngle = 加速度角度
End Sub

Property Get 速度角度() As Currency
    速度角度 = pVAngle
End Property

Public Sub Move()
    Me.x = Me.x + pV * Cos(pVAngle)
    Me.y = Me.y + pV * Sin(pVAngle)
    pV = Sqr((pV * Cos(pVAngle) + pA * Cos(pAAngle)) ^ 2 + (pV * Sin(pVAngle) + pA * Sin(pAAngle)) ^ 2)
    pVAngle = Angle(pV * Cos(pVAngle) + pA * Cos(pAAngle), pV * Sin(pVAngle) + pA * Sin(pAAngle))
    
End Sub

Function Angle(x As Currency, y As Currency)
    Dim pHosei As Currency
    If Abs(x) < 0.001 Then
        If y > 0 Then
            Angle = PI / 2
        ElseIf y < 0 Then
            Angle = -PI / 2
        Else
            Angle = PI / 2 '(;´▽`A``
        End If
    Else
        If x > 0 Then
            If y >= 0 Then pHosei = 0 Else pHosei = 2 * PI
        Else
            If y >= 0 Then pHosei = PI Else pHosei = PI
        End If
        Angle = Atn(y / x)
    End If
    Angle = Angle + pHosei
End Function

追記
回転運動ぽいのができるかなぁと思い,ちょっと速度角度というプロパティを足した後,次のように標準モジュールを書き換えました。
一部分のみ載せています。 加速度を与えるSetAをループの中に入れた。

    Dim shp As Shape: Set shp = TSlide.Shapes("shp")
    
    s.SetShp shp
    
    s.SetV 10, -PI / 2
    
    Dim i As Long
    Do
        s.SetA 0.8, s.速度角度 - PI / 2
        s.Move
        shp.TextFrame.TextRange = " "

このようになります。
f:id:chemiphys:20170121233138g:plain

等速円運動の話とか覚えてないので,ずっと回るように半径を決める術はわたしにはありませんが,

なんとなくそれができそうな動きをしているので,喜びました。